From c0d658d6efbcf21340191204cf7e220bdd84c789 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 18 Sep 2008 19:32:00 +0000 Subject: [PATCH] 2008-09-18 21:31 UTC+0200 Viktor Szakats (harbour.01 syenar hu) * contrib/xhb/Makefile * contrib/xhb/common.mak + contrib/xhb/xhbcopyf.c + contrib/xhb/tests + contrib/xhb/tests/testcp.prg + contrib/xhb/tests/bld_b32.bat + contrib/xhb/tests/bld_vc.bat + Added XHB_COPYFILE() function, which is (more or less) compatible with xhb's extended __COPYFILE() function. Thanks to Toninho for the initial code and hint. --- harbour/ChangeLog | 12 ++ harbour/contrib/xhb/Makefile | 1 + harbour/contrib/xhb/common.mak | 1 + harbour/contrib/xhb/tests/bld_b32.bat | 14 +++ harbour/contrib/xhb/tests/bld_vc.bat | 14 +++ harbour/contrib/xhb/tests/testcp.prg | 9 ++ harbour/contrib/xhb/xhbcopyf.c | 157 ++++++++++++++++++++++++++ 7 files changed, 208 insertions(+) create mode 100644 harbour/contrib/xhb/tests/bld_b32.bat create mode 100644 harbour/contrib/xhb/tests/bld_vc.bat create mode 100644 harbour/contrib/xhb/tests/testcp.prg create mode 100644 harbour/contrib/xhb/xhbcopyf.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f870001ff2..b769de8a16 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,18 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2008-09-18 21:31 UTC+0200 Viktor Szakats (harbour.01 syenar hu) + * contrib/xhb/Makefile + * contrib/xhb/common.mak + + contrib/xhb/xhbcopyf.c + + contrib/xhb/tests + + contrib/xhb/tests/testcp.prg + + contrib/xhb/tests/bld_b32.bat + + contrib/xhb/tests/bld_vc.bat + + Added XHB_COPYFILE() function, which is (more or less) + compatible with xhb's extended __COPYFILE() function. + Thanks to Toninho for the initial code and hint. + 2008-09-18 20:41 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/vm/thread.c * detach local parameters passed by reference to hb_threadStart() diff --git a/harbour/contrib/xhb/Makefile b/harbour/contrib/xhb/Makefile index fdc76aad7d..dd1e4cfe82 100644 --- a/harbour/contrib/xhb/Makefile +++ b/harbour/contrib/xhb/Makefile @@ -11,6 +11,7 @@ C_SOURCES=\ hbsyslog.c \ hboutdbg.c \ cstructc.c \ + xhbcopyf.c \ xhbenum.c \ xhbfunc.c \ xhbmsgs.c \ diff --git a/harbour/contrib/xhb/common.mak b/harbour/contrib/xhb/common.mak index c130f131c4..3c1d0a0073 100644 --- a/harbour/contrib/xhb/common.mak +++ b/harbour/contrib/xhb/common.mak @@ -20,6 +20,7 @@ LIB_OBJS = \ $(OBJ_DIR)hbsyslog$(OBJEXT) \ $(OBJ_DIR)hboutdbg$(OBJEXT) \ $(OBJ_DIR)cstructc$(OBJEXT) \ + $(OBJ_DIR)xhbcopyf$(OBJEXT) \ $(OBJ_DIR)xhbenum$(OBJEXT) \ $(OBJ_DIR)xhbfunc$(OBJEXT) \ $(OBJ_DIR)xhbmsgs$(OBJEXT) \ diff --git a/harbour/contrib/xhb/tests/bld_b32.bat b/harbour/contrib/xhb/tests/bld_b32.bat new file mode 100644 index 0000000000..ea28394330 --- /dev/null +++ b/harbour/contrib/xhb/tests/bld_b32.bat @@ -0,0 +1,14 @@ +@echo off +rem +rem $Id$ +rem + +if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\bin +if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\lib +if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\include + +set HB_ARCHITECTURE=w32 +set HB_COMPILER=bcc32 +set HB_USER_LIBS=xhb.lib + +call %HB_BIN_INSTALL%\bld.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 diff --git a/harbour/contrib/xhb/tests/bld_vc.bat b/harbour/contrib/xhb/tests/bld_vc.bat new file mode 100644 index 0000000000..2c065ff32c --- /dev/null +++ b/harbour/contrib/xhb/tests/bld_vc.bat @@ -0,0 +1,14 @@ +@echo off +rem +rem $Id$ +rem + +if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\bin +if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\lib +if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\include + +set HB_ARCHITECTURE=w32 +set HB_COMPILER=msvc +set HB_USER_LIBS=xhb.lib + +call %HB_BIN_INSTALL%\bld.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 diff --git a/harbour/contrib/xhb/tests/testcp.prg b/harbour/contrib/xhb/tests/testcp.prg new file mode 100644 index 0000000000..c0ab3da17f --- /dev/null +++ b/harbour/contrib/xhb/tests/testcp.prg @@ -0,0 +1,9 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + XHB_COPYFILE( "testcp.prg", "testcp.bak", {| x | QOut( x ) } ) + + RETURN diff --git a/harbour/contrib/xhb/xhbcopyf.c b/harbour/contrib/xhb/xhbcopyf.c new file mode 100644 index 0000000000..ba8a03caeb --- /dev/null +++ b/harbour/contrib/xhb/xhbcopyf.c @@ -0,0 +1,157 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * XHB_COPYFILE() function + * + * Copyright 1999 Andi Jahja + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbapi.h" +#include "hbapierr.h" +#include "hbapifs.h" +#include "hbapiitm.h" +#include "hbvm.h" + +#if defined(HB_OS_UNIX_COMPATIBLE) + #include + #include +#endif + +#define BUFFER_SIZE 8192 + +static BOOL hb_fsCopy( char * szSource, char * szDest, PHB_ITEM pBlock ) +{ + BOOL bRetVal = FALSE; + HB_FHANDLE fhndSource; + + HB_TRACE(HB_TR_DEBUG, ("hb_fsCopy(%s, %s)", szSource, szDest)); + + while( ( fhndSource = hb_spOpen( ( BYTE * ) szSource, FO_READ | FO_SHARED | FO_PRIVATE ) ) == FS_ERROR ) + { + USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 2012, NULL, szSource, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 0 ); + + if( uiAction != E_RETRY ) + break; + } + + if( fhndSource != FS_ERROR ) + { + HB_FHANDLE fhndDest; + + while( ( fhndDest = hb_spCreate( ( BYTE * ) szDest, FC_NORMAL ) ) == FS_ERROR ) + { + USHORT uiAction = hb_errRT_BASE_Ext1( EG_CREATE, 2012, NULL, szDest, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 0 ); + + if( uiAction != E_RETRY ) + break; + } + + if( fhndDest != FS_ERROR ) + { +#if defined(HB_OS_UNIX_COMPATIBLE) + struct stat struFileInfo; + int iSuccess = fstat( fhndSource, &struFileInfo ); +#endif + BYTE * buffer = ( BYTE * ) hb_xgrab( BUFFER_SIZE ); + USHORT usRead; + + bRetVal = TRUE; + + if( hb_itemType( pBlock ) != HB_IT_BLOCK ) + pBlock = NULL; + + while( ( usRead = hb_fsRead( fhndSource, buffer, BUFFER_SIZE ) ) != 0 ) + { + while( hb_fsWrite( fhndDest, buffer, usRead ) != usRead ) + { + USHORT uiAction = hb_errRT_BASE_Ext1( EG_WRITE, 2016, NULL, szDest, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 0 ); + + if( uiAction != E_RETRY ) + { + bRetVal = FALSE; + break; + } + } + + if( pBlock ) + { + PHB_ITEM pCnt = hb_itemPutNL( NULL, usRead ); + + hb_vmEvalBlockV( pBlock, 1, pCnt ); + + hb_itemRelease( pCnt ); + } + } + + hb_xfree( buffer ); + +#if defined(HB_OS_UNIX_COMPATIBLE) + if( iSuccess == 0 ) + fchmod( fhndDest, struFileInfo.st_mode ); +#endif + + hb_fsClose( fhndDest ); + } + + hb_fsClose( fhndSource ); + } + + return bRetVal; +} + +/* Clipper returns .F. on failure and NIL on success */ + +HB_FUNC( XHB_COPYFILE ) +{ + if( ISCHAR( 1 ) && ISCHAR( 2 ) ) + { + if( ! hb_fsCopy( hb_parc( 1 ), hb_parc( 2 ), hb_param( 3, HB_IT_BLOCK ) ) ) + hb_retl( FALSE ); + } + else + hb_errRT_BASE( EG_ARG, 2010, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); /* NOTE: Undocumented but existing Clipper Run-time error */ +}