diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 28a37dfab2..553297956a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,83 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + - Removed a strange extension which looked like a mistake + (besides not being CA-Cl*pper compatible). + * Comments reviewed/changed/added. + ; Review done, now 100% compatible. + +2006-07-17 00:41 UTC+0100 Viktor Szakats (viktor.szakats syenar.hu) + * harbour/common.mak + * harbour/makefile.bc + * harbour/makefile.vc + * harbour/utils/Makefile + + Added hbpptest + + * harbour/utils/hbpptest/pretest.prg + + Output now goes to STDOUT. + + * harbour/source/compiler/harbour.c + ! Possible memory leak fixed. + + * harbour/source/rtl/Makefile + ! Fixed tabs (readded them). + + - harbour/source/rtl/dbdelim.prg + + harbour/source/rdd/dbdelim.prg + - harbour/source/rtl/dbjoin.prg + + harbour/source/rdd/dbjoin.prg + * Moved three RDD related internal function source files + to the RDD library. (They did depend on each other + * harbour/source/rtl/Makefile + * harbour/source/rdd/Makefile + * harbour/common.mak + * Moved three RDD related internal function source files + to the RDD library. (They did depend on each other + anyway.) + + * harbour/source/rdd/dbcmd.c + * harbour/source/rdd/dbfuncs.prg + * harbour/source/rdd/dblist.prg + * harbour/source/rdd/dbsort.prg + * harbour/source/rdd/dbstrux.prg + * harbour/source/rdd/dbtotal.prg + * harbour/source/rdd/dbupdat.prg + * harbour/source/rdd/rddord.prg + ! Problem where error condition was not detected if BREAK didn't + * harbour/source/rtl/dbedit.prg + * harbour/source/rtl/dbjoin.prg + % Cleanups, minor optimizations. + ! __dbApp(), __dbCopy() to return LOGICAL. + ! Problem where error condition was not detected if BREAK didn't + set the error object. + ! __dbTotal() lRest handling fixed. + ! __dbTotal() ErrorBlock overriding removed. + ! __dbCreate() now generating default alias. + % __dbCreate() using dbCreate() undoc param to open the tables. + ! __dbDelim() return value. + ! __dbSDF() return value. + + CA-Cl*pper undocumented call added: _dtxCondSet() + + XBase++ compatible calls implemented: + dbJoin(), dbList(), dbSort(), dbTotal(), dbUpdate(), _dbExport() + dbCopyStruct(), dbCopyExtStruct() + + Added some more 10 chars call stubs: + __dbCopySt(), __dbCopyXS(), __dbOpenSD(), __dbArrang() + + Comments. + + Formatting. + ; All high-level db functions seems to be compatible now. + DBEDIT() is left TODO for review (refix). + + * harbour/source/rtl/tbrowse.prg + - Removed compiler+RTL __dbList() hack which + made it incompatible with CA-Cl*pper. The + hack targeted an XBase++ extension, but it's + compatible even without the hack. Tested with + * harbour/source/rdd/dblist.prg + - Removed compiler+RTL __dbList() hack which + made it incompatible with CA-Cl*pper. The + hack targeted an XBase++ extension, but it's + compatible even without the hack. Tested with + XBase++ 1.82.294. 2006-07-16 23:26 UTC+0100 Enrico Maria Giordano * harbour/source/rtl/typefile.prg % FUNCTION -> PROCEDURE diff --git a/harbour/common.mak b/harbour/common.mak index b6ed631302..2d698394db 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -55,10 +55,10 @@ GTGUI_DIR = source\rtl\gtgui HARBOUR_DIR = source\compiler HBPP_DIR = utils\hbpp +HBPPTEST_DIR = utils\hbpptest HBRUN_DIR = utils\hbrun HBTEST_DIR = utils\hbtest HBDOC_DIR = utils\hbdoc -HBPP_DIR = utils\hbpp HBMAKE_DIR = utils\hbmake HBVER_DIR = utils\hbver @@ -95,6 +95,7 @@ $(GTWVT_DIR);\ $(GTGUI_DIR);\ $(HARBOUR_DIR);\ $(HBPP_DIR);\ +$(HBPPTEST_DIR);\ $(HBRUN_DIR);\ $(HBTEST_DIR);\ $(HBDOC_DIR);\ @@ -138,6 +139,7 @@ GTGUI_LIB = $(LIB_DIR)\gtgui.lib HARBOUR_EXE = $(BIN_DIR)\harbour.exe HBPP_EXE = $(BIN_DIR)\hbpp.exe +HBPPTEST_EXE = $(BIN_DIR)\hbpptest.exe HBRUN_EXE = $(BIN_DIR)\hbrun.exe HBTEST_EXE = $(BIN_DIR)\hbtest.exe HBDOC_EXE = $(BIN_DIR)\hbdoc.exe @@ -411,9 +413,6 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\color53.obj \ $(OBJ_DIR)\date.obj \ $(OBJ_DIR)\dbedit.obj \ - $(OBJ_DIR)\dbdelim.obj \ - $(OBJ_DIR)\dbsdf.obj \ - $(OBJ_DIR)\dbjoin.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ @@ -595,6 +594,9 @@ RDD_LIB_OBJS = \ $(OBJ_DIR)\delim1.obj \ $(OBJ_DIR)\sdf1.obj \ \ + $(OBJ_DIR)\dbdelim.obj \ + $(OBJ_DIR)\dbsdf.obj \ + $(OBJ_DIR)\dbjoin.obj \ $(OBJ_DIR)\dbtotal.obj \ $(OBJ_DIR)\dbfuncs.obj \ $(OBJ_DIR)\dblist.obj \ @@ -725,6 +727,11 @@ HBPP_EXE_OBJS = \ #********************************************************** +HBPPTEST_EXE_OBJS = \ + $(OBJ_DIR)\pretest.obj \ + +#********************************************************** + HBRUN_EXE_OBJS = \ $(OBJ_DIR)\hbrun.obj \ $(OBJ_DIR)\external.obj \ @@ -862,6 +869,7 @@ HB_BUILD_TARGETS = \ \ $(HBRUN_EXE) \ $(HBTEST_EXE) \ + $(HBPPTEST_EXE) \ $(HBDOC_EXE) \ $(HBMAKE_EXE) \ $(HBVER_EXE) \ diff --git a/harbour/include/hbexpra.c b/harbour/include/hbexpra.c index b2b9138b47..144276e7ed 100644 --- a/harbour/include/hbexpra.c +++ b/harbour/include/hbexpra.c @@ -402,94 +402,6 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms ) HB_EXPR_PCODE1( hb_compExprDelete, pName ); return pEval; } - else if( HB_COMP_ISSUPPORTED( HB_COMPFLAG_XBASE ) && - (( strcmp( "__DBLIST", pName->value.asSymbol ) == 0 ) && iCount >= 10) ) - { - HB_EXPR_PTR pArray = pParms->value.asList.pExprList->pNext; - - if( pArray->ExprType == HB_ET_ARRAY ) - { - HB_EXPR_PTR pElem = pArray->value.asList.pExprList; - HB_EXPR_PTR pPrev = NULL, pNext; - - while( pElem ) - { - /* The {|| &cMacro } block is now &( "{||" + cMacro + "}" ) due to early macro expansion in compiler. */ - if( pElem->ExprType == HB_ET_MACRO ) - { - HB_EXPR_PTR pMacro = pElem->value.asMacro.pExprList; - - if( pMacro && - pMacro->ExprType == HB_EO_PLUS && - pMacro->value.asOperator.pLeft->ExprType == HB_EO_PLUS && - pMacro->value.asOperator.pLeft->value.asOperator.pRight->ExprType == HB_ET_VARIABLE - ) - { - /* Saving the next array element so the list can be relinked after we substitute the macro block. */ - pNext = pElem->pNext; - - /* Instead we only want the macro variable, {|| &cMacro } -> &( "{||" + cMacro + "}" ) -> cMacro */ - hb_compExprClear( pElem ); - pElem = pMacro->value.asOperator.pLeft->value.asOperator.pRight; - if( pPrev ) - { - /* Previous element should point to the new element. */ - pPrev->pNext = pElem; - } - else - { - /* Top of array should point to the new first element. */ - pArray->value.asList.pExprList = pElem; - } - pElem->pNext = pNext; - } - } - /* Search for {|| &(cMacro) }. */ - else if( pElem->ExprType == HB_ET_CODEBLOCK ) - { - HB_EXPR_PTR pBlock = pElem->value.asCodeblock.pExprList; - - /* Search for macros {|| &cMacro }. */ - if( pBlock->ExprType == HB_ET_MACRO ) - { - /* Saving the next array element so the list can be relinked after we substitute the macro block. */ - pNext = pElem->pNext; - - /* Instead we only want the core expression. */ - hb_compExprClear( pElem ); - if( pBlock->value.asMacro.pExprList ) /* &( exp ) -> exp */ - { - pElem = pBlock->value.asMacro.pExprList; - } - else if( pBlock->value.asMacro.cMacroOp ) /* simple macro in Flex build {|| &cMacro}, because harbour.y does not support early macros yet*/ - { - pElem = hb_compExprNewVar( pBlock->value.asMacro.szMacro ); - } - else /* {|| &cMacro.suffix } -> cMacro + "suffix" */ - { - char *cStr = pBlock->value.asMacro.szMacro; - pElem = hb_compExprNewString( cStr, strlen(cStr) ); - } - - if( pPrev ) - { - /* Previous element should point to the new element. */ - pPrev->pNext = pElem; - } - else - { - /* Top of array should point to the new first element. */ - pArray->value.asList.pExprList = pElem; - } - pElem->pNext = pNext; - } - } - - pPrev = pElem; - pElem = pElem->pNext; - } - } - } #ifndef SIMPLEX else if( ( strcmp( "_GET_", pName->value.asSymbol ) == 0 ) && iCount ) diff --git a/harbour/makefile.bc b/harbour/makefile.bc index daf8e6bf06..fdfcefb708 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -430,6 +430,21 @@ $(PP_LIB) ! #********************************************************** # +# HBPPTEST build rule +# +$(HBPPTEST_EXE) :: BasicLibs BasicExes StdLibs +$(HBPPTEST_EXE) :: $(HBPPTEST_EXE_OBJS) + $(HIDE)IF EXIST "$(HBPPTEST_EXE)" $(DEL) "$(HBPPTEST_EXE)" > NUL + $(HIDE)$(CC) @&&! +$(CFLAGS) +-e$(HBPPTEST_EXE) +$(**: = ^ +) +$(STANDARD_STATIC_HBLIBS) +$(PP_LIB) +! +#********************************************************** +# # HBRUN build rule # $(HBRUN_EXE) :: BasicLibs BasicExes StdLibs diff --git a/harbour/makefile.vc b/harbour/makefile.vc index ae041f245d..b6ab4e3189 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -211,6 +211,9 @@ DLL_OBJS = $(TMP_DLL_OBJS:obj\vc=obj\dll\vc) {$(HBPP_DIR)}.c{$(OBJ_DIR)}.obj:: $(HIDE)$(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $< #******************************************************* +{$(HBPPTEST_DIR)}.c{$(OBJ_DIR)}.obj:: + $(HIDE)$(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $< +#******************************************************* {$(HBRUN_DIR)}.c{$(OBJ_DIR)}.obj:: $(HIDE)$(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $< #******************************************************* @@ -330,6 +333,10 @@ DLL_OBJS = $(TMP_DLL_OBJS:obj\vc=obj\dll\vc) $(HIDE)$(HARBOUR_EXE) $(HARBOURFLAGS) $< -o$(OBJ_DIR)\\ $(HIDE)$(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $(OBJ_DIR)\$(*B).c #******************************************************* +{$(HBPPTEST_DIR)}.prg{$(OBJ_DIR)}.obj: + $(HIDE)$(HARBOUR_EXE) $(HARBOURFLAGS) $< -o$(OBJ_DIR)\\ + $(HIDE)$(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $(OBJ_DIR)\$(*B).c +#******************************************************* {$(HBRUN_DIR)}.prg{$(OBJ_DIR)}.obj: $(HIDE)$(HARBOUR_EXE) $(HARBOURFLAGS) $< -o$(OBJ_DIR)\\ $(HIDE)$(CC) $(CLIBFLAGS) -Fo$(OBJ_DIR)\ $(OBJ_DIR)\$(*B).c @@ -429,6 +436,9 @@ DLL_OBJS = $(TMP_DLL_OBJS:obj\vc=obj\dll\vc) {$(HBPP_DIR)}.c{$(DLL_OBJ_DIR)}.obj:: $(HIDE)$(CC) $(CLIBFLAGSDLL) -Fo$(DLL_OBJ_DIR)\ $< #******************************************************* +{$(HBPPTEST_DIR)}.c{$(DLL_OBJ_DIR)}.obj:: + $(HIDE)$(CC) $(CLIBFLAGSDLL) -Fo$(DLL_OBJ_DIR)\ $< +#******************************************************* {$(HBRUN_DIR)}.c{$(DLL_OBJ_DIR)}.obj:: $(HIDE)$(CC) $(CLIBFLAGSDLL) -Fo$(DLL_OBJ_DIR)\ $< #******************************************************* @@ -548,6 +558,10 @@ DLL_OBJS = $(TMP_DLL_OBJS:obj\vc=obj\dll\vc) $(HIDE)$(HARBOUR_EXE) -D__EXPORT__ $(HARBOURFLAGS) $< -o$(DLL_OBJ_DIR)\\ $(HIDE)$(CC) $(CLIBFLAGSDLL) -Fo$(DLL_OBJ_DIR)\ $(OBJ_DIR)\$(*B).c #******************************************************* +{$(HBPPTEST_DIR)}.prg{$(DLL_OBJ_DIR)}.obj: + $(HIDE)$(HARBOUR_EXE) -D__EXPORT__ $(HARBOURFLAGS) $< -o$(DLL_OBJ_DIR)\\ + $(HIDE)$(CC) $(CLIBFLAGSDLL) -Fo$(DLL_OBJ_DIR)\ $(OBJ_DIR)\$(*B).c +#******************************************************* {$(HBRUN_DIR)}.prg{$(DLL_OBJ_DIR)}.obj: $(HIDE)$(HARBOUR_EXE) -D__EXPORT__ $(HARBOURFLAGS) $< -o$(DLL_OBJ_DIR)\\ $(HIDE)$(CC) $(CLIBFLAGSDLL) -Fo$(DLL_OBJ_DIR)\ $(OBJ_DIR)\$(*B).c @@ -731,6 +745,20 @@ $(PP_LIB) << #********************************************************** # +# HBPPTEST build rule +# +$(HBPPTEST_EXE) : $(HBPPTEST_EXE_OBJS) + $(HIDE)IF EXIST "$(HBPPTEST_EXE)" $(DEL) "$(HBPPTEST_EXE)" > NUL + $(HIDE)$(LINKER) @<< +$(LDFLAGS) +/OUT:$(HBPPTEST_EXE) +$(**: = ^ +) +$(STANDARD_STATIC_HBLIBS) +$(PP_LIB) +<< +#********************************************************** +# # HBRUN build rule # $(HBRUN_EXE) : $(HBRUN_EXE_OBJS) diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index 02004912c4..6bacca5787 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -414,10 +414,11 @@ static int hb_compProcessRSPFile( char * szRspName, int argc, char * argv[] ) hb_comp_bAutoOpen = bAutoOpen; hb_fsFNameMerge( szFile, pFileName ); - hb_xfree( pFileName ); hb_compCompile( szFile, argc, argv, FALSE ); } + hb_xfree( pFileName ); + return iStatus; } diff --git a/harbour/source/rdd/Makefile b/harbour/source/rdd/Makefile index c6f86562f5..3aaaf3b41f 100644 --- a/harbour/source/rdd/Makefile +++ b/harbour/source/rdd/Makefile @@ -14,9 +14,12 @@ C_SOURCES=\ hbdbsort.c \ PRG_SOURCES=\ + dbdelim.prg \ dbfuncs.prg \ + dbjoin.prg \ dbtotal.prg \ dblist.prg \ + dbsdf.prg \ dbsort.prg \ dbstrux.prg \ dbupdat.prg \ diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index ef55fd49f6..34f93bb8b6 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -4614,62 +4614,72 @@ HB_FUNC( __DBTRANS ) HB_FUNC( __DBAPP ) { + BOOL bRetVal; + if( ISCHAR( 1 ) ) { AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); if( pArea ) { - hb_rddTransRecords( pArea, - hb_parc( 1 ), /* file name */ - hb_parc( 8 ), /* RDD */ - hb_parnl( 9 ), /* connection */ - hb_param( 2, HB_IT_ARRAY ), /* Fields */ - FALSE, /* Export? */ - hb_param( 3, HB_IT_BLOCK ), /* cobFor */ - NULL, /* lpStrFor */ - hb_param( 4, HB_IT_BLOCK ), /* cobWhile */ - NULL, /* lpStrWhile */ - hb_param( 5, HB_IT_NUMERIC ), /* Next */ + bRetVal = ( SUCCESS == hb_rddTransRecords( pArea, + hb_parc( 1 ), /* file name */ + hb_parc( 8 ), /* RDD */ + hb_parnl( 9 ), /* connection */ + hb_param( 2, HB_IT_ARRAY ), /* Fields */ + FALSE, /* Export? */ + hb_param( 3, HB_IT_BLOCK ), /* cobFor */ + NULL, /* lpStrFor */ + hb_param( 4, HB_IT_BLOCK ), /* cobWhile */ + NULL, /* lpStrWhile */ + hb_param( 5, HB_IT_NUMERIC ), /* Next */ ISNIL( 6 ) ? NULL : hb_param( 6, HB_IT_ANY ), /* RecID */ - hb_param( 7, HB_IT_LOGICAL ), /* Rest */ - hb_parc( 10 ), /* Codepage */ - hb_param( 11, HB_IT_STRING ) );/* Delimiter */ + hb_param( 7, HB_IT_LOGICAL ), /* Rest */ + hb_parc( 10 ), /* Codepage */ + hb_param( 11, HB_IT_STRING ) ) ); /* Delimiter */ } else { hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "APPEND FROM" ); + bRetVal = FALSE; } } + + hb_retl( bRetVal ); } HB_FUNC( __DBCOPY ) { + BOOL bRetVal; + if( ISCHAR( 1 ) ) { AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); if( pArea ) { - hb_rddTransRecords( pArea, - hb_parc( 1 ), /* file name */ - hb_parc( 8 ), /* RDD */ - hb_parnl( 9 ), /* connection */ - hb_param( 2, HB_IT_ARRAY ), /* Fields */ - TRUE, /* Export? */ - hb_param( 3, HB_IT_BLOCK ), /* cobFor */ - NULL, /* lpStrFor */ - hb_param( 4, HB_IT_BLOCK ), /* cobWhile */ - NULL, /* lpStrWhile */ - hb_param( 5, HB_IT_NUMERIC ), /* Next */ + bRetVal = ( SUCCESS == hb_rddTransRecords( pArea, + hb_parc( 1 ), /* file name */ + hb_parc( 8 ), /* RDD */ + hb_parnl( 9 ), /* connection */ + hb_param( 2, HB_IT_ARRAY ), /* Fields */ + TRUE, /* Export? */ + hb_param( 3, HB_IT_BLOCK ), /* cobFor */ + NULL, /* lpStrFor */ + hb_param( 4, HB_IT_BLOCK ), /* cobWhile */ + NULL, /* lpStrWhile */ + hb_param( 5, HB_IT_NUMERIC ), /* Next */ ISNIL( 6 ) ? NULL : hb_param( 6, HB_IT_ANY ), /* RecID */ - hb_param( 7, HB_IT_LOGICAL ), /* Rest */ - hb_parc( 10 ), /* Codepage */ - hb_param( 11, HB_IT_STRING ) );/* Delimiter */ + hb_param( 7, HB_IT_LOGICAL ), /* Rest */ + hb_parc( 10 ), /* Codepage */ + hb_param( 11, HB_IT_STRING ) ) ); /* Delimiter */ } else { hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "COPY TO" ); + bRetVal = FALSE; } } + + hb_retl( bRetVal ); } HB_EXPORT ERRCODE hb_rddGetTempAlias( char * szAliasTmp ) diff --git a/harbour/source/rdd/dbdelim.prg b/harbour/source/rdd/dbdelim.prg new file mode 100644 index 0000000000..7474b0dede --- /dev/null +++ b/harbour/source/rdd/dbdelim.prg @@ -0,0 +1,120 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Copies the contents of a database to a delimited text file. + * Appends the contents of a delimited text file to a database. + * + * Copyright 2001-2003 David G. Holm + * www - http://www.harbour-project.org + * APPEND FROM code submitted by Marco Braida + * + * Copyright 2006 Przemyslaw Czerpak + * function __dbDelim() replaced by the new one which uses + * DELIM RDD I've just created + * + * 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 "hbsetup.ch" + +REQUEST DELIM + +FUNCTION __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRecord, lRest ) + +#ifdef HB_C52_STRICT + + LOCAL nSrcArea + LOCAL nDstArea + LOCAL aStruct + LOCAL cRDD := "DELIM" + + IF lExport + nSrcArea := Select() + ELSE + nDstArea := Select() + ENDIF + + IF Empty( aStruct := __dbStructFilter( dbStruct(), aFields ) ) + RETURN .F. + ENDIF + + IF lExport + dbCreate( cFile, aStruct, cRDD, .T., "", cDelimArg ) + nDstArea := Select() + IF nDstArea == nSrcArea + nDstArea := NIL + ENDIF + dbSelectArea( nSrcArea ) + ELSE + IF !__dbOpenSDF( cFile, aStruct, cRDD, .T., "", cDelimArg ) + RETURN .F. + ENDIF + nSrcArea := Select() + ENDIF + + IF nDstArea != NIL + __dbTrans( nDstArea, aStruct, bFor, bWhile, nNext, nRecord, lRest ) + ENDIF + + IF lExport + IF nDstArea != NIL + dbSelectArea( nDstArea ) + dbCloseArea() + ENDIF + dbSelectArea( nSrcArea ) + ELSE + dbSelectArea( nSrcArea ) + dbCloseArea() + dbSelectArea( nDstArea ) + ENDIF + + RETURN .T. + +#else + + RETURN iif( lExport,; + __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "DELIM", , , cDelimArg ) ,; + __dbApp( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "DELIM", , , cDelimArg ) ) + +#endif diff --git a/harbour/source/rdd/dbfuncs.prg b/harbour/source/rdd/dbfuncs.prg index 2d3973dfb3..52c6472602 100644 --- a/harbour/source/rdd/dbfuncs.prg +++ b/harbour/source/rdd/dbfuncs.prg @@ -50,41 +50,93 @@ * */ -FUNCTION DBCLEARFIL() - Return DBCLEARFILTER() +#include "hbsetup.ch" -FUNCTION DBSETDRIVE(cDriver) - Return DBSETDRIVER(cDriver) +/* short (10 chars long) version of some functions for compatibility */ -FUNCTION DBSETRELAT(xArea,bRelation,cRelation,lScoped) - Return DBSETRELATION(xArea,bRelation,cRelation,lScoped) +FUNCTION dbClearFil() + RETURN dbClearFilter() -FUNCTION DBRLOCKLIS() - Return DBRLOCKLIST() +FUNCTION dbSetDrive( cRDD ) + RETURN dbSetDriver( cRDD ) -FUNCTION DBCLOSEARE() - Return DBCLOSEAREA() - -FUNCTION RDDSETDEFA(xDriver) - Return RDDSETDEFAULT(xDriver) +FUNCTION dbSetRelat( xArea, bRelation, cRelation, lScoped ) + RETURN dbSetRelation( xArea, bRelation, cRelation, lScoped ) -FUNCTION DBSELECTAR(xArea) - Return DBSELECTAREA(xArea) +FUNCTION dbRLockLis() + RETURN dbRLockList() -FUNCTION DBUNLOCKAL() - Return DBUNLOCKALL() +FUNCTION dbCloseAre() + RETURN dbCloseArea() -FUNCTION DBCLEARREL() - Return DBCLEARRELATION() - -FUNCTION DBSETFILTE(bFilter,cFilter) - Return DBSETFILTER(bFilter,cFilter) +FUNCTION dbSelectAr( xArea ) + RETURN dbSelectArea( xArea ) -FUNCTION DBFIELDINF(nType,nArea,xInfo) - Return DBFIELDINFO(nType,nArea,xInfo) - -FUNCTION DBORDERINF(nInfo,cIndex,xOrder,xSet) - Return DBORDERINFO(nInfo,cIndex,xOrder,xSet) +FUNCTION dbUnLockAl() + RETURN dbUnLockAll() -FUNCTION DBRECORDIN(nInfo,nRecord,xSet) - Return DBRECORDINFO(nInfo,nRecord,xSet) +FUNCTION dbClearRel() + RETURN dbClearRelation() + +FUNCTION dbSetFilte( bFilter, cFilter ) + RETURN dbSetFilter( bFilter, cFilter ) + +FUNCTION dbFieldInf( nType, nArea, xInfo ) + RETURN dbFieldInfo( nType, nArea, xInfo ) + +FUNCTION dbOrderInf( nInfo, cIndex, xOrder, xSet ) + RETURN dbOrderInfo( nInfo, cIndex, xOrder, xSet ) + +FUNCTION dbRecordIn( nInfo, nRecord, xSet ) + RETURN dbRecordInfo( nInfo, nRecord, xSet ) + +FUNCTION rddSetDefa( cRDD ) + RETURN rddSetDefault( cRDD ) + +FUNCTION __dbCopySt( cFileName, aFieldList ) + RETURN __dbCopyStruct( cFileName, aFieldList ) + +FUNCTION __dbCopyXS( cFileName ) + RETURN __dbCopyXStruct( cFileName ) + +/* ; NOTE: The created table will be kept open if lOpenMode parameter + is of logical type. If .T. it will be opened in a new workarea, + if .F. it will be opened in the current one. */ +/* ; NOTE: Has an identical parameter list with dbCreate() */ + +FUNCTION __dbOpenSD( cFile, aStruct, cRDD, lOpenMode, cAlias, cDelimArg, cCodePage, nConnection ) + RETURN __dbOpenSDF( cFile, aStruct, cRDD, lOpenMode, cAlias, cDelimArg, cCodePage, nConnection ) + +FUNCTION __dbArrang( nToArea, aStruct, bFor, bWhile, nNext, nRecord, lRest, aFields ) + RETURN __dbArrange( nToArea, aStruct, bFor, bWhile, nNext, nRecord, lRest, aFields ) + +FUNCTION ordListCle() + RETURN ordListClear() + +FUNCTION ordListReb() + RETURN ordListRebuild() + +FUNCTION ordSetFocu( xOrder, cFile ) + RETURN ordSetFocus( xOrder, cFile ) + +FUNCTION ordSetRela( xArea, bRelation, cRelation ) + RETURN ordSetRelation( xArea, bRelation, cRelation ) + +#ifdef HB_COMPAT_XPP + +FUNCTION _dbExport( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, cXPP_Driver, cDelimiter ) + + DO CASE + CASE cXPP_Driver == "SDFDBE" + RETURN __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "SDF" ) +/* Alternate CA-Cl*pper compatible call: + RETURN __dbSDF( .T., cFile, aFields, bFor, bWhile, nNext, nRecord, lRest ) */ + CASE cXPP_Driver == "DELDBE" + RETURN __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "DELIM", , , cDelimiter ) +/* Alternate CA-Cl*pper compatible call: + RETURN __dbDelim( .T., cFile, cDelimiter, aFields, bFor, bWhile, nNext, nRecord, lRest ) */ + ENDCASE + + RETURN __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, cXPP_Driver ) + +#endif diff --git a/harbour/source/rdd/dbjoin.prg b/harbour/source/rdd/dbjoin.prg new file mode 100644 index 0000000000..c2d75ea219 --- /dev/null +++ b/harbour/source/rdd/dbjoin.prg @@ -0,0 +1,180 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * __DBJOIN() function + * + * Copyright 2005 Pavel Tsarenko + * 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 "hbsetup.ch" + +#include "dbstruct.ch" + +/* NOTE: Compared to CA-Cl*pper, Harbour has three extra parameters + (cRDD, nConnection, cCodePage). */ + +FUNCTION __dbJoin( cAlias, cFile, aFields, bFor, cRDD, nConnection, cCodePage ) + LOCAL nMaster := Select() + LOCAL nDetail := Select( cAlias ) + LOCAL nResult + LOCAL aStruct + LOCAL aJoinList + + LOCAL oError + LOCAL lError := .F. + + dbSelectArea( nMaster ) + IF Empty( aStruct := __FieldTwo( cAlias, aFields ) ) + RETURN .F. + ENDIF + + BEGIN SEQUENCE + + dbCreate( cFile, aStruct, cRDD, .T., "", NIL, cCodePage, nConnection ) + nResult := Select() + aJoinList := __JoinList( nMaster, nDetail, nResult, aStruct ) + + dbSelectArea( nMaster ) + dbGoTop() + DO WHILE !Eof() + + dbSelectArea( nDetail ) + dbGoTop() + DO WHILE !Eof() + + dbSelectArea( nMaster ) + IF Eval( bFor ) + __doJoinList( aJoinList ) + ENDIF + + dbSelectArea( nDetail ) + dbSkip() + ENDDO + + dbSelectArea( nMaster ) + dbSkip() + ENDDO + + RECOVER USING oError + lError := .T. + END SEQUENCE + + IF nResult != NIL + dbSelectArea( nResult ) + dbCloseArea() + ENDIF + + dbSelectArea( nMaster ) + + IF lError + Break( oError ) + ENDIF + + RETURN .T. + +STATIC FUNCTION __FieldTwo( cAlias, aFields ) + LOCAL aFldTemp + LOCAL bFind + LOCAL aStruct + LOCAL cField + + IF Empty( aFields ) + RETURN dbStruct() + ENDIF + + aFldTemp := {} + AEval( aFields, {| cFld | AAdd( aFldTemp, Trim( Upper( cFld ) ) ) } ) + + aFields := aFldTemp + + aStruct := {} + bFind := {| cFld | cFld == cField } + AEval( dbStruct(), {| aFld | cField := aFld[ DBS_NAME ],; + iif( AScan( aFields, bFind ) == 0, NIL, AAdd( aStruct, aFld ) ) } ) + + Select( cAlias ) + bFind := {| cFld | "->" $ cFld .AND. SubStr( cFld, At( "->", cFld ) + 2 ) == cField } + AEval( dbStruct(), {| aFld | cField := aFld[ DBS_NAME ],; + iif( AScan( aFields, bFind ) == 0, NIL, AAdd( aStruct, aFld ) ) } ) + + RETURN aStruct + +STATIC FUNCTION __JoinList( nMaster, nDetail, nResult, aStruct ) + LOCAL aList := {} + LOCAL nPos + LOCAL i + + FOR i := 1 TO Len( aStruct ) + IF ( nPos := ( nMaster )->( FieldPos( aStruct[ i ][ DBS_NAME ] ) ) ) != 0 + AAdd( aList, { nResult, nMaster, nPos, i } ) + ELSEIF ( nPos := ( nDetail )->( FieldPos( aStruct[ i ][ DBS_NAME ] ) ) ) != 0 + AAdd( aList, { nResult, nDetail, nPos, i } ) + ENDIF + NEXT + + RETURN aList + +STATIC PROCEDURE __doJoinList( aList ) + LOCAL aJoin + + IF Len( aList ) > 0 + + ( aList[ 1 ][ 1 ] )->( dbAppend() ) + + FOR EACH aJoin IN aList + ( aJoin[ 1 ] )->( FieldPut( aJoin[ 4 ], ( aJoin[ 2 ] )->( FieldGet( aJoin[ 3 ] ) ) ) ) + NEXT + ENDIF + + RETURN + +#ifdef HB_COMPAT_XPP + +FUNCTION dbJoin( cAlias, cFile, aFields, bFor ) + RETURN __dbJoin( cAlias, cFile, aFields, bFor ) + +#endif diff --git a/harbour/source/rdd/dblist.prg b/harbour/source/rdd/dblist.prg index 8a229d271a..1aad20cfce 100644 --- a/harbour/source/rdd/dblist.prg +++ b/harbour/source/rdd/dblist.prg @@ -48,20 +48,13 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. * - * The following parts are Copyright of the individual authors. - * www - http://www.harbour-project.org - * - * Copyright 2000 RonPinkas - * HB_aExpressions() - * */ -/* NOTE: lAll is basically a dummy parameter, nothing really depends on it. - [vszakats] */ +#include "hbsetup.ch" -#include "set.ch" +/* NOTE: lAll is a dummy parameter, nothing seems to depend on it. [vszakats] */ -FUNCTION __dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToPrint, cToFileName ) +PROCEDURE __dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToPrint, cToFileName ) LOCAL lOldPrinter LOCAL lOldExtra @@ -71,44 +64,17 @@ FUNCTION __dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToP LOCAL cExt LOCAL oError + LOCAL lError := .F. LOCAL bOutBlock - LOCAL nLen := Len( abEval ), nIndex, asMacros, nMacros, nMacroIndex - - // Scan for strings instead of blocks - These are macros that need to be compiled into blocks. - FOR nIndex := 1 TO nLen - IF ValType( abEval[ nIndex ] ) == 'C' - //? abEval[ nIndex ] - // Macro may be a comma seperated list. - asMacros := HB_aExpressions( abEval[ nIndex ] ) - nMacros := Len( asMacros ) - - // Array has to be sized to allow dor the extra blocks - nLen += ( nMacros - 1 ) - aSize( abEval, nLen ) - - // We will use the place holder of the string for the first new block. - abEval[ nIndex ] := &( "{||" + asMacros[ 1 ] + "}" ) - - // We will now push all subsequent blocks 1 at a time and insert the new block inplace. - FOR nMacroIndex := 2 TO nMacros - aIns( abEval, nIndex + nMacroIndex - 1 ) - abEval[ nIndex + nMacroIndex - 1 ] := &( "{||" + asMacros[ nMacroIndex ] + "}" ) - NEXT - - // The loop counter should skip the new elements. - nIndex += ( nMacros - 1 ) - ENDIF - NEXT - /* Choose the output style */ IF lOff bOutBlock := {|| QOut( iif( Deleted(), "*", " " ) ),; - aEval( abEval, {| bEval | QQOut( Eval( bEval ), "" ) } ) } + AEval( abEval, {| bEval | QQOut( Eval( bEval ), "" ) } ) } ELSE bOutBlock := {|| QOut( Str( RecNo(), 7 ), iif( Deleted(), "*", " " ) ),; - aEval( abEval, {| bEval | QQOut( Eval( bEval ), "" ) } ) } + AEval( abEval, {| bEval | QQOut( Eval( bEval ), "" ) } ) } ENDIF /* Save SETs */ @@ -122,7 +88,7 @@ FUNCTION __dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToP cExt := ".txt" ENDIF lOldExtra := Set( _SET_EXTRA, .T. ) - cOldExtraFile := Set( _SET_EXTRAFILE, hb_FNameMerge( @cPath, @cName, @cExt ) ) + cOldExtraFile := Set( _SET_EXTRAFILE, hb_FNameMerge( cPath, cName, cExt ) ) ENDIF /* Do the job */ @@ -142,9 +108,10 @@ FUNCTION __dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToP ENDIF RECOVER USING oError + lError := .T. END SEQUENCE - /* Restor SETs */ + /* Restore SETs */ IF !Empty( lToPrint ) Set( _SET_PRINTER, lOldPrinter ) @@ -156,8 +123,15 @@ FUNCTION __dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToP /* On error signal the error for the higher level error handler or quit */ - IF oError != NIL + IF lError Break( oError ) ENDIF -RETURN NIL + RETURN + +#ifdef HB_COMPAT_XPP + +FUNCTION dbList( lOff, abEval, lAll, bFor, bWhile, nNext, nRecord, lRest, lToPrint, cToFileName ) + RETURN __dbList( abEval, lOff, lAll, bFor, bWhile, nNext, nRecord, lRest, lToPrint, cToFileName ) + +#endif diff --git a/harbour/source/rdd/dbsdf.prg b/harbour/source/rdd/dbsdf.prg new file mode 100644 index 0000000000..eb4c2f5dd4 --- /dev/null +++ b/harbour/source/rdd/dbsdf.prg @@ -0,0 +1,63 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Copies the contents of a database to an SDF text file. + * Appends the contents of an SDF text file to a database. + * + * Copyright 2001-2002 David G. Holm + * www - http://www.harbour-project.org + * + * Copyright 2006 Przemyslaw Czerpak + * function __dbSDF() replaced by the new one which uses + * SDF RDD I've just created + * + * 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. + * + */ + +REQUEST SDF + +FUNCTION __dbSDF( lExport, cFile, aFields, bFor, bWhile, nNext, nRecord, lRest ) + RETURN iif( lExport,; + __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "SDF" ) ,; + __dbApp( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "SDF" ) ) diff --git a/harbour/source/rdd/dbsort.prg b/harbour/source/rdd/dbsort.prg index 323f2b324f..c8ff63dddb 100644 --- a/harbour/source/rdd/dbsort.prg +++ b/harbour/source/rdd/dbsort.prg @@ -50,14 +50,21 @@ * */ +#include "hbsetup.ch" + +/* NOTE: Compared to CA-Cl*pper, Harbour has three extra parameters + (cRDD, nConnection, cCodePage). */ + FUNCTION __dbSort( cToFileName, aFields, bFor, bWhile, nNext, nRecord, lRest,; - cRddName, nConnection, cdpId ) - LOCAL nArea + cRDD, nConnection, cCodePage ) + LOCAL nOldArea LOCAL nToArea LOCAL aStruct - LOCAL oError - nArea := Select() + LOCAL oError + LOCAL lError := .F. + + nOldArea := Select() aStruct := dbStruct() IF Empty( aStruct ) @@ -66,12 +73,13 @@ FUNCTION __dbSort( cToFileName, aFields, bFor, bWhile, nNext, nRecord, lRest,; BEGIN SEQUENCE - dbCreate( cToFileName, aStruct, cRddName, .T., "", , cdpID, nConnection ) + dbCreate( cToFileName, aStruct, cRDD, .T., "", NIL, cCodePage, nConnection ) nToArea := Select() - dbSelectArea( nArea ) + dbSelectArea( nOldArea ) __dbArrange( nToArea, aStruct, bFor, bWhile, nNext, nRecord, lRest, aFields ) RECOVER USING oError + lError := .T. END SEQUENCE IF nToArea != NIL @@ -79,10 +87,17 @@ FUNCTION __dbSort( cToFileName, aFields, bFor, bWhile, nNext, nRecord, lRest,; dbCloseArea() ENDIF - dbSelectArea( nArea ) + dbSelectArea( nOldArea ) - IF oError != NIL + IF lError Break( oError ) ENDIF RETURN .T. + +#ifdef HB_COMPAT_XPP + +FUNCTION dbSort( cToFileName, aFields, bFor, bWhile, nNext, nRecord, lRest ) + RETURN __dbSort( cToFileName, aFields, bFor, bWhile, nNext, nRecord, lRest ) + +#endif diff --git a/harbour/source/rdd/dbstrux.prg b/harbour/source/rdd/dbstrux.prg index 283ee99eba..98ec2a12c9 100644 --- a/harbour/source/rdd/dbstrux.prg +++ b/harbour/source/rdd/dbstrux.prg @@ -60,9 +60,11 @@ FUNCTION __dbCopyStruct( cFileName, aFieldList ) FUNCTION __dbCopyXStruct( cFileName ) LOCAL nOldArea - LOCAL oError LOCAL aStruct + LOCAL oError + LOCAL lError := .F. + IF Empty( aStruct := dbStruct() ) RETURN .F. ENDIF @@ -72,21 +74,20 @@ FUNCTION __dbCopyXStruct( cFileName ) BEGIN SEQUENCE dbSelectArea( 0 ) - __dbCreate( cFileName, NIL, NIL, .F., "" ) + __dbCreate( cFileName, NIL, NIL, .F., NIL ) - AEval( aStruct, {| aField | iif( aField[ DBS_TYPE ] == "C" .AND. aField[ DBS_LEN ] > 255, ; - ( aField[ DBS_DEC ] := Int( aField[ DBS_LEN ] / 256 ), aField[ DBS_LEN ] := aField[ DBS_LEN ] % 256 ), NIL ) } ) - - AEval( aStruct, {| aField | dbAppend(),; + AEval( aStruct, {| aField | iif( aField[ DBS_TYPE ] == "C" .AND. aField[ DBS_LEN ] > 255,; + ( aField[ DBS_DEC ] := Int( aField[ DBS_LEN ] / 256 ), aField[ DBS_LEN ] := aField[ DBS_LEN ] % 256 ), NIL ),; + dbAppend(),; FIELD->FIELD_NAME := aField[ DBS_NAME ],; FIELD->FIELD_TYPE := aField[ DBS_TYPE ],; - FIELD->FIELD_LEN := aField[ DBS_LEN ], ; + FIELD->FIELD_LEN := aField[ DBS_LEN ],; FIELD->FIELD_DEC := aField[ DBS_DEC ] } ) /* NOTE: CA-Cl*pper has a bug, where only a plain RECOVER statement is - used here (without the USING keyword), so oError will always be - NIL. */ + used here (without the USING keyword), so oError will always be NIL. */ RECOVER USING oError + lError := .T. END SEQUENCE IF Select() != nOldArea @@ -94,20 +95,28 @@ FUNCTION __dbCopyXStruct( cFileName ) dbSelectArea( nOldArea ) ENDIF - IF oError != NIL + IF lError Break( oError ) ENDIF RETURN .T. -FUNCTION __dbCreate( cFileName, cFileFrom, cRDDName, lNew, cAlias, cdpId, nConnection ) +/* NOTE: Compared to CA-Cl*pper, Harbour has two extra parameters + (cCodePage, nConnection). */ + +FUNCTION __dbCreate( cFileName, cFileFrom, cRDD, lNew, cAlias, cCodePage, nConnection ) LOCAL nOldArea := Select() LOCAL aStruct := {} + LOCAL oError DEFAULT lNew TO .F. - IF Used() .AND. ! lNew + IF cAlias == NIL + hb_FNameSplit( cFileName, NIL, @cAlias ) + ENDIF + + IF Used() .AND. !lNew dbCloseArea() ENDIF @@ -119,15 +128,13 @@ FUNCTION __dbCreate( cFileName, cFileFrom, cRDDName, lNew, cAlias, cdpId, nConne { "FIELD_TYPE", "C", 1, 0 },; { "FIELD_LEN" , "N", 3, 0 },; { "FIELD_DEC" , "N", 3, 0 } },; - cRDDName,,,, cdpId, nConnection ) - dbUseArea( .F., cRDDName, cFileName, cAlias,,, cdpId, nConnection ) - + cRDD, .F., cAlias, NIL, cCodePage, nConnection ) ELSE + dbUseArea( lNew, NIL, cFileFrom, "" ) - dbUseArea( lNew,, cFileFrom, "" ) - - dbEval( {|| AAdd( aStruct, { Rtrim(FIELD->FIELD_NAME) ,; - Rtrim(FIELD->FIELD_TYPE) ,; + /* ; Harbour does some extra RTrim()-ing here. */ + dbEval( {|| AAdd( aStruct, { RTrim( FIELD->FIELD_NAME ) ,; + RTrim( FIELD->FIELD_TYPE ) ,; FIELD->FIELD_LEN ,; FIELD->FIELD_DEC } ) } ) dbCloseArea() @@ -136,12 +143,11 @@ FUNCTION __dbCreate( cFileName, cFileFrom, cRDDName, lNew, cAlias, cdpId, nConne dbSelectArea( nOldArea ) ENDIF - AEval( aStruct, {| aField | iif( aField[ DBS_TYPE ] == "C" .AND. aField[ DBS_DEC ] != 0, ; - ( aField[ DBS_LEN ] += aField[ DBS_DEC ] * 256, ; + AEval( aStruct, {| aField | iif( aField[ DBS_TYPE ] == "C" .AND. aField[ DBS_DEC ] != 0,; + ( aField[ DBS_LEN ] += aField[ DBS_DEC ] * 256,; aField[ DBS_DEC ] := 0 ), NIL ) } ) - dbCreate( cFileName, aStruct, cRDDName,,,, cdpId, nConnection ) - dbUseArea( lNew, cRDDName, cFileName, cAlias,,, cdpId, nConnection ) + dbCreate( cFileName, aStruct, cRDD, lNew, cAlias, NIL, cCodePage, nConnection ) ENDIF @@ -178,8 +184,20 @@ FUNCTION __dbStructFilter( aStruct, aFieldList ) bFindName := {| aField | aField[ DBS_NAME ] == cName } AEval( aFieldList, {| cFieldName, nIndex | ; - cName := RTrim( Upper( cFieldName ) ), ; - nIndex := aScan( aStruct, bFindName ),; + cName := RTrim( Upper( cFieldName ) ),; + nIndex := AScan( aStruct, bFindName ),; iif( nIndex == 0, NIL, AAdd( aStructFiltered, aStruct[ nIndex] ) ) } ) RETURN aStructFiltered + +#ifdef HB_COMPAT_XPP + +/* Identical to __dbCopyStruct() */ + +FUNCTION dbCopyStruct( cFileName, aFieldList ) + RETURN dbCreate( cFileName, __dbStructFilter( dbStruct(), aFieldList ) ) + +FUNCTION dbCopyExtStruct( cFileName ) + RETURN __dbCopyXStruct( cFileName ) + +#endif diff --git a/harbour/source/rdd/dbtotal.prg b/harbour/source/rdd/dbtotal.prg index 661a2dd297..1c3a7654e4 100644 --- a/harbour/source/rdd/dbtotal.prg +++ b/harbour/source/rdd/dbtotal.prg @@ -50,20 +50,22 @@ * */ +#include "hbsetup.ch" + #include "common.ch" #include "dbstruct.ch" #include "error.ch" /* NOTE: Compared to CA-Cl*pper, Harbour: - will accept character expressions for xKey, xFor and xWhile. - - has two extra parameters (nConnection, cpdId). - - will defuault to active index key for xKey parameter. - - has more error handling. -*/ + - has three extra parameters (cRDD, nConnection, cCodePage). + - will default to active index key for xKey parameter. + - won't crash with "No exported method: EVAL" if xKey is not + block and table is not indexed. */ -FUNCTION __dbTotal( cFile, xKey, aFields, ; - xFor, xWhile, nNext, nRec, lRest, cRDD, ; - nConnection, cdpId ) +FUNCTION __dbTotal( cFile, xKey, aFields,; + xFor, xWhile, nNext, nRec, lRest,; + cRDD, nConnection, cCodePage ) LOCAL nOldArea LOCAL nNewArea @@ -74,29 +76,29 @@ FUNCTION __dbTotal( cFile, xKey, aFields, ; LOCAL lDbTransRecord LOCAL xCurKey - LOCAL bKeyBlock - LOCAL bForBlock LOCAL bWhileBlock + LOCAL bForBlock + LOCAL bKeyBlock - LOCAL lError := .F. - LOCAL bOldError LOCAL oError + LOCAL lError := .F. - IF ValType( xWhile ) == "C" + IF ISCHARACTER( xWhile ) bWhileBlock := &("{||" + xWhile + "}") - ELSEIF ValType( xWhile ) != "B" - bWhileBlock := {|| .T. } - ELSE + lRest := .T. + ELSEIF ISBLOCK( xWhile ) bWhileBlock := xWhile lRest := .T. + ELSE + bWhileBlock := {|| .T. } ENDIF - IF ValType( xFor ) == "C" + IF ISCHARACTER( xFor ) bForBlock := &("{||" + xFor + "}") - ELSEIF ValType( xFor ) != "B" - bForBlock := {|| .T. } - ELSE + ELSEIF ISBLOCK( xFor ) bForBlock := xFor + ELSE + bForBlock := {|| .T. } ENDIF DEFAULT lRest TO .F. @@ -123,35 +125,26 @@ FUNCTION __dbTotal( cFile, xKey, aFields, ; RETURN .F. ENDIF - bOldError := ErrorBlock( {| x | Break( x ) } ) - BEGIN SEQUENCE IF Empty( xKey ) - xKey := IndexKey() - - IF Empty( xKey ) - oError := ErrorNew() - oError:description := "Invalid argument" - oError:genCode := EG_ARG - Break( oError ) - ENDIF + xKey := ordKey() ENDIF - IF ValType( xKey ) == "C" + IF ISCHARACTER( xKey ) bKeyBlock := &("{||" + xKey + "}") - ELSEIF ValType( xKey ) != "B" - bKeyBlock := {|| .T. } - ELSE + ELSEIF ISBLOCK( xKey ) bKeyBlock := xKey + ELSE + bKeyBlock := {|| .T. } ENDIF aGetField := {} - AEval( aFields, {| cField | AAdd( aGetField, GetField( cField ) ) } ) + AEval( aFields, {| cField | AAdd( aGetField, __GetField( cField ) ) } ) aFieldsSum := Array( Len( aGetField ) ) - // ; Keep it open after creating it. - dbCreate( cFile, aNewDbStruct, cRDD, .T., "", NIL, cdpId, nConnection ) + /* ; Keep it open after creating it. */ + dbCreate( cFile, aNewDbStruct, cRDD, .T., "", NIL, cCodePage, nConnection ) nNewArea := Select() dbSelectArea( nOldArea ) @@ -188,7 +181,7 @@ FUNCTION __dbTotal( cFile, xKey, aFields, ; RECOVER USING oError lError := .T. - ENDSEQUENCE + END SEQUENCE IF nNewArea != NIL dbSelectArea( nNewArea ) @@ -196,25 +189,20 @@ FUNCTION __dbTotal( cFile, xKey, aFields, ; ENDIF dbSelectArea( nOldArea ) - ErrorBlock( bOldError ) IF lError - IF ValType( oError:operation ) == "C" - oError:operation += "/__DBTOTAL" - ELSE - oError:operation := "__DBTOTAL" - ENDIF - Eval( ErrorBlock(), oError ) + Break( oError ) ENDIF RETURN .T. -STATIC FUNCTION GetField( cField ) +STATIC FUNCTION __GetField( cField ) LOCAL nCurrArea := Select() LOCAL nPos LOCAL oError LOCAL lError + /* ; Is the field aliased? */ IF ( nPos := At( "->", cField ) ) > 0 IF Select( Left( cField, nPos - 1 ) ) != nCurrArea @@ -228,7 +216,7 @@ STATIC FUNCTION GetField( cField ) oError:subCode := 1101 lError := Eval( ErrorBlock(), oError ) - IF ValType( lError ) != "L" .OR. lError + IF !ISLOGICAL( lError ) .OR. lError __ErrInHandler() ENDIF @@ -243,3 +231,10 @@ STATIC FUNCTION GetField( cField ) FUNCTION __dbTransRec( nDstArea, aFieldsStru ) RETURN __dbTrans( nDstArea, aFieldsStru, NIL, NIL, 1 ) + +#ifdef HB_COMPAT_XPP + +FUNCTION dbTotal( cFile, xKey, aFields, xFor, xWhile, nNext, nRec, lRest ) + RETURN __dbTotal( cFile, xKey, aFields, xFor, xWhile, nNext, nRec, lRest ) + +#endif diff --git a/harbour/source/rdd/dbupdat.prg b/harbour/source/rdd/dbupdat.prg index 0cf91056e3..17cf5f84dd 100644 --- a/harbour/source/rdd/dbupdat.prg +++ b/harbour/source/rdd/dbupdat.prg @@ -50,6 +50,8 @@ * */ +#include "hbsetup.ch" + #include "common.ch" FUNCTION __dbUpdate( cAlias, bKey, lRandom, bAssign ) @@ -57,6 +59,7 @@ FUNCTION __dbUpdate( cAlias, bKey, lRandom, bAssign ) LOCAL xKey LOCAL oError + LOCAL lError := .F. DEFAULT lRandom TO .F. @@ -90,12 +93,20 @@ FUNCTION __dbUpdate( cAlias, bKey, lRandom, bAssign ) ENDDO RECOVER USING oError + lError := .T. END SEQUENCE dbSelectArea( nOldArea ) - IF oError != NIL + IF lError Break( oError ) ENDIF RETURN .T. + +#ifdef HB_COMPAT_XPP + +FUNCTION dbUpdate( cAlias, bAssign, bKey, lRandom ) + RETURN __dbUpdate( cAlias, bKey, lRandom, bAssign ) + +#endif diff --git a/harbour/source/rdd/rddord.prg b/harbour/source/rdd/rddord.prg index 0d95049cd1..7817fe18bc 100644 --- a/harbour/source/rdd/rddord.prg +++ b/harbour/source/rdd/rddord.prg @@ -50,6 +50,8 @@ * */ +#include "hbsetup.ch" + #include "common.ch" #include "dbinfo.ch" @@ -67,7 +69,7 @@ FUNCTION dbClearIndex() FUNCTION dbReindex() RETURN ordListRebuild() -FUNCTION dbSetOrder( nOrderNum ) +PROCEDURE dbSetOrder( nOrderNum ) IF ISCHARACTER( nOrderNum ) .AND. !Empty( Val( nOrderNum ) ) nOrderNum := Val( nOrderNum ) @@ -75,7 +77,7 @@ FUNCTION dbSetOrder( nOrderNum ) ordSetFocus( nOrderNum ) - RETURN NIL + RETURN FUNCTION IndexExt() RETURN ordBagExt() @@ -92,18 +94,19 @@ FUNCTION IndexKey( nOrder ) RETURN "" -FUNCTION OrdSetRelation( xArea, bRelation, cRelation ) +FUNCTION ordSetRelation( xArea, bRelation, cRelation ) RETURN dbSetRelation( xArea, bRelation, cRelation, .T. ) -/* short (10 chars long) version of some ord* functions for compatibility */ -FUNCTION ORDLISTCLE() - RETURN ORDLISTCLEAR() +/* NOTE: Undocumented Clipper function */ -FUNCTION ORDLISTREB() - RETURN ORDLISTREBUILD() +#ifdef HB_C52_UNDOC +#ifdef HB_C52_STRICT -FUNCTION ORDSETFOCU( xOrder, cFile ) - RETURN ORDSETFOCUS( xOrder, cFile ) +FUNCTION _dtxCondSet( cFor, bFor, lAll, bWhile, bEval, nEvery, xDummy, nRecNo, nNext, nRecord, lRest ) -FUNCTION ORDSETRELA( xArea, bRelation, cRelation ) - RETURN ORDSETRELATION( xArea, bRelation, cRelation ) + HB_SYMBOL_UNUSED( xDummy ) + + RETURN ordCondSet( cFor, bFor, lAll, bWhile, bEval, nEvery, nRecNo, nNext, nRecord, lRest ) + +#endif +#endif diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 33e63d6f27..cb12193b3d 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -5,185 +5,182 @@ ROOT = ../../ C_SOURCES=\ - abs.c \ - accept.c \ - ampm.c \ - at.c \ - binnum.c \ - binnumx.c \ - box.c \ - cdpapi.c \ - chrasc.c \ - colorind.c \ - console.c \ - copyfile.c \ - datec.c \ - dates.c \ - dateshb.c \ - datesx.c \ - defpath.c \ - descend.c \ - dirdrive.c \ - direct.c \ - diskspac.c \ - disksphb.c \ - do.c \ - empty.c \ - errorapi.c \ - errorint.c \ - file.c \ - filehb.c \ - filesys.c \ - fkmax.c \ - fnsplit.c \ - fserror.c \ - fssize.c \ - fstemp.c \ - gete.c \ - gt.c \ - gtapi.c \ - gtclip.c \ - gtsys.c \ - gttone.c \ - gtfunc.c \ - gx.c \ - hardcr.c \ - hbffind.c \ - hbgtcore.c \ - hbrandom.c \ - idle.c \ - inkey.c \ - is.c \ - isprint.c \ - langapi.c \ - left.c \ - len.c \ - lennum.c \ - math.c \ - maxrow.c \ - memofile.c \ - memoline.c \ - minmax.c \ - mlcount.c \ - mlctopos.c \ - mlpos.c \ - mod.c \ - mouseapi.c \ - mousex.c \ - mpostolc.c \ - mtran.c \ - natmsg.c \ - net.c \ - oemansi.c \ - oldbox.c \ - oldclear.c \ - pad.c \ - padc.c \ - padl.c \ - padr.c \ - philes.c \ - philes53.c \ - philesx.c \ - rat.c \ - replic.c \ - right.c \ - round.c \ - run.c \ - samples.c \ - saverest.c \ - scroll.c \ - seconds.c \ - set.c \ - setcolor.c \ - setcurs.c \ - setkey.c \ - setpos.c \ - setposbs.c \ - shadow.c \ - soundex.c \ - space.c \ - spfiles.c \ - str.c \ - strcase.c \ - strings.c \ - strmatch.c \ - strpeek.c \ - strtran.c \ - strzero.c \ - stuff.c \ - substr.c \ - teditorl.c \ - tone.c \ - trace.c \ - transfrm.c \ - trim.c \ - type.c \ - val.c \ - valtostr.c \ - valtype.c \ - version.c \ - word.c \ - xhelp.c \ - xsavescr.c \ + abs.c \ + accept.c \ + ampm.c \ + at.c \ + binnum.c \ + binnumx.c \ + box.c \ + cdpapi.c \ + chrasc.c \ + colorind.c \ + console.c \ + copyfile.c \ + datec.c \ + dates.c \ + dateshb.c \ + datesx.c \ + defpath.c \ + descend.c \ + dirdrive.c \ + direct.c \ + diskspac.c \ + disksphb.c \ + do.c \ + empty.c \ + errorapi.c \ + errorint.c \ + file.c \ + filehb.c \ + filesys.c \ + fkmax.c \ + fnsplit.c \ + fserror.c \ + fssize.c \ + fstemp.c \ + gete.c \ + gt.c \ + gtapi.c \ + gtclip.c \ + gtsys.c \ + gttone.c \ + gtfunc.c \ + gx.c \ + hardcr.c \ + hbffind.c \ + hbgtcore.c \ + hbrandom.c \ + idle.c \ + inkey.c \ + is.c \ + isprint.c \ + langapi.c \ + left.c \ + len.c \ + lennum.c \ + math.c \ + maxrow.c \ + memofile.c \ + memoline.c \ + minmax.c \ + mlcount.c \ + mlctopos.c \ + mlpos.c \ + mod.c \ + mouseapi.c \ + mousex.c \ + mpostolc.c \ + mtran.c \ + natmsg.c \ + net.c \ + oemansi.c \ + oldbox.c \ + oldclear.c \ + pad.c \ + padc.c \ + padl.c \ + padr.c \ + philes.c \ + philes53.c \ + philesx.c \ + rat.c \ + replic.c \ + right.c \ + round.c \ + run.c \ + samples.c \ + saverest.c \ + scroll.c \ + seconds.c \ + set.c \ + setcolor.c \ + setcurs.c \ + setkey.c \ + setpos.c \ + setposbs.c \ + shadow.c \ + soundex.c \ + space.c \ + spfiles.c \ + str.c \ + strcase.c \ + strings.c \ + strmatch.c \ + strpeek.c \ + strtran.c \ + strzero.c \ + stuff.c \ + substr.c \ + teditorl.c \ + tone.c \ + trace.c \ + transfrm.c \ + trim.c \ + type.c \ + val.c \ + valtostr.c \ + valtype.c \ + version.c \ + word.c \ + xhelp.c \ + xsavescr.c \ PRG_SOURCES=\ - achoice.prg \ - adir.prg \ - altd.prg \ - alert.prg \ - browdb.prg \ - browdbx.prg \ - browse.prg \ - checkbox.prg \ - color53.prg \ - dbdelim.prg \ - dbedit.prg \ - dbjoin.prg \ - dbsdf.prg \ - devoutp.prg \ - dircmd.prg \ - dummy.prg \ - errorsys.prg \ - fieldbl.prg \ - getlist.prg \ - getsys.prg \ - input.prg \ - listbox.prg \ - memoedit.prg \ - memvarbl.prg \ - menuto.prg \ - mssgline.prg \ - objfunc.prg \ - perfuncs.prg \ - persist.prg \ - profiler.prg \ - pushbtn.prg \ - radiobtn.prg \ - radiogrp.prg \ - readkey.prg \ - readvar.prg \ - scrollbr.prg \ - setfunc.prg \ - setta.prg \ - symbol.prg \ - tclass.prg \ - tbcolumn.prg \ - tbrowse.prg \ - teditor.prg \ - terror.prg \ - text.prg \ - tget.prg \ - tgetint.prg \ - tgetlist.prg \ - tlabel.prg \ - tmenuitm.prg \ - tobject.prg \ - tpopup.prg \ - treport.prg \ - ttextlin.prg \ - ttopbar.prg \ - typefile.prg \ - wait.prg \ + achoice.prg \ + adir.prg \ + altd.prg \ + alert.prg \ + browdb.prg \ + browdbx.prg \ + browse.prg \ + checkbox.prg \ + color53.prg \ + dbedit.prg \ + devoutp.prg \ + dircmd.prg \ + dummy.prg \ + errorsys.prg \ + fieldbl.prg \ + getlist.prg \ + getsys.prg \ + input.prg \ + listbox.prg \ + memoedit.prg \ + memvarbl.prg \ + menuto.prg \ + mssgline.prg \ + objfunc.prg \ + perfuncs.prg \ + persist.prg \ + profiler.prg \ + pushbtn.prg \ + radiobtn.prg \ + radiogrp.prg \ + readkey.prg \ + readvar.prg \ + scrollbr.prg \ + setfunc.prg \ + setta.prg \ + symbol.prg \ + tclass.prg \ + tbcolumn.prg \ + tbrowse.prg \ + teditor.prg \ + terror.prg \ + text.prg \ + tget.prg \ + tgetint.prg \ + tgetlist.prg \ + tlabel.prg \ + tmenuitm.prg \ + tobject.prg \ + tpopup.prg \ + treport.prg \ + ttextlin.prg \ + ttopbar.prg \ + typefile.prg \ + wait.prg \ LIBNAME=rtl diff --git a/harbour/source/rtl/dbdelim.prg b/harbour/source/rtl/dbdelim.prg deleted file mode 100644 index c7a7c6780f..0000000000 --- a/harbour/source/rtl/dbdelim.prg +++ /dev/null @@ -1,440 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * Copies the contents of a database to a delimited text file. - * Appends the contents of a delimited text file to a database. - * - * Copyright 2001-2003 David G. Holm - * www - http://www.harbour-project.org - * APPEND FROM code submitted by Marco Braida - * - * Copyright 2006 Przemyslaw Czerpak - * function __dbDelim() replaced by the new one which uses - * DELIM RDD I've just created - * - * 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. - * - */ - -REQUEST DELIM - -PROCEDURE __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRecord, lRest ) - - IF lExport - __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "DELIM", , , cDelimArg ) - ELSE - __dbApp( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "DELIM", , , cDelimArg ) - ENDIF - -RETURN - - -#ifdef __DBDELIM_STRICT_CLIPPER_CODE__ -function __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRecord, lRest ) -local nSrcArea, nDstArea, aStruct, cRDD := "DELIM" - - if lExport - nSrcArea := Select() - else - nDstArea := Select() - endif - - if Empty( aStruct := __fledit( dbstruct(), aFields ) ) - return .F. - endif - - if lExport - dbcreate( cFile, aStruct, cRDD, .T., "", cDelimArg ) - nDstArea := Select() - if nDstArea == nSrcArea - nDstArea := Nil - endif - select( nSrcArea ) - else - if !__dbopensdf( cFile, aStruct, cRDD, .T., "", cDelimArg ) - return .F. - endif - nSrcArea := Select() - endif - - if nDstArea != nil - __dbtrans( nDstArea, aStruct, bFor, bWhile, nNext, nRecord, lRest ) - endif - - if lExport - if nDstArea != Nil - select( nDstArea ) - close - endif - select( nSrcArea ) - else - select( nSrcArea ) - close - select( nDstArea ) - endif - -return .T. - -#endif /* __DBDELIM_STRICT_CLIPPER_CODE__ */ - - -#ifdef __DBDELIM_OLD_CODE__ - -#include "hbcommon.ch" -#include "fileio.ch" -#include "error.ch" -#include "set.ch" - -HB_FILE_VER( "$Id$" ) - -#define AppendEOL( handle ) FWRITE( handle, CHR( 13 ) + CHR( 10 ) ) -#define AppendEOF( handle ) FWRITE( handle, CHR( 26 ) ) -#define AppendSep( handle, cSep ) FWRITE( handle, cSep ) - -PROCEDURE __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRecord, lRest ) - LOCAL index, handle, lWriteSep, cFileName := cFile, nStart, nCount, oErr - LOCAL cSeparator := ",", cDelim := CHR( 34 ) -//------------------ -local Pos:=0 -local nPosFl:=0 -local nDimBuff:=65535 -local cByte :="" -local lunghezze:={} -local eol:=chr(13)+chr(10) -local contacamp:=0 -local primariga:=.t. -local offset:=0 -local rig:=0 -local cont_r:="" -local Lfinefile:=.f. -local nFileLen -local cCharEol:=HB_OSNewLine() -local nLenEol:=LEN(cCharEol) -local nPosLasteol -local lcisonoeol -local lErrResult -//------------------ - // Process the delimiter argument. - IF !EMPTY( cDelimArg ) - IF UPPER( cDelimArg ) == "BLANK" - cDelim := "" - cSeparator := " " - ELSE - cDelim := LEFT( cDelimArg, 1 ) - END IF - END IF - - // Process the file name argument. - index := RAT( ".", cFileName ) - IF index > 0 - // The file name might include a file extension. - IF RAT( "/", cFileName ) > index ; - .OR. RAT( "\", cFileName ) > index - // No, the file extension is in a directory name. - index := 0 - END IF - END IF - IF index <= 0 - // No file name extension, so provide the default. - cFileName += ".txt" - END IF - - // Determine where to start and how many records to process. - IF nRecord != NIL - // The RECORD clause has the highest priority. - nStart := nRecord - nCount := 1 - ELSEIF nNext != NIL - // The NEXT clause has the next highest priority. - nStart := -1 - nCount := nNext - ELSEIF bWhile != NIL .OR. lRest - // The WHILE and REST clauses have equal priority. - nStart := -1 - nCount := -1 - ELSE - // Followed by the FOR clause or the ALL clause. - nStart := 0 - nCount := -1 - END IF - IF EMPTY( bFor ) - // This simplifies the test that determines whether or not to - // use (i.e., import or export) any given processed record. - bFor := {||.T.} - END IF - - IF lExport - // COPY TO DELIMITED - IF !USED() - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_NOTABLE - oErr:subSystem := "DELIM" - oErr:subCode := 2001 - oErr:description := HB_LANGERRMSG( oErr:genCode ) - oErr:canRetry := .F. - oErr:canDefault := .T. - Eval(ErrorBlock(), oErr) - handle := -1 - ELSE - WHILE ( handle := FCREATE( cFileName ) ) == -1 - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_CREATE - oErr:subSystem := "DELIM" - oErr:subCode := 1002 - oErr:description := HB_LANGERRMSG( oErr:genCode ) - oErr:canRetry := .T. - oErr:canDefault := .T. - oErr:fileName := cFileName - oErr:osCode := FERROR() - lErrResult := Eval(ErrorBlock(), oErr) - IF VALTYPE( lErrResult ) != "L" .OR. !lErrResult - EXIT - ENDIF - ENDDO - ENDIF - IF handle != -1 - IF nStart > -1 - // Only reposition if a starting record was specified or implied. - IF nStart == 0 - GO TOP - ELSE - GO (nStart) - END IF - END IF - IF EMPTY( bWhile ) - // This simplifies the looping logic. - bWhile := {||.T.} - END IF - // Set up for the start of the first record. - lWriteSep := .F. - // Process the records to copy delimited. - WHILE EVAL( bWhile ) .AND. ( nCount == -1 .OR. nCount > 0 ) ; - .AND. !BOF() .AND. !EOF() - IF EVAL( bFor ) - IF EMPTY( aFields ) - // Process all fields. - FOR index := 1 TO FCOUNT() - IF lWriteSep - AppendSep( handle, cSeparator ) - END IF - lWriteSep := ExportVar( handle, FIELDGET( index ), cDelim ) - NEXT index - ELSE - // Process the specified fields. - FOR index := 1 TO LEN( aFields ) - IF lWriteSep - AppendSep( handle, cSeparator ) - END IF - lWriteSep := ExportVar( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ), cDelim ) - NEXT index - END IF - // Set up for the start of the next record. - AppendEOL( handle ) - lWriteSep := .F. - END IF - IF nCount != -1 - nCount-- - END IF - SKIP - END WHILE - IF SET(_SET_EOF) - AppendEOF( handle ) - END IF - FCLOSE( handle ) - END IF - ELSE - // APPEND FROM DELIMITED - handle := FOPEN( cFileName ) - IF handle == -1 - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_OPEN - oErr:subSystem := "DELIM" - oErr:subCode := 1001 - oErr:description := HB_LANGERRMSG( oErr:genCode ) - oErr:canRetry := .T. - oErr:canDefault := .T. - oErr:fileName := cFileName - oErr:osCode := FERROR() - Eval(ErrorBlock(), oErr) - ELSE - IF EMPTY( bWhile ) - // This simplifies the looping logic. - bWhile := {||.T.} - ENDIF - // --------------------------------------- - // Please fill with the other test here - // Marco Braida 2002 - // marcobra@elart.it - // --------------------------------------- - - nFileLen:=FSEEK(handle,0,FS_END) - nDimBuff:=min(nFileLen,nDimBuff) - cByte:=space(nDimBuff) - FSEEK(handle,0) -// cCharEol:=chr(13) - nPosLastEol:=0 - do while .not. lFineFile - fseek(handle,nPoslastEol,FS_SET) // forward the pointer - //we must not go after the eof - if nPosLastEol + nDimBuff > nFileLen - // change the buffer size - nDimBuff:=nFileLen-nPosLastEol - cByte:=space(nDimBuff) - Lfinefile:=.t. - endif - // fill the buffer - cByte:=space(nDimBuff) - fread(handle,@cByte,nDimBuff) - // with +1 there is a problem on large import of data - // for now we keep it remmed - // please test and test and test - nPoslastEol+=rat(cCharEol,cByte) // +1 - //do this if in the buffer there are eol char - lcisonoeol:=.t. - do while lcisonoeol - // the position of the first eol - nposfl:=at(cCharEol,cByte) - lcisonoeol:=(nPosfl>0) - if lcisonoeol - // cut the row - Pos:=1 - cont_r:=substr(cByte,Pos,nposfl-Pos) - appendtodb(cont_r,cSeparator,cDelim) - // skipping the line feed and now we are on a good char - pos:=nposfl+nLenEol - cont_r:="" - //cut the row - cByte:=substr(cByte,Pos) - endif - enddo - enddo - FCLOSE( handle ) - END IF - - END IF -RETURN - -STATIC FUNCTION ExportVar( handle, xField, cDelim ) - DO CASE - CASE VALTYPE( xField ) == "C" - FWRITE( handle, cDelim + TRIM( xField ) + cDelim ) - CASE VALTYPE( xField ) == "D" - FWRITE( handle, DTOS( xField ) ) - CASE VALTYPE( xField ) == "L" - FWRITE( handle, iif( xField, "T", "F" ) ) - CASE VALTYPE( xField ) == "N" - FWRITE( handle, LTRIM( STR( xField ) ) ) - OTHERWISE - RETURN .F. - END CASE -RETURN .T. - - -STATIC FUNCTION appendtodb(row,cSeparator,cDelim) -local lenrow:=len(row) -local aStruct:=DBSTRUCT() -local aMyVal:={} -local ii:=1 -local nPosSep:=0, nPosNextSep:=0 -local nDBFFields -local cBuffer, cUPbuffer -local vRes -local nPos1Deli, nPos2Deli -//if there is one field only there is no Separator and i put... -row:=row+cSeparator -nPosSep:=1 -nPosNextSep:=at(cSeparator,row) // seek the first Separator eg. , -nPos1Deli:=at(cDelim,row) // seek the first delimiter " -nPos2Deli:=at(cDelim+cSeparator,row,nPos1Deli+1) // seek the second delimiter " -if nPos1Deli > 0 .and. nPos2Deli > 0 - if nPosNextSep>nPos1Deli .and. nPosNextSep 0 .and. nPos2Deli > 0 - if nPosNextSep>nPos1Deli .and. nPosNextSeplenrow - exit - endif -enddo -nDBFfields:=min(len(aMyVal),len(aStruct)) -append blank - -for ii:=1 to nDBFfields - cBuffer:=strtran(aMyval[ii],cDelim,'') - DO CASE - CASE aStruct[ ii,2 ] == "D" - vRes := HB_STOD( cBuffer ) - CASE aStruct[ ii,2 ] == "L" - cUPbuffer:=upper(cBuffer) - vRes := iif( cUPBuffer == "T" .or. cUPBuffer== "1" .or. cUPBuffer=="Y",.T.,.F. ) - CASE aStruct[ ii,2 ] == "N" - vRes := VAL( cBuffer ) - OTHERWISE - vRes := cBuffer - END CASE - - FIELDPUT(ii,vRes) -next -return .T. - -#endif /* __DBDELIM_OLD_CODE__ */ diff --git a/harbour/source/rtl/dbjoin.prg b/harbour/source/rtl/dbjoin.prg deleted file mode 100644 index e153aa1868..0000000000 --- a/harbour/source/rtl/dbjoin.prg +++ /dev/null @@ -1,144 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * __DBJOIN() function - * - * Copyright 2005 Pavel Tsarenko - * 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. - * - */ - - -Function __dbJoin( cAlias, cFile, aFields, bFor, cRdd, nConnection, cdpId ) -Local nMaster := Select() -Local nDetail := Select(cAlias) -Local nResult, aStruct, aJoinList, oError, lError := .F. - -Select(nMaster) -if ( Empty(aStruct := FieldTwo(cAlias, aFields)) ) - return .F. -endif - -begin sequence - - dbCreate(cFile, aStruct, cRdd, .T., "", , cdpId, nConnection) - nResult := Select() - aJoinList := __JoinList(nMaster, nDetail, nResult, aStruct) - - Select(nMaster) - go top - do while ! Eof() - Select(nDetail) - go top - do while ! Eof() - Select(nMaster) - if Eval(bFor) - __doJoinList(aJoinList) - endif - Select(nDetail) - skip - enddo - Select(nMaster) - Skip - enddo -recover using oError - lError := .T. -end sequence - -if nResult != nil - Select(nResult) - close -endif -Select(nMaster) -if lError - break( oError ) -endif -return .T. - - -static function FieldTwo( cAlias, aFields ) - -Local aFldTemp, bFind, cField, aStruct - -if Empty(aFields) - return dbStruct() -endif -aFldTemp := {} -AEval(aFields, { |cFld| AAdd(aFldTemp, Trim(Upper(cFld))) }) -aFields := aFldTemp -aStruct := {} -bFind := { |c| c == cField } -AEval(dbStruct(), { |a| ( cField := a[1], iif( ascan(aFields, bFind) == 0,; - nil, AAdd(aStruct, a) ) ) }) -select(cAlias) -bFind := { |cFld| "->" $ cFld .AND. SubStr(cFld, At("->", cFld) + 2) == ; - cField } -AEval(dbStruct(), { |a| ( cField := a[ 1 ], iif( AScan(aFields, bFind) == 0,; - nil, AAdd(aStruct, a) ) ) }) -return aStruct - - -static function __JoinList(nMaster, nDetail, nResult, aStruct) -Local i, aList := {}, nPos -for i := 1 to len(aStruct) - if ( nPos := (nMaster)->(FieldPos(aStruct[i][1])) ) # 0 - AAdd(aList, {nResult, nMaster, nPos, i}) - elseif ( nPos := (nDetail)->(FieldPos(aStruct[i][1])) ) # 0 - AAdd(aList, {nResult, nDetail, nPos, i}) - endif -next -Return aList - - -static function __doJoinList(aList) -local aJoin - -if len(aList) > 0 - ( aList[1][1] )->( dbAppend() ) - for each aJoin in aList - ( aJoin[1] )->(FieldPut( aJoin[4], ( aJoin[2] )->(FieldGet( aJoin[3] )) )) - next -endif -return nil diff --git a/harbour/source/rtl/dbsdf.prg b/harbour/source/rtl/dbsdf.prg deleted file mode 100644 index d1cac4184c..0000000000 --- a/harbour/source/rtl/dbsdf.prg +++ /dev/null @@ -1,309 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * Copies the contents of a database to an SDF text file. - * Appends the contents of an SDF text file to a database. - * - * Copyright 2001-2002 David G. Holm - * www - http://www.harbour-project.org - * - * Copyright 2006 Przemyslaw Czerpak - * function __dbSDF() replaced by the new one which uses - * SDF RDD I've just created - * - * 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 "hbcommon.ch" -#include "fileio.ch" -#include "error.ch" -#include "set.ch" - -HB_FILE_VER( "$Id$" ) - -REQUEST SDF - -PROCEDURE __dbSDF( lExport, cFile, aFields, bFor, bWhile, nNext, nRecord, lRest ) - - IF lExport - __dbCopy( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "SDF" ) - ELSE - __dbApp( cFile, aFields, bFor, bWhile, nNext, nRecord, lRest, "SDF" ) - ENDIF - -RETURN - - -#ifdef __DBSDF_OLD_CODE__ - -#define SkipEOL( handle ) FSEEK( handle, nEOLSize, FS_RELATIVE ) -#define AppendEOL( handle ) FWRITE( handle, HB_OSNewLine() ) -#define AppendEOF( handle ) FWRITE( handle, CHR( 26 ) ) - -PROCEDURE __dbSDF( lExport, cFile, aFields, bFor, bWhile, nNext, nRecord, lRest ) - LOCAL index, handle, cFileName := cFile, nStart, nCount, oErr, nFileLen, aStruct - LOCAL cFileEOL:=chr(13)+chr(10) // EOL defaults to windows - LOCAL nEOLSize:=2 // EOL size default to windows - - // Process the file name argument. - index := RAT( ".", cFileName ) - IF index > 0 - // The file name might include a file extension. - IF RAT( "/", cFileName ) > index ; - .OR. RAT( "\", cFileName ) > index - // No, the file extension is in a directory name. - index := 0 - END IF - END IF - IF index <= 0 - // No file name extension, so provide the default. - cFileName += ".txt" - END IF - - // Determine where to start and how many records to process. - IF nRecord != NIL - // The RECORD clause has the highest priority. - nStart := nRecord - nCount := 1 - ELSEIF nNext != NIL - // The NEXT clause has the next highest priority. - nStart := -1 - nCount := nNext - ELSEIF bWhile != NIL .OR. lRest - // The WHILE and REST clauses have equal priority. - nStart := -1 - nCount := -1 - ELSE - // Followed by the FOR clause or the ALL clause. - nStart := 0 - nCount := -1 - END IF - IF EMPTY( bFor ) - // This simplifies the test that determines whether or not to - // use (i.e., import or export) any given processed record. - bFor := {||.T.} - END IF - - IF lExport - // COPY TO SDF - handle := FCREATE( cFileName ) - IF handle == -1 - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_CREATE - oErr:subSystem := "SDF" - oErr:subCode := 1002 - oErr:description := HB_LANGERRMSG( oErr:genCode ) - oErr:canRetry := .T. - oErr:canDefault := .T. - oErr:fileName := cFileName - oErr:osCode := FERROR() - Eval(ErrorBlock(), oErr) - ELSE - IF nStart > -1 - // Only reposition if a starting record was specified or implied. - IF nStart == 0 - GO TOP - ELSE - GO (nStart) - END IF - END IF - IF EMPTY( bWhile ) - // This simplifies the looping logic. - bWhile := {||.T.} - END IF - // Process the records to copy SDF. - WHILE EVAL( bWhile ) .AND. ( nCount == -1 .OR. nCount > 0 ) ; - .AND. !BOF() .AND. !EOF() - IF EVAL( bFor ) - IF EMPTY( aFields ) - // Process all fields. - FOR index := 1 TO FCOUNT() - ExportFixed( handle, FIELDGET( index ) ) - NEXT index - ELSE - // Process the specified fields. - FOR index := 1 TO LEN( aFields ) - ExportFixed( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ) ) - NEXT index - END IF - // Set up for the start of the next record. - AppendEOL( handle ) - END IF - IF nCount != -1 - nCount-- - END IF - SKIP - END WHILE - IF SET(_SET_EOF) - AppendEOF( handle ) - END IF - FCLOSE( handle ) - END IF - ELSE - // APPEND FROM SDF - handle := FOPEN( cFileName ) - IF handle == -1 - oErr := ErrorNew() - oErr:severity := ES_ERROR - oErr:genCode := EG_OPEN - oErr:subSystem := "SDF" - oErr:subCode := 1001 - oErr:description := HB_LANGERRMSG( oErr:genCode ) - oErr:canRetry := .T. - oErr:canDefault := .T. - oErr:fileName := cFileName - oErr:osCode := FERROR() - Eval(ErrorBlock(), oErr) - ELSE - cFileEOL:=FindEOL(handle) - nEOLSize:=len(cFileEOL) - IF EMPTY( bWhile ) - // This simplifies the looping logic. - bWhile := {||.T.} - END IF - nFileLen := FSEEK( handle,0,FS_END ) - - FSEEK( handle,0 ) - aStruct := DBSTRUCT() - WHILE FSEEK( handle,0,FS_RELATIVE ) + 1 < nFileLen - APPEND BLANK - IF EMPTY( aFields ) - // Process all fields. - FOR index := 1 TO FCOUNT() - IF !ImportFixed( handle,index,aStruct, cFileEOL ) - EXIT - ENDIF - NEXT index - ELSE - // Process the specified fields. - FOR index := 1 TO LEN( aFields ) - IF !ImportFixed( handle,FIELDPOS( aFields[ index ] ),aStruct, cFileEOL ) - EXIT - ENDIF - NEXT index - END IF - // Set up for the start of the next record. - SkipEOL( handle ) - - END WHILE - FCLOSE( handle ) - END IF - END IF -RETURN - -STATIC FUNCTION ExportFixed( handle, xField ) - DO CASE - CASE VALTYPE( xField ) == "C" - FWRITE( handle, xField ) - CASE VALTYPE( xField ) == "D" - FWRITE( handle, DTOS( xField ) ) - CASE VALTYPE( xField ) == "L" - FWRITE( handle, iif( xField, "T", "F" ) ) - CASE VALTYPE( xField ) == "N" - FWRITE( handle, STR( xField ) ) - OTHERWISE - RETURN .F. - END CASE -RETURN .T. - -STATIC FUNCTION ImportFixed( handle, index, aStruct, cFileEOL ) - LOCAL cBuffer := Space(aStruct[ index,3 ]), pos, res := .T., nRead - LOCAL vres - - nRead := FREAD( handle, @cBuffer, aStruct[ index,3 ] ) - IF ( pos := At( cFileEOL,cBuffer ) ) > 0 .AND. pos <= nRead - res := .F. - FSEEK( handle, -( nRead - pos + 1 ), FS_RELATIVE ) - IF pos > 1 - cBuffer := Left( cBuffer,pos-1 ) - ELSE - RETURN res - ENDIF - ENDIF - - DO CASE - CASE aStruct[ index,2 ] == "D" - vres := HB_STOD( cBuffer ) - CASE aStruct[ index,2 ] == "L" - vres := iif( cBuffer == "T",.T.,.F. ) - CASE aStruct[ index,2 ] == "N" - vres := VAL( cBuffer ) - OTHERWISE - vres := cBuffer - END CASE - FIELDPUT( index, vres ) -RETURN res - -STATIC FUNCTION FindEOL(fh) - LOCAL nBufSize:=512 - LOCAL cBuffer:=space(nBufSize) - LOCAL nF:=0,c:='',cResult:='' - fseek(fh,0,FS_SET) - do while fread(fh,@cBuffer,nBufSize) > 0 - do while nF <= nBufSize - c:=substr(cBuffer,nF,1) - IF c==chr(10) // Unix type EOL - cResult := chr(10) - ELSEIF c==chr(13) // MSWIN or MAC - if substr(cBuffer,nF+1,1)==chr(10) - cResult := (chr(13)+chr(10)) - else - cResult := chr(13) - endif - ENDIF - if len(cResult)>0 - fseek(fh,0,FS_SET) - RETURN cResult - endif - ++nF - enddo - enddo - fseek(fh,0,FS_SET) - if len(cResult)==0 - // TODO: Report an error - can't find EOL - endif -RETURN cResult - -#endif /* __DBSDF_OLD_CODE__ */ diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 1298ab92f6..330f0a02b2 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -181,8 +181,8 @@ CLASS TBrowse METHOD PosCursor() // Positions the cursor to the beginning of the call, used only when autolite==.F. METHOD LeftDetermine() // Determine leftmost unfrozen column in display METHOD DispCell( nRow, nCol, nMode ) // Displays a single cell and returns cell type as a single letter like Valtype() - METHOD HowManyCol( nWidth ) // Counts how many cols can be displayed - METHOD RedrawHeaders( nWidth ) // Repaints TBrowse Headers + METHOD HowManyCol() // Counts how many cols can be displayed + METHOD RedrawHeaders() // Repaints TBrowse Headers METHOD Moved() // Every time a movement key is issued I need to reset certain properties // of TBrowse, I do these settings inside this method @@ -846,9 +846,10 @@ return Self // Calculate how many columns fit on the browse width including ColSeps -METHOD HowManyCol( nWidth ) CLASS TBrowse +METHOD HowManyCol() CLASS TBrowse local nToAdd + local nWidth := ::nRight - ::nLeft + 1 // They were locals, so now I need to clear them (should fix this) ::nColsWidth := 0 @@ -912,13 +913,14 @@ return Self // Gets TBrowse width and width of displayed columns plus colsep -METHOD RedrawHeaders( nWidth ) CLASS TBrowse +METHOD RedrawHeaders() CLASS TBrowse local n, nTPos, nBPos local cBlankBox := Space(9) local nScreenRowT local nScreenRowB local nLCS // Len(ColSep) + local nWidth := ::nRight - ::nLeft + 1 if ::lHeaders // Drawing headers @@ -1038,8 +1040,8 @@ METHOD Stabilize() CLASS TBrowse if ::lRedrawFrame // How may columns fit on TBrowse width? - ::HowManyCol( nWidth ) - ::RedrawHeaders( nWidth ) + ::HowManyCol() + ::RedrawHeaders() // Now that browser frame has been redrawn we don't need to redraw it unless // displayed columns change diff --git a/harbour/source/rtl/typefile.prg b/harbour/source/rtl/typefile.prg index 0ebd84b959..f6f8215cd8 100644 --- a/harbour/source/rtl/typefile.prg +++ b/harbour/source/rtl/typefile.prg @@ -50,13 +50,15 @@ * */ +#include "hbsetup.ch" + #include "common.ch" #include "error.ch" #include "fileio.ch" #define BUFFER_LENGTH 2048 -FUNCTION __TYPEFILE( cFile, lPrint ) +PROCEDURE __TypeFile( cFile, lPrint ) LOCAL nHandle, cBuffer, nRead := 0, nHasRead := 0, nSize := 0, nBuffer LOCAL oErr, xRecover, nRetries LOCAL aSaveSet[ 2 ] @@ -91,7 +93,7 @@ FUNCTION __TYPEFILE( cFile, lPrint ) cTmp := hb_FNameMerge( aPath[ i ], cName, cExt ) IF file( cTmp ) cFile := cTmp - exit + EXIT ENDIF NEXT ENDIF @@ -110,7 +112,7 @@ FUNCTION __TYPEFILE( cFile, lPrint ) oErr:tries := ++nRetries xRecover := Eval( ErrorBlock(), oErr ) IF ISLOGICAL( xRecover ) .and. !xRecover // user select "Default" - RETURN NIL + RETURN ENDIF ENDDO @@ -145,7 +147,7 @@ FUNCTION __TYPEFILE( cFile, lPrint ) Set( _SET_PRINTER, aSaveSet[ 2 ] ) ENDIF - RETURN NIL + RETURN /*----------------------------------------------------------------------------*/ /* Function aDvd : Divide string to tokens and put tokens into array */ @@ -167,3 +169,10 @@ STATIC FUNCTION aDvd( cString, cDelim ) AAdd( aProm, cString ) RETURN aProm + +#ifdef HB_COMPAT_XPP + +FUNCTION _TypeFile( cFile, lPrint ) + RETURN __TypeFile( cFile, lPrint ) + +#endif diff --git a/harbour/source/vm/arrayshb.c b/harbour/source/vm/arrayshb.c index 8d578bd72c..c7ca331e31 100644 --- a/harbour/source/vm/arrayshb.c +++ b/harbour/source/vm/arrayshb.c @@ -332,99 +332,3 @@ HB_FUNC( HB_APARAMS ) { hb_itemRelease( hb_itemReturn( hb_arrayFromParams( hb_parni( 1 ) + 1 ) ) ); } - -HB_FUNC( HB_AEXPRESSIONS ) -{ - PHB_ITEM pArray = hb_stackReturnItem(); - PHB_ITEM pLine = hb_param( 1, HB_IT_STRING ); - size_t i, iOffset = 0; - int iParans = 0, iArrays = 0, iIndexs = 0; - BOOL bArray = FALSE; - - if( pLine == NULL ) - { - hb_errRT_BASE_SubstR( EG_ARG, 9999, NULL, "HB_AEXPRESSIONS", HB_ERR_ARGS_BASEPARAMS ); - return; - } - - hb_arrayNew( pArray, 0 ); - - for( i = 0; i < pLine->item.asString.length; i++ ) - { - switch( pLine->item.asString.value[i] ) - { - case '(' : - iParans++; - bArray = FALSE; - break; - - case ')' : - iParans--; - bArray = TRUE; - break; - - case '{' : - iArrays++; - bArray = FALSE; - break; - - case '}' : - iArrays--; - bArray = TRUE; - break; - - case '[' : - if( bArray || ( i && isalnum((int) pLine->item.asString.value[i - 1] ) ) ) - { - iIndexs++; - } - else - { - while( ++i < pLine->item.asString.length && pLine->item.asString.value[i] != ']' ); - } - bArray = FALSE; - break; - - case ']' : - iIndexs--; - bArray = TRUE; - break; - - case '"' : - while( ++i < pLine->item.asString.length && pLine->item.asString.value[i] != '"' ); - bArray = FALSE; - break; - - case '\'' : - while( ++i < pLine->item.asString.length && pLine->item.asString.value[i] != '\'' ); - bArray = FALSE; - break; - - case ',' : - if( iParans == 0 && iArrays == 0 && iIndexs == 0 ) - { - PHB_ITEM pExp = hb_itemNew( NULL ); - - hb_arrayAdd( pArray, hb_itemPutCL( pExp, pLine->item.asString.value + iOffset, i - iOffset ) ); - iOffset = i + 1; - - hb_itemRelease( pExp ); - } - bArray = FALSE; - break; - - default : - bArray = FALSE; - break; - } - } - - if( iOffset < pLine->item.asString.length - 1 ) - { - PHB_ITEM pExp = hb_itemNew( NULL ); - - hb_arrayAdd( pArray, hb_itemPutCL( pExp, pLine->item.asString.value + iOffset, pLine->item.asString.length - iOffset ) ); - - hb_itemRelease( pExp ); - } -} diff --git a/harbour/utils/Makefile b/harbour/utils/Makefile index e041acf97e..9db291d6de 100644 --- a/harbour/utils/Makefile +++ b/harbour/utils/Makefile @@ -6,6 +6,7 @@ ROOT = ../ DIRS=\ hbpp \ + hbpptest \ hbver \ hbrun \ hbdoc \ diff --git a/harbour/utils/hbpptest/pretest.prg b/harbour/utils/hbpptest/pretest.prg index 28d342b4d0..8626e2956d 100644 --- a/harbour/utils/hbpptest/pretest.prg +++ b/harbour/utils/hbpptest/pretest.prg @@ -1,6 +1,10 @@ -// -// $Id$ -// +/* + * $Id$ + */ + +#ifndef __HARBOUR__ + #xtranslate HB_OSNewLine() => ( Chr( 13 ) + Chr( 10 ) ) +#endif #command TEXT TO VAR => #pragma __stream|%s||:= #command CTEXT TO VAR => #pragma __cstream|%s||:= @@ -958,9 +962,9 @@ ENDTEXT /* ---------------------------------------------------------------------*/ __PP_FREE() - ? "Total count =", nCnt - ? "Valid results =", nRes - ? "Failed results=", nCnt - nRes + OutStd( "Total count =", nCnt, hb_OSNewLine() ) + OutStd( "Valid results =", nRes, hb_OSNewLine() ) + OutStd( "Failed results=", nCnt - nRes, hb_OSNewLine() ) RETURN @@ -994,15 +998,15 @@ LOCAL i IF( pre == out ) RETURN 1 ELSE - ? pre - ? out - ? " => FAILED in LINE: ", PROCLINE(1) + OutStd( pre, hb_OSNewLine() ) + OutStd( out, hb_OSNewLine() ) + OutStd( " => FAILED in LINE: ", PROCLINE(1), hb_OSNewLine() ) i := 1 WHILE SUBSTR(pre,i,1) == SUBSTR(out,i,1) i++ ENDDO - ? SUBSTR( pre, i ) - ? SUBSTR( out, i ) + OutStd( SUBSTR( pre, i ), hb_OSNewLine() ) + OutStd( SUBSTR( out, i ), hb_OSNewLine() ) ENDIF -RETURN 0 \ No newline at end of file +RETURN 0