From b6cc8296fb3fdd4736a6db23cd390fe02835cbcf Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 13 Sep 2017 12:00:53 +0000 Subject: [PATCH] 2017-09-13 11:57 UTC Viktor Szakats (vszakats users.noreply.github.com) + src/rdd/usrrdd/rdds/arrayrdd.prg -> contrib/rddmisc/arrayrdd.prg + src/rdd/usrrdd/rdds/dbtcdx.prg -> contrib/rddmisc/dbtcdx.prg + src/rdd/usrrdd/rdds/fptcdx.prg -> contrib/rddmisc/fptcdx.prg + src/rdd/usrrdd/rdds/hscdx.prg -> contrib/rddmisc/hscdx.prg + src/rdd/usrrdd/rdds/logrdd.prg -> contrib/rddmisc/logrdd.prg + src/rdd/usrrdd/rdds/rlcdx.prg -> contrib/rddmisc/rlcdx.prg + src/rdd/usrrdd/rdds/smtcdx.prg -> contrib/rddmisc/smtcdx.prg + src/rdd/usrrdd/rdds/vfpcdx.prg -> contrib/rddmisc/vfpcdx.prg * src/rdd/usrrdd/rdds/arrayrdd.prg * src/rdd/usrrdd/rdds/dbtcdx.prg * src/rdd/usrrdd/rdds/fptcdx.prg * src/rdd/usrrdd/rdds/hscdx.prg * src/rdd/usrrdd/rdds/logrdd.prg * src/rdd/usrrdd/rdds/rlcdx.prg * src/rdd/usrrdd/rdds/smtcdx.prg * src/rdd/usrrdd/rdds/vfpcdx.prg * move usrrdd sources to contrib/rddmisc to have the source tree in sync with 3.4 fork, where these were converted to a contrib. In 3.2 they will still be compiled into core with an #include trick. --- ChangeLog.txt | 22 + contrib/rddmisc/arrayrdd.prg | 2048 +++++++++++++++++++++++++++++ contrib/rddmisc/dbtcdx.prg | 73 ++ contrib/rddmisc/fptcdx.prg | 73 ++ contrib/rddmisc/hscdx.prg | 284 +++++ contrib/rddmisc/logrdd.prg | 467 +++++++ contrib/rddmisc/rlcdx.prg | 222 ++++ contrib/rddmisc/smtcdx.prg | 73 ++ contrib/rddmisc/vfpcdx.prg | 70 + src/rdd/usrrdd/rdds/arrayrdd.prg | 2049 +----------------------------- src/rdd/usrrdd/rdds/dbtcdx.prg | 74 +- src/rdd/usrrdd/rdds/fptcdx.prg | 74 +- src/rdd/usrrdd/rdds/hscdx.prg | 285 +---- src/rdd/usrrdd/rdds/logrdd.prg | 468 +------ src/rdd/usrrdd/rdds/rlcdx.prg | 223 +--- src/rdd/usrrdd/rdds/smtcdx.prg | 74 +- src/rdd/usrrdd/rdds/vfpcdx.prg | 71 +- 17 files changed, 3340 insertions(+), 3310 deletions(-) create mode 100644 contrib/rddmisc/arrayrdd.prg create mode 100644 contrib/rddmisc/dbtcdx.prg create mode 100644 contrib/rddmisc/fptcdx.prg create mode 100644 contrib/rddmisc/hscdx.prg create mode 100644 contrib/rddmisc/logrdd.prg create mode 100644 contrib/rddmisc/rlcdx.prg create mode 100644 contrib/rddmisc/smtcdx.prg create mode 100644 contrib/rddmisc/vfpcdx.prg diff --git a/ChangeLog.txt b/ChangeLog.txt index 3bc441454e..fb2fc67fe5 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -7,6 +7,28 @@ Entries may not always be in chronological/commit order. See license at the end of file. */ +2017-09-13 11:57 UTC Viktor Szakats (vszakats users.noreply.github.com) + + src/rdd/usrrdd/rdds/arrayrdd.prg -> contrib/rddmisc/arrayrdd.prg + + src/rdd/usrrdd/rdds/dbtcdx.prg -> contrib/rddmisc/dbtcdx.prg + + src/rdd/usrrdd/rdds/fptcdx.prg -> contrib/rddmisc/fptcdx.prg + + src/rdd/usrrdd/rdds/hscdx.prg -> contrib/rddmisc/hscdx.prg + + src/rdd/usrrdd/rdds/logrdd.prg -> contrib/rddmisc/logrdd.prg + + src/rdd/usrrdd/rdds/rlcdx.prg -> contrib/rddmisc/rlcdx.prg + + src/rdd/usrrdd/rdds/smtcdx.prg -> contrib/rddmisc/smtcdx.prg + + src/rdd/usrrdd/rdds/vfpcdx.prg -> contrib/rddmisc/vfpcdx.prg + * src/rdd/usrrdd/rdds/arrayrdd.prg + * src/rdd/usrrdd/rdds/dbtcdx.prg + * src/rdd/usrrdd/rdds/fptcdx.prg + * src/rdd/usrrdd/rdds/hscdx.prg + * src/rdd/usrrdd/rdds/logrdd.prg + * src/rdd/usrrdd/rdds/rlcdx.prg + * src/rdd/usrrdd/rdds/smtcdx.prg + * src/rdd/usrrdd/rdds/vfpcdx.prg + * move usrrdd sources to contrib/rddmisc to have the source tree + in sync with 3.4 fork, where these were converted to a contrib. + In 3.2 they will still be compiled into core with an #include + trick. + 2017-09-13 11:40 UTC Viktor Szakats (vszakats users.noreply.github.com) * config/*/*.mk * config/*.mk diff --git a/contrib/rddmisc/arrayrdd.prg b/contrib/rddmisc/arrayrdd.prg new file mode 100644 index 0000000000..4bc2c789bf --- /dev/null +++ b/contrib/rddmisc/arrayrdd.prg @@ -0,0 +1,2048 @@ +/* + * ARRAY RDD + * + * Copyright 2006 Francesco Saverio Giudice + * Copyright 2011-2013 Quique (Index, locate and filter Support) + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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. + * + */ + +/* This is a Array RDD, or Memory RDD. + It works only in memory and actually supports standard dbf commands + except relations. */ + +#include "dbinfo.ch" +#include "dbstruct.ch" +#include "error.ch" +#include "fileio.ch" +#include "hbtrace.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +#xtranslate Throw( ) => ( Eval( ErrorBlock(), ), Break( ) ) + +#define LEFTEQUAL( l, r ) iif( ValType( l ) $ "CM", Left( l, Len( r ) ) == r, l == r ) + +ANNOUNCE ARRAYRDD + +#define DATABASE_FILENAME 1 +#define DATABASE_RECORDS 2 +#define DATABASE_RECINFO 3 +#define DATABASE_OPENNUMBER 4 +#define DATABASE_LOCKED 5 +#define DATABASE_STRUCT 6 +#define DATABASE_INDEX 7 +#define DATABASE_SIZEOF 7 + +#define RDDDATA_DATABASE 1 +#define RDDDATA_SIZEOF 1 + +#define WADATA_DATABASE 1 +#define WADATA_WORKAREA 2 +#define WADATA_OPENINFO 3 +#define WADATA_RECNO 4 +#define WADATA_BOF 5 +#define WADATA_FORCEBOF 6 +#define WADATA_EOF 7 +#define WADATA_TOP 8 +#define WADATA_BOTTOM 9 +#define WADATA_FOUND 10 +#define WADATA_LOCKS 11 +#define WADATA_INDEX 12 +#define WADATA_WAORDINFO 13 +#define WADATA_ORDRECNO 14 +#define WADATA_FILTERINFO 15 +#define WADATA_LOCATE 16 +#define WADATA_SIZEOF 16 + +#define RECDATA_DELETED 1 +#define RECDATA_LOCKED 2 +#define RECDATA_SIZEOF 2 + +#define INDEX_TAG 1 +#define INDEX_ORCR 2 +#define INDEX_RECORDS 3 +#define INDEX_SIZEOF 3 + +#define INDEXKEY_KEY 1 +#define INDEXKEY_RECORD 2 +#define INDEXKEY_SIZEOF 2 + +#define WAOI_SCOPE_0 1 +#define WAOI_SCOPE_1 2 +#define WAOI_SIZEOF 2 + +STATIC s_nRddID := -1 + +/* + * non work area methods receive RDD ID as first parameter + * Methods INIT and EXIT does not have to execute SUPER methods - this is + * always done by low-level USRRDD code + */ + +STATIC FUNCTION AR_INIT( nRDD ) + + /* Init DBF Hash */ + + USRRDD_RDDDATA( nRDD, { => } ) + + RETURN HB_SUCCESS + +#if 0 + +STATIC FUNCTION AR_RDDDATAINIT() + RETURN { ; + NIL ; /* RDDDATA_DATABASE */ + } + +#endif + +STATIC FUNCTION AR_DATABASEINIT() + RETURN { ; + NIL, ; /* DATABASE_FILENAME */ + {}, ; /* DATABASE_RECORDS */ + {}, ; /* DATABASE_RECINFO */ + 0, ; /* DATABASE_OPENNUMBER */ + .F., ; /* DATABASE_LOCKED */ + NIL, ; /* DATABASE_STRUCT - aStruct */ + {} ; /* DATABASE_INDEX */ + } + +STATIC FUNCTION AR_WADATAINIT() + RETURN { ; + NIL, ; /* WADATA_DATABASE */ + 0, ; /* WADATA_WORKAREA */ + NIL, ; /* WADATA_OPENINFO */ + 0, ; /* WADATA_RECNO */ + .F., ; /* WADATA_BOF */ + .F., ; /* WADATA_FORCEBOF - to solve an hack in dbf1.c */ + .F., ; /* WADATA_EOF */ + .F., ; /* WADATA_TOP */ + .F., ; /* WADATA_BOTTOM */ + .F., ; /* WADATA_FOUND */ + {}, ; /* WADATA_LOCKS */ + 0, ; /* WADATA_INDEX */ + {}, ; /* WADATA_WAORDINFO */ + 0, ; /* WADATA_ORDRECNO */ + NIL, ; /* WADATA_FILTERINFO */ + Array( UR_SI_SIZE ); /* WADATA_LOCATE */ + } + +STATIC FUNCTION AR_RECDATAINIT() + RETURN { ; + .F., ; /* RECDATA_DELETED */ + 0; /* RECDATA_LOCKED (Number of area) */ + } + +STATIC FUNCTION AR_INDEXINIT() + RETURN { ; + NIL, ; /* INDEX_TAG */ + NIL, ; /* INDEX_ORCR */ + {} ; /* INDEX_RECORDS */ + } + +STATIC FUNCTION AR_INDEXKEYINIT() + RETURN { ; + NIL, ; /* INDEXKEY_KEY */ + NIL ; /* INDEXKEY_RECORD */ + } + +STATIC FUNCTION AR_WAOIINIT() + RETURN { ; + NIL, ; /* WAOI_SCOPE_0 */ + NIL ; /* WAOI_SCOPE_1 */ + } + +/* + * methods: NEW and RELEASE receive pointer to work area structure + * not work area number. It's necessary because the can be executed + * before work area is allocated + * these methods does not have to execute SUPER methods - this is + * always done by low-level USRRDD code + */ + +STATIC FUNCTION AR_NEW( pWA ) + + /* + * Set in our private AREA item the array with slot number and + * BOF/EOF flags. There is no BOF support in HB_F* function so + * we have to emulate it and there is no phantom record so we + * cannot return EOF flag directly. + */ + + USRRDD_AREADATA( pWA, AR_WADATAINIT() ) + + RETURN HB_SUCCESS + +/* Creating fields for new DBF - dbCreate() in current workarea */ + +STATIC FUNCTION AR_CREATEFIELDS( nWA, aStruct ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL nResult := HB_SUCCESS + LOCAL aFieldStruct, aField + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aStruct: %2$s", nWA, hb_ValToExp( aStruct ) ) ) + + /* Setting WA number to current WorkArea */ + aWAData[ WADATA_WORKAREA ] := nWA + + /* Create new file data structure - workarea uses a reference to database */ + aWAData[ WADATA_DATABASE ] := AR_DATABASEINIT() + + /* Store DBF Structure */ + aWAData[ WADATA_DATABASE ][ DATABASE_STRUCT ] := aStruct + + /* Set fields */ + UR_SUPER_SETFIELDEXTENT( nWA, Len( aStruct ) ) + + FOR EACH aFieldStruct IN aStruct + aFieldStruct[ DBS_NAME ] := Upper( aFieldStruct[ DBS_NAME ] ) + aFieldStruct[ DBS_TYPE ] := Upper( aFieldStruct[ DBS_TYPE ] ) + + aField := Array( UR_FI_SIZE ) + aField[ UR_FI_NAME ] := aFieldStruct[ DBS_NAME ] + aField[ UR_FI_TYPE ] := hb_Decode( aFieldStruct[ DBS_TYPE ], "C", HB_FT_STRING, "L", HB_FT_LOGICAL, "M", HB_FT_MEMO, "D", HB_FT_DATE, "N", iif( aFieldStruct[ DBS_DEC ] > 0, HB_FT_DOUBLE, HB_FT_INTEGER ) ) + aField[ UR_FI_TYPEEXT ] := 0 + aField[ UR_FI_LEN ] := aFieldStruct[ DBS_LEN ] + aField[ UR_FI_DEC ] := aFieldStruct[ DBS_DEC ] + UR_SUPER_ADDFIELD( nWA, aField ) + + NEXT + + RETURN nResult + +/* Create database from current WA fields definition */ + +STATIC FUNCTION AR_CREATE( nWA, aOpenInfo ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) + LOCAL cName + LOCAL cFullName, aDBFData, nResult /*, aFieldStruct, aField, aStruct */ + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOpenInfo: %2$s", nWA, hb_ValToExp( aOpenInfo ) ) ) + + /* getting database infos from current workarea */ + aDBFData := aWAData[ WADATA_DATABASE ] + + /* setting in uppercase chars to avoid differences */ + cFullName := Upper( aOpenInfo[ UR_OI_NAME ] ) + + /* When there is no ALIAS we will create new one using file name */ + IF aOpenInfo[ UR_OI_ALIAS ] == NIL + hb_FNameSplit( cFullName,, @cName ) + aOpenInfo[ UR_OI_ALIAS ] := cName + ENDIF + + /* Check if database is already present in memory slots */ + /* + 2008-11-07 FSG - dbCreate() doesn't check if a dbf file exists. So I will not check it. + If you need to check if a table exists use hb_dbExists() function that works in + similar way of hb_vfExists(), i.e.: + IF ! hb_dbExists( cFullName ) + dbCreate( cFullName, aStructure, "ARRAYRDD" ) + ... + ENDIF + */ + + /* Setting file attribs */ + aDBFData[ DATABASE_FILENAME ] := cFullName + aDBFData[ DATABASE_LOCKED ] := .T. /* I need Exclusive mode in creation */ + + /* Adding new database in RDD memory slots using filename as key */ + hRDDData[ cFullName ] := aDBFData + + /* Set WorkArea Info */ + aWAData[ WADATA_WORKAREA ] := nWA + aWAData[ WADATA_OPENINFO ] := aOpenInfo /* Put open informations */ + + /* Call SUPER OPEN to finish allocating work area (f.e.: alias settings) */ + nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) + + IF nResult == HB_SUCCESS + /* Add a new open number */ + aDBFData[ DATABASE_OPENNUMBER ]++ + /* default values for Records == 0 */ + aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. + aWAData[ WADATA_RECNO ] := 1 + ENDIF + + RETURN nResult + +STATIC FUNCTION AR_OPEN( nWA, aOpenInfo ) + + LOCAL cFullName, cName, hRDDData, aWAData, aDBFData + LOCAL aStruct, oError, aFieldStruct, aField, nResult + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOpenInfo: %2$s", nWA, hb_ValToExp( aOpenInfo ) ) ) + + cFullName := Upper( aOpenInfo[ UR_OI_NAME ] ) + + IF Right( cFullName, 1 ) == "." + cFullName := Left( cFullName, Len( cFullName ) - 1 ) + ENDIF + + /* When there is no ALIAS we will create new one using file name */ + IF aOpenInfo[ UR_OI_ALIAS ] == NIL + hb_FNameSplit( cFullName,, @cName ) + aOpenInfo[ UR_OI_ALIAS ] := cName + ENDIF + + hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) + + IF cFullName $ hRDDData + aDBFData := hRDDData[ cFullName ] + aStruct := aDBFData[ DATABASE_STRUCT ] + ELSE + oError := ErrorNew() + oError:GenCode := EG_OPEN + oError:SubCode := 1000 + oError:Description := hb_langErrMsg( EG_OPEN ) + ", memory file not found" + oError:FileName := aOpenInfo[ UR_OI_NAME ] + oError:CanDefault := .T. + NetErr( .T. ) + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + /* Set WorkArea Infos */ + aWAData := USRRDD_AREADATA( nWA ) + aWAData[ WADATA_DATABASE ] := aDBFData /* Put a reference to database */ + aWAData[ WADATA_WORKAREA ] := nWA + aWAData[ WADATA_OPENINFO ] := aOpenInfo /* Put open informations */ + + /* Set fields */ + UR_SUPER_SETFIELDEXTENT( nWA, Len( aStruct ) ) + + FOR EACH aFieldStruct IN aStruct + aField := Array( UR_FI_SIZE ) + aField[ UR_FI_NAME ] := aFieldStruct[ DBS_NAME ] + aField[ UR_FI_TYPE ] := hb_Decode( aFieldStruct[ DBS_TYPE ], "C", HB_FT_STRING, "L", HB_FT_LOGICAL, "M", HB_FT_MEMO, "D", HB_FT_DATE, "N", iif( aFieldStruct[ DBS_DEC ] > 0, HB_FT_DOUBLE, HB_FT_INTEGER ) ) + aField[ UR_FI_TYPEEXT ] := 0 + aField[ UR_FI_LEN ] := aFieldStruct[ DBS_LEN ] + aField[ UR_FI_DEC ] := aFieldStruct[ DBS_DEC ] + UR_SUPER_ADDFIELD( nWA, aField ) + NEXT + + /* Call SUPER OPEN to finish allocating work area (f.e.: alias settings) */ + nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) + + /* Add a new open number */ + aDBFData[ DATABASE_OPENNUMBER ]++ + + /* File already opened in exclusive mode */ + /* I have to do this check here because, in case of error, AR_CLOSE() is called however */ + IF aDBFData[ DATABASE_LOCKED ] + oError := ErrorNew() + oError:GenCode := EG_OPEN + oError:SubCode := 1000 + oError:Description := hb_langErrMsg( EG_OPEN ) + "(" + ; + hb_langErrMsg( EG_LOCK ) + " - already opened in exclusive mode)" + oError:FileName := aOpenInfo[ UR_OI_NAME ] + oError:CanDefault := .T. + NetErr( .T. ) + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + /* Open file in exclusive mode */ + IF ! aOpenInfo[ UR_OI_SHARED ] + IF aDBFData[ DATABASE_OPENNUMBER ] == 1 + aDBFData[ DATABASE_LOCKED ] := .T. + ELSE + oError := ErrorNew() + oError:GenCode := EG_OPEN + oError:SubCode := 1000 + oError:Description := hb_langErrMsg( EG_OPEN ) + "(" + ; + hb_langErrMsg( EG_LOCK ) + " - already opened in shared mode)" + oError:FileName := aOpenInfo[ UR_OI_NAME ] + oError:CanDefault := .T. + UR_SUPER_ERROR( nWA, oError ) + NetErr( .T. ) + RETURN HB_FAILURE + ENDIF + ENDIF + + IF nResult == HB_SUCCESS + NetErr( .F. ) + AR_GOTOP( nWA ) + ENDIF + + RETURN nResult + +STATIC FUNCTION AR_CLOSE( nWA ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF HB_ISARRAY( aDBFData ) + /* decrease open number */ + --aDBFData[ DATABASE_OPENNUMBER ] + + /* unlock file */ + aDBFData[ DATABASE_LOCKED ] := .F. /* Exclusive mode */ + ENDIF + + RETURN UR_SUPER_CLOSE( nWA ) + +STATIC FUNCTION AR_GETVALUE( nWA, nField, xValue ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL aStruct := aDBFData[ DATABASE_STRUCT ] + LOCAL nRecNo := aWAData[ WADATA_RECNO ] + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nField: %2$d, xValue: %3$s", nWA, nField, hb_ValToExp( xValue ) ) ) + + IF nField > 0 .AND. nField <= Len( aStruct ) + IF aWAData[ WADATA_EOF ] + /* We are at EOF position, return empty value */ + xValue := EmptyValue( aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) + ELSE + xValue := aRecords[ nRecNo ][ nField ] + ENDIF + RETURN HB_SUCCESS + ENDIF + + RETURN HB_FAILURE + +STATIC FUNCTION AR_PUTVALUE( nWA, nField, xValue ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL aStruct := aDBFData[ DATABASE_STRUCT ] + LOCAL nRecNo := aWAData[ WADATA_RECNO ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL aKeys[ Len( aIndexes ) ] + LOCAL xVal + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nField: %2$d, xValue: %3$s", nWA, nField, hb_ValToExp( xValue ) ) ) + + IF nField > 0 .AND. nField <= Len( aStruct ) .AND. ; + iif( HB_ISSTRING( xValue ) .AND. aStruct[ nField ][ DBS_TYPE ] == "M", .T., ValType( xValue ) == aStruct[ nField ][ DBS_TYPE ] ) + + xVal := PutValue( xValue, aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) + + AEval( aIndexes, {| aInd, n | aKeys[ n ] := Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ) } ) + + IF ! aWAData[ WADATA_EOF ] + aRecords[ nRecNo ][ nField ] := xVal + ENDIF + + AEval( aIndexes, {| aInd, n | ModifyIndex( n, Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aInd, aWAData, aKeys[ n ] ) } ) + + RETURN HB_SUCCESS + ENDIF + + RETURN HB_FAILURE + +STATIC FUNCTION AR_GOTO( nWA, nRecord ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL nRecCount := Len( aRecords ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecord: %2$d, nRecCount: %3$d", nWA, nRecord, nRecCount ) ) + + IF nRecord >= 1 .AND. nRecord <= nRecCount + aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .F. + aWAData[ WADATA_RECNO ] := nRecord + ELSEIF nRecCount == 0 + aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. + aWAData[ WADATA_RECNO ] := 1 + ELSEIF nRecord < 0 + aWAData[ WADATA_BOF ] := .T. + aWAData[ WADATA_EOF ] := .F. + aWAData[ WADATA_RECNO ] := 1 + ELSEIF nRecord == 0 .OR. nRecord > nRecCount + aWAData[ WADATA_BOF ] := .F. + aWAData[ WADATA_EOF ] := .T. + aWAData[ WADATA_RECNO ] := nRecCount + 1 + ENDIF + + AR_UNLOCK( nWA ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "aWAData[ WADATA_BOF ]: %1$s, aWAData[ WADATA_EOF ]: %2$s, aWAData[ WADATA_RECNO ]: %3$d", ; + hb_ValToExp( aWAData[ WADATA_BOF ] ), hb_ValToExp( aWAData[ WADATA_EOF ] ), aWAData[ WADATA_RECNO ] ) ) + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_GOTOID( nWA, nRecord ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecord: %2$d", nWA, nRecord ) ) + + RETURN AR_GOTO( nWA, nRecord ) + +STATIC FUNCTION AR_GOTOP( nWA ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL nRecCount := Len( aRecords ) + LOCAL nIndex := aWAData[ WADATA_INDEX ] + LOCAL nResult := HB_SUCCESS + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF nRecCount == 0 + aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. + aWAData[ WADATA_RECNO ] := 1 + ELSE + aWAData[ WADATA_BOF ] := .F. + aWAData[ WADATA_EOF ] := .F. + IF nIndex == 0 + aWAData[ WADATA_RECNO ] := 1 + ELSEIF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] == NIL + IF Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) + aWAData[ WADATA_ORDRECNO ] := 0 + nResult := AR_GOTO( nWA, 0 ) + ELSE + aWAData[ WADATA_ORDRECNO ] := 1 + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ 1 ][ INDEXKEY_RECORD ] ) + ENDIF + ELSE + aWAData[ WADATA_ORDRECNO ] := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] ) + ENDIF + + IF Set( _SET_DELETED ) .AND. aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] + RETURN AR_SKIPFILTER( nWA, 1 ) + ENDIF + ENDIF + + AR_UNLOCK( nWA ) + + RETURN nResult + +STATIC FUNCTION AR_GOBOTTOM( nWA ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL nIndex := aWAData[ WADATA_INDEX ] + LOCAL nResult := HB_SUCCESS + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF Len( aRecords ) == 0 + aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. + aWAData[ WADATA_RECNO ] := 1 + ELSE + aWAData[ WADATA_BOF ] := .F. + aWAData[ WADATA_EOF ] := .F. + IF nIndex == 0 + aWAData[ WADATA_RECNO ] := Len( aRecords ) + ELSEIF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] == NIL + IF Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) + aWAData[ WADATA_ORDRECNO ] := 0 + nResult := AR_GOTO( nWA, 0 ) + ELSE + aWAData[ WADATA_ORDRECNO ] := Len( ATail( aIndexes[ nIndex ][ INDEX_RECORDS ] ) ) + nResult := AR_GOTO( nWA, ATail( aIndexes[ nIndex ][ INDEX_RECORDS ] )[ INDEXKEY_RECORD ] ) + ENDIF + ELSE + aWAData[ WADATA_ORDRECNO ] := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .T. ) + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] ) + ENDIF + + IF Set( _SET_DELETED ) .AND. aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] + RETURN AR_SKIPFILTER( nWA, -1 ) + ENDIF + ENDIF + + AR_UNLOCK( nWA ) + + RETURN nResult + +STATIC FUNCTION AR_SETFILTER( nWa, aDbFilterInfo ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aDbFilterInfo: %2$s", nWA, hb_ValToExp( aDbFilterInfo ) ) ) + + USRRDD_AREADATA( nWA )[ WADATA_FILTERINFO ] := aDbFilterInfo + + RETURN SUCCESS + +STATIC FUNCTION AR_CLEARFILTER( nWA ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + USRRDD_AREADATA( nWA )[ WADATA_FILTERINFO ] := NIL + + RETURN SUCCESS + +STATIC FUNCTION AR_SKIPFILTER( nWA, nRecords ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL lBof, nToSkip + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$d", nWA, nRecords ) ) + + nToSkip := iif( nRecords > 0, 1, iif( nRecords < 0, -1, 0 ) ) + + IF nToSkip != 0 + DO WHILE ! aWAData[ WADATA_BOF ] .AND. ! aWAData[ WADATA_EOF ] + IF ( Set( _SET_DELETED ) .AND. aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] ) .OR. ; + ( aWAData[ WADATA_FILTERINFO ] != NIL .AND. ! Eval( aWAData[ WADATA_FILTERINFO ][ UR_FRI_BEXPR ] ) ) + IF AR_SKIPRAW( nWA, nToSkip ) != HB_SUCCESS + RETURN HB_FAILURE + ENDIF + IF nToSkip < 0 .AND. aWAData[ WADATA_BOF ] + lBof := .T. + aWAData[ WADATA_BOF ] := .F. + nToSkip := 1 + ELSEIF nToSkip > 0 .AND. aWAData[ WADATA_EOF ] + EXIT + ENDIF + LOOP + ENDIF + + /* FILTERS */ + EXIT + ENDDO + + IF lBof != NIL + aWAData[ WADATA_BOF ] := .T. + ENDIF + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_SKIPRAW( nWA, nRecords ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL nIndex := aWAData[ WADATA_INDEX ] + LOCAL aIndexes := aWAData[ WADATA_DATABASE ][ DATABASE_INDEX ] + LOCAL lBof, lEof + LOCAL nResult, nRec, nEnd, lScope0, lScope1 + LOCAL nIni := 0 + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$d", nWA, nRecords ) ) + + IF nRecords == 0 + lBof := aWAData[ WADATA_BOF ] + lEof := aWAData[ WADATA_EOF ] + + nResult := AR_GOTO( nWA, aWAData[ WADATA_RECNO ] ) + + aWAData[ WADATA_BOF ] := lBof + aWAData[ WADATA_EOF ] := lEof + + ELSEIF nIndex > 0 + nRec := ordKeyNo() + lScope0 := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] != NIL + lScope1 := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] != NIL + nEnd := ordKeyCount() + IF nRec == 0 + nRec := nEnd + 1 + ENDIF + IF lScope0 + nIni := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) + nIni-- + ENDIF + IF nIni == -1 .OR. Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) + nResult := AR_GOTO( nWA, 0 ) + aWAData[ WADATA_ORDRECNO ] := 0 + ELSEIF nRecords < 0 .AND. -nRecords >= nRec + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ nIni + 1 ][ INDEXKEY_RECORD ] ) + aWAData[ WADATA_ORDRECNO ] := 1 + aWAData[ WADATA_BOF ] := .T. + ELSEIF nRecords > 0 .AND. nRec + nRecords > nEnd + nResult := AR_GOTO( nWA, 0 ) + aWAData[ WADATA_ORDRECNO ] := 0 + ELSE + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ nRec + nRecords + nIni ][ INDEXKEY_RECORD ] ) + aWAData[ WADATA_ORDRECNO ] := nRec + nRecords + nIni + IF aIndexes[ nIndex ][ INDEX_ORCR ][ UR_ORCR_CONDINFO ][ UR_ORC_DESCEND ] + IF nRecords < 0 + IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] != NIL .AND. aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] < aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_KEY ] + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ 1 ][ INDEXKEY_RECORD ] ) + aWAData[ WADATA_ORDRECNO ] := 1 + aWAData[ WADATA_BOF ] := .T. + ENDIF + ELSEIF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] != NIL .AND. aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] > aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_KEY ] + nResult := AR_GOTO( nWA, 0 ) + aWAData[ WADATA_ORDRECNO ] := 0 + ENDIF + ELSEIF lScope0 .AND. ! aIndexes[ nIndex ][ INDEX_RECORDS ][ nRec + nRecords + nIni ][ INDEXKEY_KEY ] >= aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] .OR. lScope1 .AND. ! aIndexes[ nIndex ][ INDEX_RECORDS ][ nRec + nRecords + nIni ][ INDEXKEY_KEY ] <= aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] + IF nRecords < 0 + IF aIndexes[ nIndex ][ INDEX_RECORDS ][ nIni + 1 ][ INDEXKEY_KEY ] + ENDIF + aWAData[ WADATA_ORDRECNO ] := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) + aWAData[ WADATA_BOF ] := aWAData[ WADATA_EOF ] + ELSE + nResult := AR_GOTO( nWA, 0 ) + aWAData[ WADATA_ORDRECNO ] := 0 + ENDIF + ENDIF + ENDIF + + ELSEIF nRecords < 0 .AND. -nRecords >= aWAData[ WADATA_RECNO ] + nResult := AR_GOTO( nWA, 1 ) + aWAData[ WADATA_BOF ] := .T. + ELSE + nResult := AR_GOTO( nWA, aWAData[ WADATA_RECNO ] + nRecords ) + ENDIF + + RETURN nResult + +STATIC FUNCTION AR_BOF( nWA, lBof ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lBof: %2$s", nWA, hb_ValToExp( lBof ) ) ) + + /* This is a hack to protect from dbf1.c skipraw hack */ + IF aWAData[ WADATA_FORCEBOF ] .AND. lBof + aWAData[ WADATA_BOF ] := lBof + aWAData[ WADATA_FORCEBOF ] := .F. + ELSE + lBof := aWAData[ WADATA_BOF ] + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_EOF( nWA, lEof ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lEof: %2$s", nWA, hb_ValToExp( lEof ) ) ) + + lEof := aWAData[ WADATA_EOF ] + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_DELETE( nWA ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL aKeys[ Len( aIndexes ) ] + LOCAL oError + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF aOpenInfo[ UR_OI_READONLY ] + oError := ErrorNew() + oError:GenCode := EG_READONLY + oError:SubCode := 1025 /* EDBF_READONLY */ + oError:Description := hb_langErrMsg( EG_READONLY ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + IF ! aWAData[ WADATA_EOF ] + + IF aOpenInfo[ UR_OI_SHARED ] .AND. AScan( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) == 0 + oError := ErrorNew() + oError:GenCode := EG_UNLOCKED + oError:SubCode := 1022 /* EDBF_UNLOCKED */ + oError:Description := hb_langErrMsg( EG_UNLOCKED ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + IF Len( aRecInfo ) > 0 .AND. aWAData[ WADATA_RECNO ] <= Len( aRecInfo ) + AEval( aIndexes, {| aInd, n | aKeys[ n ] := Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ) } ) + + aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] := .T. + + AEval( aIndexes, {| aInd, n | ModifyIndex( n, Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aInd, aWAData, aKeys[ n ] ) } ) + ENDIF + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_DELETED( nWA, lDeleted ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lDeleted: %2$s", nWA, hb_ValToExp( lDeleted ) ) ) + + IF Len( aRecInfo ) > 0 .AND. aWAData[ WADATA_RECNO ] <= Len( aRecInfo ) + lDeleted := aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] + ELSE + lDeleted := .F. + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_RECALL( nWA ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL aKeys[ Len( aIndexes ) ] + LOCAL oError + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF aOpenInfo[ UR_OI_READONLY ] + oError := ErrorNew() + oError:GenCode := EG_READONLY + oError:SubCode := 1025 /* EDBF_READONLY */ + oError:Description := hb_langErrMsg( EG_READONLY ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + IF ! aWAData[ WADATA_EOF ] + + IF aOpenInfo[ UR_OI_SHARED ] .AND. AScan( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) == 0 + oError := ErrorNew() + oError:GenCode := EG_UNLOCKED + oError:SubCode := 1022 /* EDBF_UNLOCKED */ + oError:Description := hb_langErrMsg( EG_UNLOCKED ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + IF Len( aRecInfo ) > 0 .AND. aWAData[ WADATA_RECNO ] <= Len( aRecInfo ) + AEval( aIndexes, {| aInd, n | aKeys[ n ] := Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ) } ) + aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] := .F. + AEval( aIndexes, {| aInd, n | ModifyIndex( n, Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aInd, aWAData, aKeys[ n ] ) } ) + ENDIF + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_APPEND( nWA, nRecords ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL aStruct := aDBFData[ DATABASE_STRUCT ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] + LOCAL oError, aRecord, aRecDataInit + + HB_SYMBOL_UNUSED( nRecords ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$s", nWA, hb_ValToExp( nRecords ) ) ) + + IF aOpenInfo[ UR_OI_READONLY ] + oError := ErrorNew() + oError:GenCode := EG_READONLY + oError:SubCode := 1025 /* EDBF_READONLY */ + oError:Description := hb_langErrMsg( EG_READONLY ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] +#if 0 + oError:OsCode := FError() +#endif + oError:CanDefault := .T. + oError:CanRetry := .T. + NetErr( .T. ) + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + + ENDIF + aRecord := BlankRecord( aStruct ) + AAdd( aRecords, aRecord ) + + aRecDataInit := AR_RECDATAINIT() + AAdd( aRecInfo, aRecDataInit ) + + NetErr( .F. ) + AR_GOTO( nWa, Len( aRecords ) ) + AEval( aIndexes, {| aIndex, n | ModifyIndex( n, Eval( aIndex[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aIndex, aWAData ) } ) + + /* SHARED ACCESS */ + IF aWAData[ WADATA_OPENINFO ][ UR_OI_SHARED ] + aRecDataInit[ RECDATA_LOCKED ] := nWA + AAdd( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_LOCK( nWA, aLock ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL nRec := iif( aLock[ UR_LI_RECORD ] == NIL, aWAData[ WADATA_RECNO ], aLock[ UR_LI_RECORD ] ) + LOCAL aRecInfo + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aLock: %2$s", nWA, hb_ValToExp( aLock ) ) ) + + IF aWAData[ WADATA_EOF ] + aLock[ UR_LI_RESULT ] := .T. + + ELSE + aRecInfo := aWAData[ WADATA_DATABASE ][ DATABASE_RECINFO ][ nRec ] + IF aWAData[ WADATA_OPENINFO ][ UR_OI_SHARED ] + IF aRecInfo[ RECDATA_LOCKED ] == nWA + aLock[ UR_LI_RESULT ] := .T. + ELSEIF aRecInfo[ RECDATA_LOCKED ] != 0 + aLock[ UR_LI_RESULT ] := .F. + ELSE + aRecInfo[ RECDATA_LOCKED ] := nWA + AAdd( aWAData[ WADATA_LOCKS ], nRec ) + aLock[ UR_LI_RESULT ] := .T. + ENDIF + ELSE + aLock[ UR_LI_RESULT ] := .T. + ENDIF + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_UNLOCK( nWA, nRec ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aRecords := aWAData[ WADATA_LOCKS ] + LOCAL aRecInfo := aWAData[ WADATA_DATABASE ][ DATABASE_RECINFO ] + LOCAL nPos + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRec: %2$d", nWA, nRec ) ) + + IF ! Empty( aRecords ) + IF nRec == NIL /* Unlock All */ + FOR EACH nRec IN aRecords + aRecInfo[ nRec ][ RECDATA_LOCKED ] := 0 + NEXT + ASize( aRecords, 0 ) + ELSE + IF ( nPos := AScan( aRecords, nRec ) ) > 0 + aRecInfo[ nRec ][ RECDATA_LOCKED ] := 0 + hb_ADel( aRecords, nPos, .T. ) + ENDIF + ENDIF + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_RECID( nWA, nRecNo ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL nRecCount := Len( aRecords ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecNo: %2$s", nWA, hb_ValToExp( nRecNo ) ) ) + + IF aWAData[ WADATA_EOF ] + nRecNo := nRecCount + 1 + ELSE + nRecNo := aWAData[ WADATA_RECNO ] + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_RECCOUNT( nWA, nRecords ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$s", nWA, hb_ValToExp( nRecords ) ) ) + + nRecords := Len( aRecords ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nRecords: %1$d", nRecords ) ) + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_PACK( nWA ) + + LOCAL oError, nRec, aIndex + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL nDel := 0 + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF ! aDBFData[ DATABASE_LOCKED ] + oError := ErrorNew() + oError:GenCode := EG_UNLOCKED + oError:SubCode := 1022 /* EDBF_UNLOCKED */ + oError:Description := hb_langErrMsg( EG_UNLOCKED ) + UR_SUPER_ERROR( nWA, oError ) + RETURN FAILURE + + ENDIF + + AEval( aIndexes, {| aIndex, n | ModifyIndex( n, Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ), aIndex, aWAData ) } ) + FOR EACH aIndex IN aIndexes + FOR nRec := Len( aIndex[ INDEX_RECORDS ] ) TO 1 STEP -1 + IF aRecInfo[ aIndex[ INDEX_RECORDS, INDEXKEY_RECORD ], RECDATA_DELETED ] + ADel( aIndex[ INDEX_RECORDS ], nRec ) + nDel++ + ENDIF + NEXT + IF nDel > 0 + ASize( aIndex[ INDEX_RECORDS ], Len( aIndex[ INDEX_RECORDS ] ) - nDel ) + nDel := 0 + ENDIF + NEXT + + FOR nRec := Len( aRecInfo ) TO 1 STEP -1 + IF aRecInfo[ nRec ][ RECDATA_DELETED ] + ADel( aRecInfo, nRec ) + ADel( aRecords, nRec ) + nDel++ + ENDIF + NEXT + IF nDel > 0 + ASize( aRecInfo, Len( aRecInfo ) - nDel ) + ASize( aRecords, Len( aRecInfo ) ) + ENDIF + + AR_GOTOP( nWA ) + + RETURN SUCCESS + +STATIC FUNCTION AR_ZAP( nWA ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] + LOCAL oError + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) + + IF aOpenInfo[ UR_OI_READONLY ] + oError := ErrorNew() + oError:GenCode := EG_READONLY + oError:SubCode := 1025 /* EDBF_READONLY */ + oError:Description := hb_langErrMsg( EG_READONLY ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + IF aOpenInfo[ UR_OI_SHARED ] + oError := ErrorNew() + oError:GenCode := EG_SHARED + oError:SubCode := 1023 /* EDBF_SHARED */ + oError:Description := hb_langErrMsg( EG_SHARED ) + oError:FileName := aOpenInfo[ UR_OI_NAME ] + UR_SUPER_ERROR( nWA, oError ) + RETURN HB_FAILURE + ENDIF + + /* empty records */ + aDBFData[ DATABASE_RECORDS ] := {} + aDBFData[ DATABASE_RECINFO ] := {} + + /* move to 0 recno */ + AR_GOTO( nWA, 0 ) + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_GOCOLD( nWA ) + + HB_SYMBOL_UNUSED( nWA ) + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_FOUND( nWa, lFound ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lFound: %2$s", nWa, hb_ValToExp( lFound ) ) ) + + lFound := USRRDD_AREADATA( nWA )[ WADATA_FOUND ] + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_SEEK( nWa, lSoftSeek, xSeek, lLast ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aIndexes := aWAData[ WADATA_DATABASE ][ DATABASE_INDEX ] + LOCAL nIndex := aWAData[ WADATA_INDEX ] + LOCAL nResult /* := HB_SUCCESS */ + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lSoftSeek: %2$s, xSeek: %3$s, lLast: %4$s", nWa, hb_ValToExp( lSoftSeek ), hb_ValToExp( xSeek ), hb_ValToExp( lLast ) ) ) + + aWAData[ WADATA_ORDRECNO ] := Seek( xSeek, lSoftSeek, lLast, aIndexes[ nIndex ] ) + IF aWAData[ WADATA_ORDRECNO ] == 0 .OR. aWAData[ WADATA_ORDRECNO ] > Len( aIndexes[ nIndex ][ INDEX_RECORDS ] ) + aWAData[ WADATA_FOUND ] := .F. + nResult := AR_GOTO( nWA, 0 ) + ELSE + aWAData[ WADATA_FOUND ] := LEFTEQUAL( aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_KEY ], xSeek ) + nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] ) + ENDIF + + RETURN nResult + +STATIC FUNCTION AR_INFO( nWA, nMsg, xValue ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nMsg: %2$s, xValue: %3$s", nWA, hb_ValToExp( nMsg ), hb_ValToExp( xValue ) ) ) + + SWITCH nMsg + CASE DBI_TABLEEXT + xValue := "" + EXIT + CASE DBI_SHARED + xValue := aDBFData[ DATABASE_LOCKED ] + EXIT + OTHERWISE + RETURN UR_SUPER_INFO( nWA, nMsg, @xValue ) + ENDSWITCH + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_ORDLSTADD( nWA, aOrderInfo ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + + HB_SYMBOL_UNUSED( aOrderInfo ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOrderInfo: %2$s", nWA, hb_ValToExp( aOrderInfo ) ) ) + + IF Empty( aIndexes ) + aWAData[ WADATA_INDEX ] := 0 + ELSE + aWAData[ WADATA_INDEX ] := 1 + IF Empty( aWAData[ WADATA_WAORDINFO ] ) + AEval( aWAData[ WADATA_WAORDINFO ] := Array( Len( aIndexes ) ), {| x, y | HB_SYMBOL_UNUSED( x ), aWAData[ WADATA_WAORDINFO ][ y ] := AR_WAOIINIT() } ) + ENDIF + + ENDIF + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_ORDLSTFOCUS( nWA, aOrderInfo ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aDBFData := aWAData[ WADATA_DATABASE ] + LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] + LOCAL xIndex := aOrderInfo[ UR_ORI_TAG ] + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOrderInfo: %2$s", nWA, hb_ValToExp( aOrderInfo ) ) ) + + aOrderInfo[ UR_ORI_RESULT ] := iif( aWAData[ WADATA_INDEX ] > 0, aIndexes[ aWAData[ WADATA_INDEX ], INDEX_TAG ], "" ) + + SWITCH ValType( xIndex ) + CASE "N" + aWAData[ WADATA_INDEX ] := iif( xIndex >= 1 .AND. xIndex <= Len( aIndexes ), Int( xIndex ), 0 ) + EXIT + CASE "C" + xIndex := Upper( xIndex ) + aWAData[ WADATA_INDEX ] := AScan( aIndexes, {| x | x[ INDEX_TAG ] == xIndex } ) + EXIT + ENDSWITCH + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_ORDCREATE( nWA, aOrderCreate ) + + LOCAL aWAData, aDBFData, aOCInfo, nNext + LOCAL aIndexes, nContNext, nContStep + LOCAL bWhile, nRec, bNext, bEval, bEvalOCI, nStep, nIndex, cIndex, aIndex + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOrderCreate: %2$s", nWA, hb_ValToExp( aOrderCreate ) ) ) + + aWAData := USRRDD_AREADATA( nWA ) + aDBFData := aWAData[ WADATA_DATABASE ] + + IF HB_ISARRAY( aOrderCreate[ UR_ORCR_CONDINFO ] ) + aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ] + ELSE + aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ] := { ; + .F., ; /* #define UR_ORC_ACTIVE 1 */ + "", ; /* #define UR_ORC_CFOR 2 */ + "", ; /* #define UR_ORC_CWHILE 3 */ + NIL, ; /* #define UR_ORC_BFOR 4 */ + NIL, ; /* #define UR_ORC_BWHILE 5 */ + NIL, ; /* #define UR_ORC_BEVAL 6 */ + 0, ; /* #define UR_ORC_STEP 7 */ + 0, ; /* #define UR_ORC_STARTREC 8 */ + 0, ; /* #define UR_ORC_NEXT 9 */ + 0, ; /* #define UR_ORC_RECORD 10 */ + .F., ; /* #define UR_ORC_REST 11 */ + .F., ; /* #define UR_ORC_DESCEND 12 */ + .F., ; /* #define UR_ORC_SCOPED 13 */ + .T., ; /* #define UR_ORC_ALL 14 */ + .F., ; /* #define UR_ORC_ADDITIVE 15 */ + .F., ; /* #define UR_ORC_USECURRENT 16 */ + .F., ; /* #define UR_ORC_CUSTOM 17 */ + .F., ; /* #define UR_ORC_NOOPTIMIZE 18 */ + .F., ; /* #define UR_ORC_COMPOUND 19 */ + .F., ; /* #define UR_ORC_USEFILTER 20 */ + .F., ; /* #define UR_ORC_TEMPORARY 21 */ + .F., ; /* #define UR_ORC_EXCLUSIVE 22 */ + NIL ; /* #define UR_ORC_CARGO 23 */ + } + ENDIF + + nNext := aOCInfo[ UR_ORC_NEXT ] + aIndexes := aDBFData[ DATABASE_INDEX ] + nContNext := 1 + nContStep := 0 + + IF Empty( aOrderCreate[ UR_ORCR_TAGNAME ] ) + aOrderCreate[ UR_ORCR_TAGNAME ] := aOrderCreate[ UR_ORCR_BAGNAME ] + ENDIF + cIndex := aOrderCreate[ UR_ORCR_TAGNAME ] := Upper( aOrderCreate[ UR_ORCR_TAGNAME ] ) + aIndex := AR_INDEXINIT() + aIndex[ INDEX_TAG ] := cIndex + aIndex[ INDEX_ORCR ] := aOrderCreate + IF ( nIndex := AScan( aIndexes, {| x | x[ INDEX_TAG ] == cIndex } ) ) > 0 + ADel( aIndexes, nIndex ) + aIndexes[ Len( aIndexes ) ] := aIndex + ELSE + AAdd( aIndexes, aIndex ) + ENDIF + + IF aOCInfo[ UR_ORC_BWHILE ] == NIL .AND. nNext == 0 + nRec := 1 + AR_GOTO( nWA, nRec ) + ELSE + nRec := aOCInfo[ UR_ORC_STARTREC ] + AR_GOTO( nWA, nRec ) + ENDIF + IF aOCInfo[ UR_ORC_BWHILE ] == NIL + bWhile := {|| .T. } + ELSE + bWhile := aOCInfo[ UR_ORC_BWHILE ] + ENDIF + IF nNext == 0 + bNext := {|| .T. } + ELSE + bNext := {|| nContNext++ <= nNext } + ENDIF + IF aOCInfo[ UR_ORC_BEVAL ] == NIL + HB_TRACE( HB_TR_DEBUG, "bEval = {|| .T. }" ) + bEval := {|| .T. } + ELSEIF aOCInfo[ UR_ORC_STEP ] == NIL + bEval := aOCInfo[ UR_ORC_BEVAL ] + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "bEval = %1$s", hb_ValToExp( bEval ) ) ) + ELSE + bEvalOCI := aOCInfo[ UR_ORC_BEVAL ] + nStep := aOCInfo[ UR_ORC_STEP ] + bEval := {|| iif( ++nContStep == nStep, ( nContStep := 0, Eval( bEvalOCI ) ), .T. ) } + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "bEvalOCI = %1$s, nStep = %2$d, bEval = %3$s", hb_ValToExp( bEvalOCI ), nStep, hb_ValToExp( bEval ) ) ) + ENDIF + + AAdd( aWAData[ WADATA_WAORDINFO ], AR_WAOIINIT() ) + aWAData[ WADATA_INDEX ] := Len( aIndexes ) + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "aWAData[ WADATA_EOF ] = %1$s", hb_ValToExp( aWAData[ WADATA_EOF ] ) ) ) + + DO WHILE ! aWAData[ WADATA_EOF ] .AND. Eval( bEval ) .AND. Eval( bNext ) .AND. Eval( bWhile ) + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "aWAData[ WADATA_INDEX ] = %1$s, Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ) = %2$s, aIndex = %3$s, aWAData = %4$s", ; + hb_ValToExp( aWAData[ WADATA_INDEX ] ), hb_ValToExp( Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ) ), ; + hb_ValToExp( hb_ValToExp( aIndex ) ), hb_ValToExp( aWAData ) ) ) + ModifyIndex( aWAData[ WADATA_INDEX ], Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ), aIndex, aWAData ) + AR_GOTO( nWA, ++nRec ) + ENDDO + + RETURN AR_GOTOP( nWA ) + +STATIC FUNCTION AR_ORDINFO( nWA, nMsg, aOrderInfo ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aIndexes := aWAData[ WADATA_DATABASE ][ DATABASE_INDEX ] + LOCAL nIndex, nPos + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nMsg: %2$s, aOrderInfo: %3$s", nWA, hb_ValToExp( nMsg ), hb_ValToExp( aOrderInfo ) ) ) + + IF Empty( aOrderInfo[ UR_ORI_TAG ] ) + aOrderInfo[ UR_ORI_TAG ] := aOrderInfo[ UR_ORI_BAG ] + ENDIF + + SWITCH ValType( aOrderInfo[ UR_ORI_TAG ] ) + CASE "C" + nIndex := Upper( aOrderInfo[ UR_ORI_TAG ] ) + nIndex := AScan( aIndexes, {| x | x[ INDEX_TAG ] == nIndex } ) + EXIT + CASE "N" + nIndex := aOrderInfo[ UR_ORI_TAG ] + EXIT + OTHERWISE + nIndex := aWAData[ WADATA_INDEX ] + ENDSWITCH + + SWITCH nMsg + CASE DBOI_EXPRESSION + IF nIndex < 1 .OR. Empty( aIndexes ) .OR. nIndex > Len( aIndexes[ nIndex ] ) + aOrderInfo[ UR_ORI_RESULT ] := "" + ELSE + aOrderInfo[ UR_ORI_RESULT ] := aIndexes[ nIndex ][ INDEX_ORCR ][ UR_ORCR_CKEY ] + ENDIF + EXIT + CASE DBOI_POSITION + IF nIndex < 1 .OR. Empty( aIndexes ) .OR. nIndex > Len( aIndexes[ nIndex ] ) .OR. Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) .OR. aWAData[ WADATA_ORDRECNO ] == 0 + aOrderInfo[ UR_ORI_RESULT ] := 0 + ELSE + IF aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] != aWAData[ WADATA_RECNO ] + aWAData[ WADATA_ORDRECNO ] := Seek( Eval( aIndexes[ nIndex ][ INDEX_ORCR ][ UR_ORCR_BKEY ] ), .F., .F., aIndexes[ nIndex ], aWAData[ WADATA_RECNO ] ) + ENDIF + IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] == NIL + aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_ORDRECNO ] + ELSE + nPos := Seek( aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ], .T., .F., aIndexes[ nIndex ] ) + IF nPos > 0 .AND. ! LEFTEQUAL( aIndexes[ nIndex ][ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ], aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] ) + IF nPos > 1 .AND. aIndexes[ nIndex ][ INDEX_RECORDS ][ nPos - 1 ][ INDEXKEY_KEY ] >= aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] + nPos-- + ELSE + aOrderInfo[ UR_ORI_RESULT ] := 0 + EXIT + ENDIF + ENDIF + aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_ORDRECNO ] - nPos + 1 + ENDIF + ENDIF + EXIT + CASE DBOI_BAGNAME + aOrderInfo[ UR_ORI_RESULT ] := "" + EXIT + CASE DBOI_KEYCOUNT + IF nIndex >= 1 .AND. ! Empty( aWAData[ WADATA_DATABASE ][ DATABASE_RECORDS ] ) + IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] == NIL + nPos := 0 + ELSE + nPos := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) + IF nPos == 0 + aOrderInfo[ UR_ORI_RESULT ] := 0 + EXIT + ENDIF + ENDIF + IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] == NIL + IF nPos > 0 + nPos := Len( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - nPos + 1 + ENDIF + ELSE + nMsg := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .T. ) + IF nMsg > 0 + IF nPos == 0 + nPos := nMsg + ELSE + nPos := nMsg - nPos + 1 + ENDIF + ENDIF + ENDIF + IF nPos > 0 + aOrderInfo[ UR_ORI_RESULT ] := nPos + ELSE + aOrderInfo[ UR_ORI_RESULT ] := Len( aIndexes[ nIndex ][ INDEX_RECORDS ] ) + ENDIF + ELSE + aOrderInfo[ UR_ORI_RESULT ] := 0 + ENDIF + EXIT + CASE DBOI_SCOPETOP + aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] + IF aOrderInfo[ UR_ORI_ALLTAGS ] != NIL + aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] := aOrderInfo[ UR_ORI_NEWVAL ] + ENDIF + EXIT + CASE DBOI_SCOPEBOTTOM + aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] + IF aOrderInfo[ UR_ORI_ALLTAGS ] != NIL + aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] := aOrderInfo[ UR_ORI_NEWVAL ] + ENDIF + EXIT + CASE DBOI_SCOPETOPCLEAR + aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] + aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] := NIL + EXIT + CASE DBOI_SCOPEBOTTOMCLEAR + aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] + aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] := NIL + EXIT + OTHERWISE + RETURN HB_FAILURE + ENDSWITCH + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_CLEARLOCATE( nWA ) + + USRRDD_AREADATA( nWA )[ WADATA_LOCATE ] := Array( UR_SI_SIZE ) + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_SETLOCATE( nWA, aScopeInfo ) + + USRRDD_AREADATA( nWA )[ WADATA_LOCATE ] := aScopeInfo + + RETURN HB_SUCCESS + +STATIC FUNCTION AR_LOCATE( nWA, lContinue ) + + LOCAL aWAData := USRRDD_AREADATA( nWA ) + LOCAL aScopeInfo := aWAData[ WADATA_LOCATE ] + LOCAL bFor := aScopeInfo[ UR_SI_BFOR ] + LOCAL bWhile := aScopeInfo[ UR_SI_BWHILE ] + LOCAL bLocate + + IF lContinue + AR_SKIPRAW( nWA, 1 ) + ENDIF + IF bWhile == NIL + bLocate := {|| ! Eval( bFor ) } + IF ! lContinue .AND. aScopeInfo[ UR_SI_NEXT ] == NIL .AND. aScopeInfo[ UR_SI_RECORD ] == NIL .AND. ! aScopeInfo[ UR_SI_REST ] + AR_GOTOP( nWA ) + ENDIF + ELSE + bLocate := {|| ! Eval( bFor ) .AND. Eval( bWhile ) } + ENDIF + dbEval( {|| NIL },, bLocate, aScopeInfo[ UR_SI_NEXT ], aScopeInfo[ UR_SI_RECORD ], aScopeInfo[ UR_SI_REST ] .OR. lContinue ) + aWAData[ WADATA_FOUND ] := ! aWAData[ WADATA_EOF ] .AND. Eval( bFor ) + + RETURN HB_SUCCESS + + +STATIC FUNCTION AR_DUMMY() + + RETURN HB_SUCCESS + +/* + * This function have to exist in all RDD and then name have to be in + * format: _GETFUNCTABLE + */ + +FUNCTION ARRAYRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + + LOCAL cSuperRDD := NIL /* NO SUPER RDD */ + LOCAL aMyFunc[ UR_METHODCOUNT ] + + s_nRddID := nRddID + + aMyFunc[ UR_INIT ] := ( @AR_INIT() ) + aMyFunc[ UR_NEW ] := ( @AR_NEW() ) + aMyFunc[ UR_FLUSH ] := ( @AR_DUMMY() ) + aMyFunc[ UR_CREATE ] := ( @AR_CREATE() ) + aMyFunc[ UR_CREATEFIELDS ] := ( @AR_CREATEFIELDS() ) + aMyFunc[ UR_OPEN ] := ( @AR_OPEN() ) + aMyFunc[ UR_CLOSE ] := ( @AR_CLOSE() ) + aMyFunc[ UR_BOF ] := ( @AR_BOF() ) + aMyFunc[ UR_EOF ] := ( @AR_EOF() ) + aMyFunc[ UR_APPEND ] := ( @AR_APPEND() ) + aMyFunc[ UR_DELETE ] := ( @AR_DELETE() ) + aMyFunc[ UR_DELETED ] := ( @AR_DELETED() ) + aMyFunc[ UR_RECALL ] := ( @AR_RECALL() ) + aMyFunc[ UR_SETFILTER ] := ( @AR_SETFILTER() ) + aMyFunc[ UR_CLEARFILTER ] := ( @AR_CLEARFILTER() ) + aMyFunc[ UR_SKIPFILTER ] := ( @AR_SKIPFILTER() ) + aMyFunc[ UR_SKIPRAW ] := ( @AR_SKIPRAW() ) + aMyFunc[ UR_GOTO ] := ( @AR_GOTO() ) + aMyFunc[ UR_GOTOID ] := ( @AR_GOTOID() ) + aMyFunc[ UR_GOTOP ] := ( @AR_GOTOP() ) + aMyFunc[ UR_GOBOTTOM ] := ( @AR_GOBOTTOM() ) + aMyFunc[ UR_RECID ] := ( @AR_RECID() ) + aMyFunc[ UR_LOCK ] := ( @AR_LOCK() ) + aMyFunc[ UR_UNLOCK ] := ( @AR_UNLOCK() ) + aMyFunc[ UR_RECCOUNT ] := ( @AR_RECCOUNT() ) + aMyFunc[ UR_GETVALUE ] := ( @AR_GETVALUE() ) + aMyFunc[ UR_PUTVALUE ] := ( @AR_PUTVALUE() ) + aMyFunc[ UR_PACK ] := ( @AR_PACK() ) + aMyFunc[ UR_ZAP ] := ( @AR_ZAP() ) + aMyFunc[ UR_GOCOLD ] := ( @AR_GOCOLD() ) + aMyFunc[ UR_FOUND ] := ( @AR_FOUND() ) + aMyFunc[ UR_SEEK ] := ( @AR_SEEK() ) + aMyFunc[ UR_INFO ] := ( @AR_INFO() ) + aMyFunc[ UR_ORDLSTADD ] := ( @AR_ORDLSTADD() ) + aMyFunc[ UR_ORDLSTFOCUS ] := ( @AR_ORDLSTFOCUS() ) + aMyFunc[ UR_ORDCREATE ] := ( @AR_ORDCREATE() ) + aMyFunc[ UR_ORDINFO ] := ( @AR_ORDINFO() ) + aMyFunc[ UR_CLEARLOCATE ] := ( @AR_CLEARLOCATE() ) + aMyFunc[ UR_SETLOCATE ] := ( @AR_SETLOCATE() ) + aMyFunc[ UR_LOCATE ] := ( @AR_LOCATE() ) + + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc, pSuperRddID ) + +INIT PROCEDURE ARRAYRDD_INIT() + + rddRegister( "ARRAYRDD", RDT_FULL ) + + RETURN + +/* -------------------------------------------------- */ +/* UTILITY FUNCTIONS */ +/* -------------------------------------------------- */ + +/* + hb_EraseArrayRdd() function is equivalent of FErase() function, but works here in memory +*/ + +FUNCTION hb_EraseArrayRdd( cFullName ) + + LOCAL nReturn := HB_FAILURE + LOCAL aDBFData, oError + LOCAL hRDDData + + IF s_nRddID >= 0 + hRDDData := USRRDD_RDDDATA( s_nRddID ) + + IF hRDDData != NIL + IF HB_ISSTRING( cFullName ) + cFullName := Upper( cFullName ) + /* First search if memory dbf exists */ + IF cFullName $ hRDDData + + /* Get ARRAY DATA */ + aDBFData := hRDDData[ cFullName ] + + /* Check if there are current opened workarea */ + IF aDBFData[ DATABASE_OPENNUMBER ] > 0 + oError := ErrorNew() + + oError:GenCode := EG_UNSUPPORTED + oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ + oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; + "database in use)" + oError:FileName := cFullName + oError:CanDefault := .T. + Throw( oError ) + + nReturn := HB_FAILURE + + ELSE + /* Delete database from slot */ + hb_HDel( hRDDData, cFullName ) + nReturn := HB_SUCCESS + + ENDIF + ENDIF + ENDIF + + ELSE + oError := ErrorNew() + + oError:GenCode := EG_UNSUPPORTED + oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ + oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; + "ARRAYRDD not inizialized)" + oError:FileName := cFullName + oError:CanDefault := .T. + /* UR_SUPER_ERROR( 0, oError ) */ + Throw( oError ) + + nReturn := HB_FAILURE + + ENDIF + + ELSE + oError := ErrorNew() + + oError:GenCode := EG_UNSUPPORTED + oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ + oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; + "ARRAYRDD not inizialized)" + oError:FileName := cFullName + oError:CanDefault := .T. + THROW( oError ) + + nReturn := HB_FAILURE + + ENDIF + + RETURN nReturn + +/* + hb_FileArrayRdd( cFullName ) --> lExist + This function is equivalent of File() function, but works here in memory +*/ + +FUNCTION hb_FileArrayRdd( cFullName ) + + LOCAL nReturn := HB_FAILURE + LOCAL oError + LOCAL hRDDData + + IF s_nRddID >= 0 + hRDDData := USRRDD_RDDDATA( s_nRddID ) + + IF hRDDData != NIL + IF HB_ISSTRING( cFullName ) + cFullName := Upper( cFullName ) + /* First search if memory dbf exists */ + IF cFullName $ hRDDData + nReturn := HB_SUCCESS + ENDIF + ENDIF + + ELSE + oError := ErrorNew() + + oError:GenCode := EG_UNSUPPORTED + oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ + oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; + "ARRAYRDD not inizialized)" + oError:FileName := cFullName + oError:CanDefault := .T. + Throw( oError ) + + nReturn := HB_FAILURE + ENDIF + + ELSE + oError := ErrorNew() + + oError:GenCode := EG_UNSUPPORTED + oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ + oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; + "ARRAYRDD not in use)" + oError:FileName := cFullName + oError:CanDefault := .T. + Throw( oError ) + + nReturn := HB_FAILURE + + ENDIF + + RETURN nReturn == HB_SUCCESS + +/* hb_SetArrayRdd( aArray ) --> NIL + This function set DBF with aArray like APPEND FROM aArray in an empty DBF */ +PROCEDURE hb_SetArrayRdd( aArray ) + + LOCAL aRecInfo + LOCAL nWA := Select() + LOCAL aDBFData := USRRDD_AREADATA( nWA )[ WADATA_DATABASE ] + + aDBFData[ DATABASE_RECORDS ] := aArray + aDBFData[ DATABASE_RECINFO ] := Array( Len( aArray ) ) + FOR EACH aRecInfo IN aDBFData[ DATABASE_RECINFO ] + aRecInfo := AR_RECDATAINIT() + NEXT + AR_GOTOP( nWA ) + + RETURN + +STATIC FUNCTION BlankRecord( aStruct ) + + LOCAL nLenStruct := Len( aStruct ) + LOCAL aRecord := Array( nLenStruct ) + LOCAL nField + + FOR nField := 1 TO nLenStruct + aRecord[ nField ] := EmptyValue( aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) + NEXT + + RETURN aRecord + +STATIC FUNCTION PutValue( xValue, cType, nLen, nDec ) + + LOCAL xVal + + DO CASE + CASE cType == "C" + xVal := PadR( xValue, nLen ) + CASE cType == "M" + xVal := xValue /* No limit for a memo field */ + CASE cType == "N" + xVal := Val( Str( xValue, nLen, nDec ) ) + OTHERWISE + xVal := xValue + ENDCASE + + RETURN xVal + +STATIC FUNCTION EmptyValue( cType, nLen, nDec ) + + LOCAL xVal + + hb_default( @nLen, 0 ) + hb_default( @nDec, 0 ) + + DO CASE + CASE cType == "C" .OR. cType == "M" + xVal := Space( nLen ) + CASE cType == "D" + xVal := hb_SToD() + CASE cType == "L" + xVal := .F. + CASE cType == "N" + xVal := Val( Str( 0, nLen, nDec ) ) + ENDCASE + + RETURN xVal + +/** + * Function .......: hb_Decode( , [ ]> ) ---> + * Author .........: Francesco Saverio Giudice + * Date of creation: 1991-01-25 + * Last revision ..: 2006-01-24 1.13 - rewritten for xHarbour and renamed in hb_Decode() + * + * Decode a value from a list. + */ + +STATIC FUNCTION hb_Decode( ... ) + + LOCAL aParams, nParams, xDefault + LOCAL xVal, cKey, xRet + LOCAL aValues, aResults, n, i, nPos, nLen + + aParams := hb_AParams() + nParams := PCount() + xDefault := NIL + + DO CASE + CASE nParams > 1 /* More parameters, real CASE */ + xVal := aParams[ 1 ] + + hb_ADel( aParams, 1, .T. ) /* Resize params */ + nParams := Len( aParams ) + + /* if I have a odd number of members, last is DEFAULT */ + IF ( nParams % 2 ) != 0 + xDefault := ATail( aParams ) + /* Resize again deleting last */ + hb_ADel( aParams, nParams, .T. ) + nParams := Len( aParams ) + ENDIF + + /* Ok because I have no other value than default, I will check if it is a complex value */ + /* like an array or an hash, so I can get it to decode values */ + IF xDefault != NIL .AND. ; + ( HB_ISARRAY( xDefault ) .OR. HB_ISHASH( xDefault ) ) + + /* If it is an array I will restart this function creating a linear call */ + IF HB_ISARRAY( xDefault ) .AND. Len( xDefault ) > 0 + /* I can have a linear array like { 1, "A", 2, "B", 3, "C" } + * or an array of array couples like { { 1, "A" }, { 2, "B" }, { 3, "C" } } + * first element tell me what type is */ + + /* couples of values */ + IF HB_ISARRAY( xDefault[ 1 ] ) + /* If i have an array as default, this contains couples of key / value */ + /* so I have to convert in a linear array */ + + nLen := Len( xDefault ) + + /* Check if array has a default value, this will be last value and has a value */ + /* different from an array */ + IF ! HB_ISARRAY( ValType( xDefault[ nLen ] ) ) + aParams := Array( ( nLen - 1 ) * 2 ) + + n := 1 + FOR i := 1 TO nLen - 1 + aParams[ n++ ] := xDefault[ i ][ 1 ] + aParams[ n++ ] := xDefault[ i ][ 2 ] + NEXT + + AAdd( aParams, xDefault[ nLen ] ) + + ELSE + /* I haven't a DEFAULT */ + aParams := Array( Len( xDefault ) * 2 ) + + n := 1 + FOR i := 1 TO Len( xDefault ) + aParams[ n++ ] := xDefault[ i ][ 1 ] + aParams[ n++ ] := xDefault[ i ][ 2 ] + NEXT + + ENDIF + ELSE + /* I have a linear array */ + aParams := xDefault + + ENDIF + + ELSEIF HB_ISHASH( xDefault ) /* If it is an hash, translate it in an array */ + + aParams := Array( Len( xDefault ) * 2 ) + + i := 1 + FOR EACH cKey IN xDefault:Keys + aParams[ i++ ] := cKey + aParams[ i++ ] := xDefault[ cKey ] + NEXT + + ENDIF + + /* Then add Decoding value at beginning */ + hb_AIns( aParams, 1, xVal, .T. ) + + /* And run decode() again */ + xRet := hb_ExecFromArray( @hb_Decode(), aParams ) + + ELSE + /* Ok let's go ahead with real FUNCTION */ + + /* Combine in 2 lists having elements as { value } and { decode } */ + aValues := Array( nParams / 2 ) + aResults := Array( nParams / 2 ) + + i := 1 + FOR n := 1 TO nParams - 1 STEP 2 + aValues[ i ] := aParams[ n ] + aResults[ i ] := aParams[ n + 1 ] + i++ + NEXT + + /* Check if value exists (valtype of values MUST be same of xVal, + * otherwise I will get a runtime error) + * TODO: Have I to check also between different valtypes, jumping different ? */ + nPos := AScan( aValues, {| e | e == xVal } ) + + IF nPos == 0 /* Not Found, returning DEFAULT */ + xRet := xDefault /* it could be also NIL because not present */ + + ELSE + xRet := aResults[ nPos ] + + ENDIF + ENDIF + + CASE nParams == 0 /* No parameters */ + xRet := NIL + + CASE nParams == 1 /* Only value to decode as parameter, return an empty value of itself */ + xRet := DecEmptyValue( aParams[ 1 ] ) + + ENDCASE + + RETURN xRet + +STATIC FUNCTION DecEmptyValue( xVal ) + + LOCAL xRet + LOCAL cType := ValType( xVal ) + + SWITCH cType + CASE "C" /* Char */ + CASE "M" /* Memo */ + xRet := "" + EXIT + CASE "D" /* Date */ + xRet := hb_SToD() + EXIT + CASE "L" /* Logical */ + xRet := .F. + EXIT + CASE "N" /* Number */ + xRet := 0 + EXIT + CASE "B" /* code block */ + xRet := {|| NIL } + EXIT + CASE "A" /* array */ + xRet := {} + EXIT + CASE "H" /* hash */ + xRet := { => } + EXIT + CASE "U" /* undefined */ + xRet := NIL + EXIT + CASE "O" /* Object */ + xRet := NIL /* Or better another value ? */ + EXIT + OTHERWISE + /* Create a runtime error for new datatypes */ + xRet := "" + IF xRet == 0 /* BANG! */ + ENDIF + + ENDSWITCH + + RETURN xRet + +STATIC PROCEDURE ModifyIndex( nIndex, xValue, aIndex, aWAData, xValorAnt ) + + LOCAL nPos, aOCInfo, lFor, lDel + + HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nIndex = %1$d, xValue = %2$s, aIndex = %3$s, aWAData = %4$s, xValorAnt = %5$s", ; + nIndex, hb_ValToExp( xValue ), hb_ValToExp( aIndex ), hb_ValToExp( aWAData ), hb_ValToExp( xValorAnt ) ) ) + + aOCInfo := aIndex[ INDEX_ORCR, UR_ORCR_CONDINFO ] + lFor := ( aOCInfo[ UR_ORC_BFOR ] == NIL .OR. Eval( aOCInfo[ UR_ORC_BFOR ] ) ) + lDel := .F. + + IF xValorAnt != NIL .AND. ( ! lFor .OR. ! xValue == xValorAnt ) + ADel( aIndex[ INDEX_RECORDS ], Seek( xValorAnt, .F., .F., aIndex, aWAData[ WADATA_RECNO ] ) ) + lDel := .T. + ENDIF + + IF lFor .AND. ! xValue == xValorAnt + nPos := Seek( xValue, .T., .T., aIndex ) + IF xValorAnt == NIL + AAdd( aIndex[ INDEX_RECORDS ], NIL ) + ENDIF + IF nPos > 0 + IF aIndex[ INDEX_RECORDS ][ nPos ] != NIL .AND. aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ] <= xValue + nPos++ + ENDIF + ELSE + nPos := Len( aIndex[ INDEX_RECORDS ] ) + ENDIF + AIns( aIndex[ INDEX_RECORDS ], nPos ) + aIndex[ INDEX_RECORDS ][ nPos ] := AR_INDEXKEYINIT() + aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ] := xValue + aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_RECORD ] := aWAData[ WADATA_RECNO ] + IF nIndex == aWAData[ WADATA_INDEX ] + aWAData[ WADATA_ORDRECNO ] := nPos + ENDIF + + ELSEIF lDel + ASize( aIndex[ INDEX_RECORDS ], Len( aIndex[ INDEX_RECORDS ] ) - 1 ) + IF nIndex == aWAData[ WADATA_INDEX ] + aWAData[ WADATA_ORDRECNO ] := 0 + ENDIF + ENDIF + + RETURN + +STATIC FUNCTION Seek( xSeek, lSoft, lLast, aIndexInfo, nRec ) + + LOCAL nPos, bFirst, bBefore, bAfter, bAjust + LOCAL aIndex := aIndexInfo[ INDEX_RECORDS ] + LOCAL nIni := 1 + LOCAL nEnd := Len( aIndex ) + + SWITCH nEnd + CASE 0 /* empty archive */ + nPos := 0 + EXIT + CASE 1 /* Archive with 1 record */ + IF aIndex[ 1 ] == NIL .OR. ; + iif( lSoft, ; + iif( aIndexInfo[ INDEX_ORCR ][ UR_ORCR_CONDINFO ][ UR_ORC_DESCEND ], ; + aIndex[ 1 ][ INDEXKEY_KEY ] <= xSeek, ; + aIndex[ 1 ][ INDEXKEY_KEY ] >= xSeek ), ; + LEFTEQUAL( aIndex[ 1 ][ INDEXKEY_KEY ], xSeek ) ) + nPos := 1 + ELSE + nPos := 0 + ENDIF + EXIT + OTHERWISE /* Archive with 2 or more records */ + IF aIndexInfo[ INDEX_ORCR ][ UR_ORCR_CONDINFO ][ UR_ORC_DESCEND ] + bFirst := {|| aIndex[ 2 ][ INDEXKEY_KEY ] >= xSeek } + bBefore := {|| xSeek > aIndex[ nPos ][ INDEXKEY_KEY ] } + bAfter := {|| xSeek < aIndex[ nPos ][ INDEXKEY_KEY ] } + bAjust := {|| ! aIndex[ nPos ][ INDEXKEY_KEY ] <= xSeek } + ELSE + bFirst := {|| aIndex[ 2 ][ INDEXKEY_KEY ] <= xSeek } + bBefore := {|| ! aIndex[ nPos ][ INDEXKEY_KEY ] <= xSeek } + bAfter := {|| xSeek > aIndex[ nPos ][ INDEXKEY_KEY ] } + bAjust := {|| ! aIndex[ nPos ][ INDEXKEY_KEY ] >= xSeek } + ENDIF + + IF aIndex[ 2 ] != NIL .AND. Eval( bFirst ) + DO WHILE nIni <= nEnd + nPos := Int( ( nIni + nEnd ) / 2 ) + IF aIndex[ nPos ] == NIL .OR. Eval( bBefore ) + nEnd := nPos - 1 + ELSEIF Eval( bAfter ) + nIni := nPos + 1 + ELSE + IF lLast + IF nPos < nEnd .AND. aIndex[ nPos + 1 ] != NIL .AND. LEFTEQUAL( aIndex[ nPos + 1 ][ INDEXKEY_KEY ], xSeek ) + nIni := nPos + 1 + ELSE + EXIT + ENDIF + ELSE + nEnd := nPos - 1 + ENDIF + IF nRec != NIL .AND. nRec == aIndex[ nPos ][ INDEXKEY_RECORD ] + EXIT + ENDIF + ENDIF + ENDDO + IF aIndex[ nPos ] != NIL .AND. Eval( bAjust ) + nPos++ + ENDIF + ELSE + nPos := 1 + ENDIF + IF nRec != NIL + IF nIni <= nEnd .AND. ! Empty( aIndex ) .AND. aIndex[ nPos ] != NIL .AND. nRec != aIndex[ nPos ][ INDEXKEY_RECORD ] + nEnd := Len( aIndex ) + FOR nPos := nIni TO nEnd + IF aIndex[ nPos ] == NIL .OR. ! LEFTEQUAL( xSeek, aIndex[ nPos ][ INDEXKEY_KEY ] ) + nPos := 0 + EXIT + ELSEIF aIndex[ nPos ][ INDEXKEY_RECORD ] == nRec + EXIT + ENDIF + NEXT + IF nPos > nEnd + nPos := 0 + ENDIF + ENDIF + ELSEIF ! lSoft + IF nPos > Len( aIndex ) .OR. ! LEFTEQUAL( aIndex[ nPos ][ INDEXKEY_KEY ], xSeek ) + nPos := 0 + ENDIF + ENDIF + + ENDSWITCH + + RETURN nPos + +STATIC FUNCTION SeekScope( aIndex, aOrdInfo, lBottom ) + + LOCAL nPos := Seek( aOrdInfo[ WAOI_SCOPE_0 ], .T., lBottom, aIndex ) + + IF nPos > 0 .AND. ! LEFTEQUAL( aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ], aOrdInfo[ WAOI_SCOPE_1 ] ) + IF nPos > 1 .AND. aIndex[ INDEX_RECORDS ][ nPos - 1 ][ INDEXKEY_KEY ] >= aOrdInfo[ WAOI_SCOPE_0 ] + nPos-- + ELSE + nPos := 0 + ENDIF + ENDIF + + RETURN nPos diff --git a/contrib/rddmisc/dbtcdx.prg b/contrib/rddmisc/dbtcdx.prg new file mode 100644 index 0000000000..91e0d82320 --- /dev/null +++ b/contrib/rddmisc/dbtcdx.prg @@ -0,0 +1,73 @@ +/* + * DBTCDX RDD + * + * Copyright 2006 Przemyslaw Czerpak + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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 "dbinfo.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +/* + * DBTCDX RDD + * Very simple RDD which inherits from DBFCDX and + * set default memo type to DBT + */ + +/* Force linking DBFCDX and DBFFPT from which our RDD inherits */ +REQUEST DBFCDX +REQUEST DBFFPT + +/* Announce our RDD for foreign REQUESTs */ +ANNOUNCE DBTCDX + +FUNCTION DBTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + "DBFCDX", {}, pSuperRddID ) /* We are inheriting from DBFCDX */ + +INIT PROCEDURE DBTCDX_INIT() + + rddRegister( "DBTCDX", RDT_FULL ) + rddInfo( RDDI_MEMOTYPE, DB_MEMO_DBT, "DBTCDX" ) + + RETURN diff --git a/contrib/rddmisc/fptcdx.prg b/contrib/rddmisc/fptcdx.prg new file mode 100644 index 0000000000..fd99e1c8a2 --- /dev/null +++ b/contrib/rddmisc/fptcdx.prg @@ -0,0 +1,73 @@ +/* + * FPTCDX RDD + * + * Copyright 2006 Przemyslaw Czerpak + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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 "dbinfo.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +/* + * FPTCDX RDD + * Very simple RDD which inherits from DBFCDX and + * set default memo type to FPT + */ + +/* Force linking DBFCDX and DBFFPT from which our RDD inherits */ +REQUEST DBFCDX +REQUEST DBFFPT + +/* Announce our RDD for foreign REQUESTs */ +ANNOUNCE FPTCDX + +FUNCTION FPTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + "DBFCDX", {}, pSuperRddID ) /* We are inheriting from DBFCDX */ + +INIT PROCEDURE FPTCDX_INIT() + + rddRegister( "FPTCDX", RDT_FULL ) + rddInfo( RDDI_MEMOTYPE, DB_MEMO_FPT, "FPTCDX" ) + + RETURN diff --git a/contrib/rddmisc/hscdx.prg b/contrib/rddmisc/hscdx.prg new file mode 100644 index 0000000000..4cc46b7782 --- /dev/null +++ b/contrib/rddmisc/hscdx.prg @@ -0,0 +1,284 @@ +/* + * HSCDX + * + * Copyright 2006 Przemyslaw Czerpak + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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. + * + */ + +/* + * A simple RDD which adds automatically update HSX indexes to DBFCDX + * To create new HSX index for current work area use: hsx_Create() + * To open already existing one use hsx_Open(), + * To close use: hsx_Close() + * To retrieve an handle use: hsx_Handle() + */ + +#include "dbinfo.ch" +#include "fileio.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +ANNOUNCE HSCDX + +/* + * methods: NEW and RELEASE receive pointer to work area structure + * not work area number. It's necessary because the can be executed + * before work area is allocated + * these methods does not have to execute SUPER methods - this is + * always done by low-level USRRDD code + */ + +STATIC FUNCTION _HSX_NEW( pWA ) + + LOCAL aWData := { .F., {}, {} } + + /* + * Set in our private AREA item the array where we will keep HSX indexes + * and HOT buffer flag + */ + + USRRDD_AREADATA( pWA, aWData ) + + RETURN HB_SUCCESS + +STATIC FUNCTION _HSX_CLOSE( nWA ) + + LOCAL aWData := USRRDD_AREADATA( nWA ), nHSX + + /* close all HSX indexes */ + + FOR EACH nHSX IN aWData[ 2 ] + hs_Close( nHSX ) + NEXT + + /* clean the HSX index array */ + ASize( aWData[ 2 ], 0 ) + ASize( aWData[ 3 ], 0 ) + + /* call SUPER CLOSE method to close parent RDD */ + + RETURN UR_SUPER_CLOSE( nWA ) + +STATIC FUNCTION _HSX_GOCOLD( nWA ) + + LOCAL nResult, aWData, nHSX, nRecNo, nKeyNo + + IF ( nResult := UR_SUPER_GOCOLD( nWA ) ) == HB_SUCCESS + aWData := USRRDD_AREADATA( nWA ) + IF aWData[ 1 ] + IF ! Empty( aWData[ 2 ] ) + nRecNo := RecNo() + /* update HSX indexes */ + FOR EACH nHSX IN aWData[ 2 ] + nKeyNo := hs_KeyCount( nHSX ) + DO WHILE nKeyNo >= 0 .AND. nKeyNo < nRecNo + nKeyNo := hs_Add( nHSX, "" ) + ENDDO + IF nKeyNo >= nRecNo + hs_Replace( nHSX,, nRecNo ) + ENDIF + NEXT + ENDIF + aWData[ 1 ] := .F. + ENDIF + ENDIF + + RETURN nResult + +STATIC FUNCTION _HSX_GOHOT( nWA ) + + LOCAL nResult, aWData + + IF ( nResult := UR_SUPER_GOHOT( nWA ) ) == HB_SUCCESS + aWData := USRRDD_AREADATA( nWA ) + aWData[ 1 ] := .T. + ENDIF + + RETURN nResult + +STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll ) + + LOCAL nResult, aWData + + IF ( nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) ) == HB_SUCCESS + aWData := USRRDD_AREADATA( nWA ) + aWData[ 1 ] := .T. + ENDIF + + RETURN nResult + +/* + * Three public functions for CREATE, OPEN and CLOSE HSX indexes bound + * with current work are and automatically updated. + */ + +FUNCTION hsx_Create( cFile, cExpr, nKeySize, nBufSize, lCase, nFiltSet ) + + LOCAL aWData, nHsx := -1, nOpenMode + + IF ! Used() + ELSEIF ! rddName() == "HSCDX" + ELSE + aWData := USRRDD_AREADATA( Select() ) + nOpenMode := iif( dbInfo( DBI_SHARED ), 1, 0 ) + ; + iif( dbInfo( DBI_ISREADONLY ), 2, 0 ) + IF ( nHsx := hs_Index( cFile, cExpr, nKeySize, nOpenMode, nBufSize, lCase, nFiltSet ) ) >= 0 + AAdd( aWData[ 2 ], nHsx ) + AAdd( aWData[ 3 ], cFile ) + ENDIF + ENDIF + + RETURN nHsx + +PROCEDURE hsx_Open( cFile, nBufSize ) + + LOCAL aWData, nHsx, nOpenMode + + IF ! Used() + ELSEIF ! rddName() == "HSCDX" + ELSE + aWData := USRRDD_AREADATA( Select() ) + nOpenMode := iif( dbInfo( DBI_SHARED ), 1, 0 ) + ; + iif( dbInfo( DBI_ISREADONLY ), 2, 0 ) + IF ( nHsx := hs_Open( cFile, nBufSize, nOpenMode ) ) >= 0 + AAdd( aWData[ 2 ], nHsx ) + AAdd( aWData[ 3 ], cFile ) + ENDIF + ENDIF + + RETURN + +PROCEDURE hsx_Close( xHSX ) + + LOCAL aWData, nSlot + + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + DO CASE + CASE HB_ISNUMERIC( xHSX ) + nSlot := AScan( aWData[ 2 ], xHSX ) + CASE HB_ISSTRING( xHSX ) + nSlot := AScan( aWData[ 3 ], {| _1 | _1 == xHSX } ) + OTHERWISE + nSlot := 0 + ENDCASE + IF nSlot > 0 + hb_ADel( aWData[ 2 ], nSlot, .T. ) + hb_ADel( aWData[ 3 ], nSlot, .T. ) + ENDIF + ENDIF + + RETURN + +FUNCTION hsx_Handle( cFile ) + + LOCAL aWData, nSlot + + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + nSlot := AScan( aWData[ 3 ], {| _1 | _1 == cFile } ) + IF nSlot != 0 + RETURN aWData[ 2 ][ nSlot ] + ENDIF + ENDIF + + RETURN -1 + +FUNCTION hsx_File( nHsx ) + + LOCAL aWData, nSlot + + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + nSlot := AScan( aWData[ 3 ], nHsx ) + IF nSlot != 0 + RETURN aWData[ 3 ][ nSlot ] + ENDIF + ENDIF + + RETURN "" + +FUNCTION hsx_Get( nSlot ) + + LOCAL aWData + + IF Used() .AND. rddName() == "HSCDX" + aWData := USRRDD_AREADATA( Select() ) + IF nSlot > 0 .AND. nSlot <= Len( aWData[ 2 ] ) + RETURN aWData[ 2 ][ nSlot ] + ENDIF + ENDIF + + RETURN -1 + +/* Force linking DBFCDX from which our RDD inherits */ + +REQUEST DBFCDX + +/* + * This function have to exist in all RDD and then name have to be in + * format: _GETFUNCTABLE + */ + +FUNCTION HSCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + + LOCAL cSuperRDD := "DBFCDX" /* We are inheriting from DBFCDX */ + LOCAL aMyFunc[ UR_METHODCOUNT ] + + aMyFunc[ UR_NEW ] := @_HSX_NEW() + aMyFunc[ UR_CLOSE ] := @_HSX_CLOSE() + aMyFunc[ UR_GOCOLD ] := @_HSX_GOCOLD() + aMyFunc[ UR_GOHOT ] := @_HSX_GOHOT() + aMyFunc[ UR_APPEND ] := @_HSX_APPEND() + + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc, pSuperRddID ) + +/* + * Register our HSCDX at program startup + */ + +INIT PROCEDURE HSCDX_INIT() + + rddRegister( "HSCDX", RDT_FULL ) + + RETURN diff --git a/contrib/rddmisc/logrdd.prg b/contrib/rddmisc/logrdd.prg new file mode 100644 index 0000000000..781024ecf8 --- /dev/null +++ b/contrib/rddmisc/logrdd.prg @@ -0,0 +1,467 @@ +/* + * LOGRDD + * + * Copyright 2009 Francesco Saverio Giudice + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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. + * + */ + +/* + * A simple RDD which introduce logging to file. It inherits from + * any existent RDD but if you write / replace / delete something + * on tables it writes changes in a log file. + */ + +#include "dbinfo.ch" +#include "fileio.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +#define ARRAY_FILENAME 1 +#define ARRAY_FHANDLE 2 +#define ARRAY_TAG 3 +#define ARRAY_ACTIVE 4 +#define ARRAY_RDDNAME 5 +#define ARRAY_MSGLOGBLOCK 6 +#define ARRAY_USERLOGBLOCK 7 + +ANNOUNCE LOGRDD + +DYNAMIC hb_LogRddInherit /* To be defined at user level */ + +STATIC s_nRddID := -1 + +STATIC FUNCTION LOGRDD_INIT( nRDD ) + + /* Defaults */ + + LOCAL cFileName := "changes.log" + LOCAL lActive := .F. + LOCAL cTag := NetName() + "\" + hb_UserName() + LOCAL cRDDName := hb_LogRddInherit() + + /* Log File will be open later so user can change parameters */ + + /* Store data in RDD cargo */ + /* cFileName, hFile, cTag, lActive, cRDDName, bMsgLogBlock, bUserLogBlock */ + USRRDD_RDDDATA( nRDD, { cFileName, NIL, cTag, lActive, cRDDName, NIL, NIL } ) + + RETURN HB_SUCCESS + +STATIC FUNCTION LOGRDD_EXIT( nRDD ) + + LOCAL aRDDData := USRRDD_RDDDATA( nRDD ) + + /* Closing log file */ + + IF aRDDData[ ARRAY_FHANDLE ] != NIL + FClose( aRDDData[ ARRAY_FHANDLE ] ) + aRDDData[ ARRAY_FHANDLE ] := NIL + ENDIF + + RETURN HB_SUCCESS + +// Create database from current WA fields definition + +STATIC FUNCTION LOGRDD_CREATE( nWA, aOpenInfo ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_CREATE( nWA, aOpenInfo ) ) == HB_SUCCESS + ToLog( "CREATE", nWA, aOpenInfo ) + ENDIF + + RETURN nResult + +// Creating fields for new DBF - dbCreate() in current workarea + +STATIC FUNCTION LOGRDD_CREATEFIELDS( nWA, aStruct ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_CREATEFIELDS( nWA, aStruct ) ) == HB_SUCCESS + ToLog( "CREATEFIELDS", nWA, aStruct ) + ENDIF + + RETURN nResult + +// Open workarea + +STATIC FUNCTION LOGRDD_OPEN( nWA, aOpenInfo ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) ) == HB_SUCCESS + ToLog( "OPEN", nWA, aOpenInfo ) + ENDIF + + RETURN nResult + +// Close workarea + +STATIC FUNCTION LOGRDD_CLOSE( nWA ) + + LOCAL cFile := dbInfo( DBI_FULLPATH ) + LOCAL cAlias := Alias() + LOCAL nResult + + IF ( nResult := UR_SUPER_CLOSE( nWA ) ) == HB_SUCCESS + ToLog( "CLOSE", nWA, cFile, cAlias ) + ENDIF + + RETURN nResult + +STATIC FUNCTION LOGRDD_APPEND( nWA, lUnlockAll ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) ) == HB_SUCCESS + ToLog( "APPEND", nWA, lUnlockAll ) + ENDIF + + RETURN nResult + +STATIC FUNCTION LOGRDD_DELETE( nWA ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_DELETE( nWA ) ) == HB_SUCCESS + ToLog( "DELETE", nWA ) + ENDIF + + RETURN nResult + +STATIC FUNCTION LOGRDD_RECALL( nWA ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_RECALL( nWA ) ) == HB_SUCCESS + ToLog( "RECALL", nWA ) + ENDIF + + RETURN nResult + +STATIC FUNCTION LOGRDD_PUTVALUE( nWA, nField, xValue ) + + LOCAL xOldValue := FieldGet( nField ) + LOCAL nResult := UR_SUPER_PUTVALUE( nWA, nField, xValue ) + + // Log changes only + + IF ! xOldValue == xValue + ToLog( "PUTVALUE", nWA, nField, xValue, xOldValue ) + ENDIF + + RETURN nResult + +STATIC FUNCTION LOGRDD_ZAP( nWA ) + + LOCAL nResult + + IF ( nResult := UR_SUPER_ZAP( nWA ) ) == HB_SUCCESS + ToLog( "ZAP", nWA ) + ENDIF + + RETURN nResult + +/* Force linking DBFCDX from which our RDD inherits */ + +REQUEST DBFCDX + +/* + * This function have to exist in all RDD and then name have to be in + * format: _GETFUNCTABLE + */ + +FUNCTION LOGRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + + LOCAL cSuperRDD := hb_LogRddInherit() /* We are inheriting from a User Defined RDD */ + LOCAL aMyFunc[ UR_METHODCOUNT ] + + s_nRddID := nRddID + + aMyFunc[ UR_INIT ] := @LOGRDD_INIT() + aMyFunc[ UR_EXIT ] := @LOGRDD_EXIT() + aMyFunc[ UR_CREATE ] := @LOGRDD_CREATE() + aMyFunc[ UR_CREATEFIELDS ] := @LOGRDD_CREATEFIELDS() + aMyFunc[ UR_OPEN ] := @LOGRDD_OPEN() + aMyFunc[ UR_CLOSE ] := @LOGRDD_CLOSE() + aMyFunc[ UR_APPEND ] := @LOGRDD_APPEND() + aMyFunc[ UR_DELETE ] := @LOGRDD_DELETE() + aMyFunc[ UR_RECALL ] := @LOGRDD_RECALL() + aMyFunc[ UR_PUTVALUE ] := @LOGRDD_PUTVALUE() + aMyFunc[ UR_ZAP ] := @LOGRDD_ZAP() + + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc, pSuperRddID ) + +INIT PROCEDURE _LOGRDD_INIT() + + rddRegister( "LOGRDD", RDT_FULL ) + + RETURN + +/* User utility functions */ + +FUNCTION hb_LogRddLogFileName( cFileName ) + + LOCAL aRDDData + LOCAL cOldFileName + + IF s_nRddID >= 0 + + aRDDData := USRRDD_RDDDATA( s_nRddID ) + + cOldFileName := aRDDData[ ARRAY_FILENAME ] + + IF HB_ISSTRING( cFileName ) + aRDDData[ ARRAY_FILENAME ] := cFileName + ENDIF + ENDIF + + RETURN cOldFileName + +FUNCTION hb_LogRddTag( cTag ) + + LOCAL aRDDData + LOCAL cOldTag + + IF s_nRddID >= 0 + + aRDDData := USRRDD_RDDDATA( s_nRddID ) + + cOldTag := aRDDData[ ARRAY_TAG ] + + IF HB_ISSTRING( cTag ) + aRDDData[ ARRAY_TAG ] := cTag + ENDIF + ENDIF + + RETURN cOldTag + +FUNCTION hb_LogRddActive( lActive ) + + LOCAL aRDDData + LOCAL lOldActive + + IF s_nRddID >= 0 + + aRDDData := USRRDD_RDDDATA( s_nRddID ) + + lOldActive := aRDDData[ ARRAY_ACTIVE ] + + IF HB_ISLOGICAL( lActive ) + aRDDData[ ARRAY_ACTIVE ] := lActive + ENDIF + ENDIF + + RETURN lOldActive + +FUNCTION hb_LogRddMsgLogBlock( bMsgLogBlock ) + + LOCAL aRDDData + LOCAL bOldMsgLogBlock + + IF s_nRddID >= 0 + + aRDDData := USRRDD_RDDDATA( s_nRddID ) + + bOldMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ] + + IF HB_ISEVALITEM( bMsgLogBlock ) + aRDDData[ ARRAY_MSGLOGBLOCK ] := bMsgLogBlock + ENDIF + ENDIF + + RETURN bOldMsgLogBlock + +FUNCTION hb_LogRddUserLogBlock( bUserLogBlock ) + + LOCAL aRDDData + LOCAL bOldUserLogBlock + + IF s_nRddID >= 0 + + aRDDData := USRRDD_RDDDATA( s_nRddID ) + + bOldUserLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ] + + IF HB_ISEVALITEM( bUserLogBlock ) + aRDDData[ ARRAY_USERLOGBLOCK ] := bUserLogBlock + ENDIF + ENDIF + + RETURN bOldUserLogBlock + +FUNCTION hb_LogRddValueToText( uValue ) + + LOCAL cType + LOCAL cText + + SWITCH cType := ValType( uValue ) + CASE "C" ; cText := hb_StrToExp( uValue ) ; EXIT + CASE "N" ; cText := hb_ntos( uValue ) ; EXIT + CASE "D" ; cText := DToS( uValue ) ; cText := "0d" + iif( Empty( cText ), "00000000", cText ) ; EXIT + OTHERWISE ; cText := hb_ValToStr( uValue ) + ENDSWITCH + + RETURN "[" + cType + "]>>>" + cText + "<<<" + +/* Local utility functions */ + +STATIC PROCEDURE OpenLogFile( nWA ) + + LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) + LOCAL cFileName := aRDDData[ ARRAY_FILENAME ] + LOCAL hFile := aRDDData[ ARRAY_FHANDLE ] + LOCAL lActive := aRDDData[ ARRAY_ACTIVE ] + +#if 0 + TraceLog( "hFile " + CStr( hFile ) ) +#endif + + IF lActive .AND. hFile == NIL + + /* Open Access Log File */ + IF hb_FileExists( cFileName ) + hFile := FOpen( cFileName, FO_READWRITE + FO_SHARED ) + ELSE + hFile := FCreate( cFileName ) + /* Close and reopen in shared mode */ + IF FError() == 0 .AND. hFile != F_ERROR + FClose( hFile ) + hFile := FOpen( cFileName, FO_READWRITE + FO_SHARED ) + ENDIF + ENDIF + IF FError() == 0 .AND. hFile != F_ERROR + /* Move to end of file */ + FSeek( hFile, 0, FS_END ) + ELSE + hFile := NIL + ENDIF + + aRDDData[ ARRAY_FHANDLE ] := hFile + ENDIF + + RETURN + +STATIC FUNCTION ToString( cCmd, nWA, xPar1, xPar2, xPar3 ) + + SWITCH cCmd + CASE "CREATE" + // Parameters received: xPar1: aOpenInfo + RETURN xPar1[ UR_OI_NAME ] + CASE "CREATEFIELDS" + // Parameters received: xPar1: aStruct + RETURN hb_ValToExp( xPar1 ) + CASE "OPEN" + // Parameters received: xPar1: aOpenInfo + RETURN 'Table: "' + xPar1[ UR_OI_NAME ] + '", Alias: "' + Alias() + '", WorkArea: ' + hb_ntos( nWA ) + CASE "CLOSE" + // Parameters received: xPar1: cTableName, xPar2: cAlias + RETURN 'Table: "' + xPar1 + '", Alias: "' + xPar2 + '", WorkArea: ' + hb_ntos( nWA ) + CASE "APPEND" + // Parameters received: xPar1: lUnlockAll + RETURN Alias() + "->RecNo() == " + hb_ntos( RecNo() ) + CASE "DELETE" + // Parameters received: none + RETURN Alias() + "->RecNo() == " + hb_ntos( RecNo() ) + CASE "RECALL" + // Parameters received: none + RETURN Alias() + "->RecNo() == " + hb_ntos( RecNo() ) + CASE "PUTVALUE" + // Parameters received: xPar1: nField, xPar2: xValue, xPar3: xOldValue + HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value + RETURN Alias() + "(" + hb_ntos( RecNo() ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 ) + CASE "ZAP" + // Parameters received: none + RETURN 'Alias: "' + Alias() + ' Table: "' + dbInfo( DBI_FULLPATH ) + '"' + ENDSWITCH + + RETURN NIL + +STATIC PROCEDURE ToLog( cCmd, nWA, xPar1, xPar2, xPar3 ) + + LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) + LOCAL lActive := aRDDData[ ARRAY_ACTIVE ] + LOCAL hFile, cTag, cRDDName, bMsgLogBlock, bUserLogBlock, cLog + + // Check if logging system is active + + IF lActive + + cTag := aRDDData[ ARRAY_TAG ] + cRDDName := aRDDData[ ARRAY_RDDNAME ] + bUserLogBlock := aRDDData[ ARRAY_USERLOGBLOCK ] + + // If not defined a User codeblock + IF ! HB_ISEVALITEM( bUserLogBlock ) + + hFile := aRDDData[ ARRAY_FHANDLE ] + + // If log file is not already open I open now + IF hFile == NIL + OpenLogFile( nWA ) + ENDIF + + IF hFile != NIL + + bMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ] + + // If defined a codeblock I send to user infos and he has to return a formatted string + // Look at local ToString() function for details + IF HB_ISEVALITEM( bMsgLogBlock ) + cLog := Eval( bMsgLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) + ELSE + cLog := DToS( Date() ) + " " + Time() + " " + cTag + ": " + PadR( cRDDName + "_" + cCmd, 20 ) + " - " + ToString( cCmd, nWA, xPar1, xPar2, xPar3 ) + ENDIF + // Log to file only if cLog is a valid string + IF HB_ISSTRING( cLog ) + FWrite( hFile, cLog + hb_eol() ) + ENDIF + ENDIF + ELSE + // Otherwise I send all to user that is responsible to log everywhere + Eval( bUserLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) + ENDIF + ENDIF + + RETURN diff --git a/contrib/rddmisc/rlcdx.prg b/contrib/rddmisc/rlcdx.prg new file mode 100644 index 0000000000..5e839df89c --- /dev/null +++ b/contrib/rddmisc/rlcdx.prg @@ -0,0 +1,222 @@ +/* + * RLCDX + * + * Copyright 2006 Przemyslaw Czerpak + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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. + * + */ + +/* + * A simple RDD which introduce lock counters. It has full DBFCDX + * functionality from which it inherits but if you execute dbRLock( 100 ) + * twice then you will have to also repeat call to dbRUnlock( 100 ) to + * really unlock the record 100. The same if for FLock() + * This idea comes from one of messages sent by Mindaugas Kavaliauskas. + */ + +#include "hbusrrdd.ch" +#include "rddsys.ch" + +ANNOUNCE RLCDX + +/* + * methods: NEW and RELEASE receive pointer to work area structure + * not work area number. It's necessary because the can be executed + * before work area is allocated + * these methods does not have to execute SUPER methods - this is + * always done by low-level USRRDD code + */ + +STATIC FUNCTION RLCDX_NEW( pWA ) + + LOCAL aWData := { 0, {} } + + /* + * Set in our private AREA item the array with number of FLOCKs + * recursively called and array with LOCKED records + */ + + USRRDD_AREADATA( pWA, aWData ) + + RETURN HB_SUCCESS + +STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) + + LOCAL aWData, nResult, xRecId, i + + aWData := USRRDD_AREADATA( nWA ) + + /* Convert EXCLUSIVE locks to DBLM_MULTIPLE */ + IF aLockInfo[ UR_LI_METHOD ] == DBLM_EXCLUSIVE + aLockInfo[ UR_LI_METHOD ] := DBLM_MULTIPLE + aLockInfo[ UR_LI_RECORD ] := RecNo() + ENDIF + + IF aLockInfo[ UR_LI_METHOD ] == DBLM_MULTIPLE /* RLOCK */ + + IF aWData[ 1 ] > 0 + aLockInfo[ UR_LI_RESULT ] := .T. + RETURN HB_SUCCESS + ENDIF + + xRecID := aLockInfo[ UR_LI_RECORD ] + IF Empty( xRecID ) + xRecID := RecNo() + ENDIF + + IF aWData[ 1 ] > 0 + aLockInfo[ UR_LI_RESULT ] := .T. + RETURN HB_SUCCESS + ELSEIF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) > 0 + ++aWData[ 2 ][ i ][ 2 ] + aLockInfo[ UR_LI_RESULT ] := .T. + RETURN HB_SUCCESS + ENDIF + + IF ( nResult := UR_SUPER_LOCK( nWA, aLockInfo ) ) == HB_SUCCESS + IF aLockInfo[ UR_LI_RESULT ] + AAdd( aWData[ 2 ], { xRecID, 1 } ) + ENDIF + ENDIF + + RETURN nResult + + ELSEIF aLockInfo[ UR_LI_METHOD ] == DBLM_FILE /* FLOCK */ + + IF aWData[ 1 ] > 0 + ++aWData[ 1 ] + RETURN HB_SUCCESS + ENDIF + + IF ( nResult := UR_SUPER_LOCK( nWA, aLockInfo ) ) == HB_SUCCESS + + /* FLOCK always first remove all RLOCKs, even if it fails */ + ASize( aWData[ 2 ], 0 ) + + IF aLockInfo[ UR_LI_RESULT ] + aWData[ 1 ] := 1 + ENDIF + ENDIF + + RETURN nResult + + ENDIF + + aLockInfo[ UR_LI_RESULT ] := .F. + + RETURN HB_FAILURE + +STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID ) + + LOCAL aWData := USRRDD_AREADATA( nWA ), i + + IF HB_ISNUMERIC( xRecID ) .AND. xRecID > 0 + IF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) > 0 + IF --aWData[ 2 ][ i ][ 2 ] > 0 + RETURN HB_SUCCESS + ENDIF + hb_ADel( aWData[ 2 ], i, .T. ) + ELSE + RETURN HB_SUCCESS + ENDIF + ELSE + IF aWData[ 1 ] > 1 + --aWData[ 1 ] + RETURN HB_SUCCESS + ENDIF + aWData[ 1 ] := 0 + ASize( aWData[ 2 ], 0 ) + ENDIF + + RETURN UR_SUPER_UNLOCK( nWA, xRecID ) + +STATIC FUNCTION RLCDX_APPEND( nWA, lUnlockAll ) + + LOCAL aWData, nResult, xRecId, i + + /* Never unlock other records, they have to be explicitly unlocked */ + + lUnlockAll := .F. + + IF ( nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) ) == HB_SUCCESS + + aWData := USRRDD_AREADATA( nWA ) + IF aWData[ 1 ] == 0 + xRecId := RecNo() + /* Some RDDs may allow to set phantom locks with RLOCK so we should + check if it's not the case and increase the counter when it is */ + IF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) > 0 + ++aWData[ 2 ][ i ][ 2 ] + ELSE + AAdd( aWData[ 2 ], { xRecID, 1 } ) + ENDIF + ENDIF + ENDIF + + RETURN nResult + +/* Force linking DBFCDX from which our RDD inherits */ + +REQUEST DBFCDX + +/* + * This function have to exist in all RDD and then name have to be in + * format: _GETFUNCTABLE + */ + +FUNCTION RLCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + + LOCAL cSuperRDD := "DBFCDX" /* We are inheriting from DBFCDX */ + LOCAL aMethods[ UR_METHODCOUNT ] + + aMethods[ UR_NEW ] := @RLCDX_NEW() + aMethods[ UR_LOCK ] := @RLCDX_LOCK() + aMethods[ UR_UNLOCK ] := @RLCDX_UNLOCK() + aMethods[ UR_APPEND ] := @RLCDX_APPEND() + + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMethods, pSuperRddID ) + +INIT PROCEDURE RLCDX_INIT() + + rddRegister( "RLCDX", RDT_FULL ) + + RETURN diff --git a/contrib/rddmisc/smtcdx.prg b/contrib/rddmisc/smtcdx.prg new file mode 100644 index 0000000000..7befe78a51 --- /dev/null +++ b/contrib/rddmisc/smtcdx.prg @@ -0,0 +1,73 @@ +/* + * SMTCDX RDD + * + * Copyright 2006 Przemyslaw Czerpak + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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. + * + */ + +/* + * SMTCDX RDD + * Very simple RDD which inherits from DBFCDX and + * set default memo type to SMT + */ + +#include "dbinfo.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +/* Force linking DBFCDX and DBFFPT from which our RDD inherits */ +REQUEST DBFCDX +REQUEST DBFFPT + +/* Announce our RDD for foreign REQUESTs */ +ANNOUNCE SMTCDX + +FUNCTION SMTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + "DBFCDX", {}, pSuperRddID ) /* We are inheriting from DBFCDX */ + +INIT PROCEDURE SMTCDX_INIT() + + rddRegister( "SMTCDX", RDT_FULL ) + rddInfo( RDDI_MEMOTYPE, DB_MEMO_SMT, "SMTCDX" ) + + RETURN diff --git a/contrib/rddmisc/vfpcdx.prg b/contrib/rddmisc/vfpcdx.prg new file mode 100644 index 0000000000..c1c4706bbb --- /dev/null +++ b/contrib/rddmisc/vfpcdx.prg @@ -0,0 +1,70 @@ +/* + * VFPCDX + * + * Copyright 2007 Miguel Angel Marchuet Frutos + * + * 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 program; see the file LICENSE.txt. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). + * + * 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 "dbinfo.ch" +#include "hbusrrdd.ch" +#include "rddsys.ch" + +/* Force linking DBFCDX from which our RDD inherits */ +REQUEST DBFCDX +REQUEST DBFFPT + +ANNOUNCE VFPCDX + +/* We are inheriting from DBFCDX */ +FUNCTION VFPCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, "DBFCDX", {}, pSuperRddID ) + +INIT PROCEDURE VFPCDX_INIT() + + rddRegister( "VFPCDX", RDT_FULL ) + + rddInfo( RDDI_TABLETYPE, DB_DBF_VFP, "VFPCDX" ) + rddInfo( RDDI_MEMOTYPE, DB_MEMO_FPT, "VFPCDX" ) + rddInfo( RDDI_MEMOVERSION, DB_MEMOVER_STD, "VFPCDX" ) + rddInfo( RDDI_LOCKSCHEME, DB_DBFLOCK_VFP, "VFPCDX" ) + + RETURN diff --git a/src/rdd/usrrdd/rdds/arrayrdd.prg b/src/rdd/usrrdd/rdds/arrayrdd.prg index 4bc2c789bf..ab26856363 100644 --- a/src/rdd/usrrdd/rdds/arrayrdd.prg +++ b/src/rdd/usrrdd/rdds/arrayrdd.prg @@ -1,2048 +1 @@ -/* - * ARRAY RDD - * - * Copyright 2006 Francesco Saverio Giudice - * Copyright 2011-2013 Quique (Index, locate and filter Support) - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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. - * - */ - -/* This is a Array RDD, or Memory RDD. - It works only in memory and actually supports standard dbf commands - except relations. */ - -#include "dbinfo.ch" -#include "dbstruct.ch" -#include "error.ch" -#include "fileio.ch" -#include "hbtrace.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -#xtranslate Throw( ) => ( Eval( ErrorBlock(), ), Break( ) ) - -#define LEFTEQUAL( l, r ) iif( ValType( l ) $ "CM", Left( l, Len( r ) ) == r, l == r ) - -ANNOUNCE ARRAYRDD - -#define DATABASE_FILENAME 1 -#define DATABASE_RECORDS 2 -#define DATABASE_RECINFO 3 -#define DATABASE_OPENNUMBER 4 -#define DATABASE_LOCKED 5 -#define DATABASE_STRUCT 6 -#define DATABASE_INDEX 7 -#define DATABASE_SIZEOF 7 - -#define RDDDATA_DATABASE 1 -#define RDDDATA_SIZEOF 1 - -#define WADATA_DATABASE 1 -#define WADATA_WORKAREA 2 -#define WADATA_OPENINFO 3 -#define WADATA_RECNO 4 -#define WADATA_BOF 5 -#define WADATA_FORCEBOF 6 -#define WADATA_EOF 7 -#define WADATA_TOP 8 -#define WADATA_BOTTOM 9 -#define WADATA_FOUND 10 -#define WADATA_LOCKS 11 -#define WADATA_INDEX 12 -#define WADATA_WAORDINFO 13 -#define WADATA_ORDRECNO 14 -#define WADATA_FILTERINFO 15 -#define WADATA_LOCATE 16 -#define WADATA_SIZEOF 16 - -#define RECDATA_DELETED 1 -#define RECDATA_LOCKED 2 -#define RECDATA_SIZEOF 2 - -#define INDEX_TAG 1 -#define INDEX_ORCR 2 -#define INDEX_RECORDS 3 -#define INDEX_SIZEOF 3 - -#define INDEXKEY_KEY 1 -#define INDEXKEY_RECORD 2 -#define INDEXKEY_SIZEOF 2 - -#define WAOI_SCOPE_0 1 -#define WAOI_SCOPE_1 2 -#define WAOI_SIZEOF 2 - -STATIC s_nRddID := -1 - -/* - * non work area methods receive RDD ID as first parameter - * Methods INIT and EXIT does not have to execute SUPER methods - this is - * always done by low-level USRRDD code - */ - -STATIC FUNCTION AR_INIT( nRDD ) - - /* Init DBF Hash */ - - USRRDD_RDDDATA( nRDD, { => } ) - - RETURN HB_SUCCESS - -#if 0 - -STATIC FUNCTION AR_RDDDATAINIT() - RETURN { ; - NIL ; /* RDDDATA_DATABASE */ - } - -#endif - -STATIC FUNCTION AR_DATABASEINIT() - RETURN { ; - NIL, ; /* DATABASE_FILENAME */ - {}, ; /* DATABASE_RECORDS */ - {}, ; /* DATABASE_RECINFO */ - 0, ; /* DATABASE_OPENNUMBER */ - .F., ; /* DATABASE_LOCKED */ - NIL, ; /* DATABASE_STRUCT - aStruct */ - {} ; /* DATABASE_INDEX */ - } - -STATIC FUNCTION AR_WADATAINIT() - RETURN { ; - NIL, ; /* WADATA_DATABASE */ - 0, ; /* WADATA_WORKAREA */ - NIL, ; /* WADATA_OPENINFO */ - 0, ; /* WADATA_RECNO */ - .F., ; /* WADATA_BOF */ - .F., ; /* WADATA_FORCEBOF - to solve an hack in dbf1.c */ - .F., ; /* WADATA_EOF */ - .F., ; /* WADATA_TOP */ - .F., ; /* WADATA_BOTTOM */ - .F., ; /* WADATA_FOUND */ - {}, ; /* WADATA_LOCKS */ - 0, ; /* WADATA_INDEX */ - {}, ; /* WADATA_WAORDINFO */ - 0, ; /* WADATA_ORDRECNO */ - NIL, ; /* WADATA_FILTERINFO */ - Array( UR_SI_SIZE ); /* WADATA_LOCATE */ - } - -STATIC FUNCTION AR_RECDATAINIT() - RETURN { ; - .F., ; /* RECDATA_DELETED */ - 0; /* RECDATA_LOCKED (Number of area) */ - } - -STATIC FUNCTION AR_INDEXINIT() - RETURN { ; - NIL, ; /* INDEX_TAG */ - NIL, ; /* INDEX_ORCR */ - {} ; /* INDEX_RECORDS */ - } - -STATIC FUNCTION AR_INDEXKEYINIT() - RETURN { ; - NIL, ; /* INDEXKEY_KEY */ - NIL ; /* INDEXKEY_RECORD */ - } - -STATIC FUNCTION AR_WAOIINIT() - RETURN { ; - NIL, ; /* WAOI_SCOPE_0 */ - NIL ; /* WAOI_SCOPE_1 */ - } - -/* - * methods: NEW and RELEASE receive pointer to work area structure - * not work area number. It's necessary because the can be executed - * before work area is allocated - * these methods does not have to execute SUPER methods - this is - * always done by low-level USRRDD code - */ - -STATIC FUNCTION AR_NEW( pWA ) - - /* - * Set in our private AREA item the array with slot number and - * BOF/EOF flags. There is no BOF support in HB_F* function so - * we have to emulate it and there is no phantom record so we - * cannot return EOF flag directly. - */ - - USRRDD_AREADATA( pWA, AR_WADATAINIT() ) - - RETURN HB_SUCCESS - -/* Creating fields for new DBF - dbCreate() in current workarea */ - -STATIC FUNCTION AR_CREATEFIELDS( nWA, aStruct ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL nResult := HB_SUCCESS - LOCAL aFieldStruct, aField - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aStruct: %2$s", nWA, hb_ValToExp( aStruct ) ) ) - - /* Setting WA number to current WorkArea */ - aWAData[ WADATA_WORKAREA ] := nWA - - /* Create new file data structure - workarea uses a reference to database */ - aWAData[ WADATA_DATABASE ] := AR_DATABASEINIT() - - /* Store DBF Structure */ - aWAData[ WADATA_DATABASE ][ DATABASE_STRUCT ] := aStruct - - /* Set fields */ - UR_SUPER_SETFIELDEXTENT( nWA, Len( aStruct ) ) - - FOR EACH aFieldStruct IN aStruct - aFieldStruct[ DBS_NAME ] := Upper( aFieldStruct[ DBS_NAME ] ) - aFieldStruct[ DBS_TYPE ] := Upper( aFieldStruct[ DBS_TYPE ] ) - - aField := Array( UR_FI_SIZE ) - aField[ UR_FI_NAME ] := aFieldStruct[ DBS_NAME ] - aField[ UR_FI_TYPE ] := hb_Decode( aFieldStruct[ DBS_TYPE ], "C", HB_FT_STRING, "L", HB_FT_LOGICAL, "M", HB_FT_MEMO, "D", HB_FT_DATE, "N", iif( aFieldStruct[ DBS_DEC ] > 0, HB_FT_DOUBLE, HB_FT_INTEGER ) ) - aField[ UR_FI_TYPEEXT ] := 0 - aField[ UR_FI_LEN ] := aFieldStruct[ DBS_LEN ] - aField[ UR_FI_DEC ] := aFieldStruct[ DBS_DEC ] - UR_SUPER_ADDFIELD( nWA, aField ) - - NEXT - - RETURN nResult - -/* Create database from current WA fields definition */ - -STATIC FUNCTION AR_CREATE( nWA, aOpenInfo ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) - LOCAL cName - LOCAL cFullName, aDBFData, nResult /*, aFieldStruct, aField, aStruct */ - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOpenInfo: %2$s", nWA, hb_ValToExp( aOpenInfo ) ) ) - - /* getting database infos from current workarea */ - aDBFData := aWAData[ WADATA_DATABASE ] - - /* setting in uppercase chars to avoid differences */ - cFullName := Upper( aOpenInfo[ UR_OI_NAME ] ) - - /* When there is no ALIAS we will create new one using file name */ - IF aOpenInfo[ UR_OI_ALIAS ] == NIL - hb_FNameSplit( cFullName,, @cName ) - aOpenInfo[ UR_OI_ALIAS ] := cName - ENDIF - - /* Check if database is already present in memory slots */ - /* - 2008-11-07 FSG - dbCreate() doesn't check if a dbf file exists. So I will not check it. - If you need to check if a table exists use hb_dbExists() function that works in - similar way of hb_vfExists(), i.e.: - IF ! hb_dbExists( cFullName ) - dbCreate( cFullName, aStructure, "ARRAYRDD" ) - ... - ENDIF - */ - - /* Setting file attribs */ - aDBFData[ DATABASE_FILENAME ] := cFullName - aDBFData[ DATABASE_LOCKED ] := .T. /* I need Exclusive mode in creation */ - - /* Adding new database in RDD memory slots using filename as key */ - hRDDData[ cFullName ] := aDBFData - - /* Set WorkArea Info */ - aWAData[ WADATA_WORKAREA ] := nWA - aWAData[ WADATA_OPENINFO ] := aOpenInfo /* Put open informations */ - - /* Call SUPER OPEN to finish allocating work area (f.e.: alias settings) */ - nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) - - IF nResult == HB_SUCCESS - /* Add a new open number */ - aDBFData[ DATABASE_OPENNUMBER ]++ - /* default values for Records == 0 */ - aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. - aWAData[ WADATA_RECNO ] := 1 - ENDIF - - RETURN nResult - -STATIC FUNCTION AR_OPEN( nWA, aOpenInfo ) - - LOCAL cFullName, cName, hRDDData, aWAData, aDBFData - LOCAL aStruct, oError, aFieldStruct, aField, nResult - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOpenInfo: %2$s", nWA, hb_ValToExp( aOpenInfo ) ) ) - - cFullName := Upper( aOpenInfo[ UR_OI_NAME ] ) - - IF Right( cFullName, 1 ) == "." - cFullName := Left( cFullName, Len( cFullName ) - 1 ) - ENDIF - - /* When there is no ALIAS we will create new one using file name */ - IF aOpenInfo[ UR_OI_ALIAS ] == NIL - hb_FNameSplit( cFullName,, @cName ) - aOpenInfo[ UR_OI_ALIAS ] := cName - ENDIF - - hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) - - IF cFullName $ hRDDData - aDBFData := hRDDData[ cFullName ] - aStruct := aDBFData[ DATABASE_STRUCT ] - ELSE - oError := ErrorNew() - oError:GenCode := EG_OPEN - oError:SubCode := 1000 - oError:Description := hb_langErrMsg( EG_OPEN ) + ", memory file not found" - oError:FileName := aOpenInfo[ UR_OI_NAME ] - oError:CanDefault := .T. - NetErr( .T. ) - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - /* Set WorkArea Infos */ - aWAData := USRRDD_AREADATA( nWA ) - aWAData[ WADATA_DATABASE ] := aDBFData /* Put a reference to database */ - aWAData[ WADATA_WORKAREA ] := nWA - aWAData[ WADATA_OPENINFO ] := aOpenInfo /* Put open informations */ - - /* Set fields */ - UR_SUPER_SETFIELDEXTENT( nWA, Len( aStruct ) ) - - FOR EACH aFieldStruct IN aStruct - aField := Array( UR_FI_SIZE ) - aField[ UR_FI_NAME ] := aFieldStruct[ DBS_NAME ] - aField[ UR_FI_TYPE ] := hb_Decode( aFieldStruct[ DBS_TYPE ], "C", HB_FT_STRING, "L", HB_FT_LOGICAL, "M", HB_FT_MEMO, "D", HB_FT_DATE, "N", iif( aFieldStruct[ DBS_DEC ] > 0, HB_FT_DOUBLE, HB_FT_INTEGER ) ) - aField[ UR_FI_TYPEEXT ] := 0 - aField[ UR_FI_LEN ] := aFieldStruct[ DBS_LEN ] - aField[ UR_FI_DEC ] := aFieldStruct[ DBS_DEC ] - UR_SUPER_ADDFIELD( nWA, aField ) - NEXT - - /* Call SUPER OPEN to finish allocating work area (f.e.: alias settings) */ - nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) - - /* Add a new open number */ - aDBFData[ DATABASE_OPENNUMBER ]++ - - /* File already opened in exclusive mode */ - /* I have to do this check here because, in case of error, AR_CLOSE() is called however */ - IF aDBFData[ DATABASE_LOCKED ] - oError := ErrorNew() - oError:GenCode := EG_OPEN - oError:SubCode := 1000 - oError:Description := hb_langErrMsg( EG_OPEN ) + "(" + ; - hb_langErrMsg( EG_LOCK ) + " - already opened in exclusive mode)" - oError:FileName := aOpenInfo[ UR_OI_NAME ] - oError:CanDefault := .T. - NetErr( .T. ) - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - /* Open file in exclusive mode */ - IF ! aOpenInfo[ UR_OI_SHARED ] - IF aDBFData[ DATABASE_OPENNUMBER ] == 1 - aDBFData[ DATABASE_LOCKED ] := .T. - ELSE - oError := ErrorNew() - oError:GenCode := EG_OPEN - oError:SubCode := 1000 - oError:Description := hb_langErrMsg( EG_OPEN ) + "(" + ; - hb_langErrMsg( EG_LOCK ) + " - already opened in shared mode)" - oError:FileName := aOpenInfo[ UR_OI_NAME ] - oError:CanDefault := .T. - UR_SUPER_ERROR( nWA, oError ) - NetErr( .T. ) - RETURN HB_FAILURE - ENDIF - ENDIF - - IF nResult == HB_SUCCESS - NetErr( .F. ) - AR_GOTOP( nWA ) - ENDIF - - RETURN nResult - -STATIC FUNCTION AR_CLOSE( nWA ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF HB_ISARRAY( aDBFData ) - /* decrease open number */ - --aDBFData[ DATABASE_OPENNUMBER ] - - /* unlock file */ - aDBFData[ DATABASE_LOCKED ] := .F. /* Exclusive mode */ - ENDIF - - RETURN UR_SUPER_CLOSE( nWA ) - -STATIC FUNCTION AR_GETVALUE( nWA, nField, xValue ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL aStruct := aDBFData[ DATABASE_STRUCT ] - LOCAL nRecNo := aWAData[ WADATA_RECNO ] - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nField: %2$d, xValue: %3$s", nWA, nField, hb_ValToExp( xValue ) ) ) - - IF nField > 0 .AND. nField <= Len( aStruct ) - IF aWAData[ WADATA_EOF ] - /* We are at EOF position, return empty value */ - xValue := EmptyValue( aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) - ELSE - xValue := aRecords[ nRecNo ][ nField ] - ENDIF - RETURN HB_SUCCESS - ENDIF - - RETURN HB_FAILURE - -STATIC FUNCTION AR_PUTVALUE( nWA, nField, xValue ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL aStruct := aDBFData[ DATABASE_STRUCT ] - LOCAL nRecNo := aWAData[ WADATA_RECNO ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL aKeys[ Len( aIndexes ) ] - LOCAL xVal - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nField: %2$d, xValue: %3$s", nWA, nField, hb_ValToExp( xValue ) ) ) - - IF nField > 0 .AND. nField <= Len( aStruct ) .AND. ; - iif( HB_ISSTRING( xValue ) .AND. aStruct[ nField ][ DBS_TYPE ] == "M", .T., ValType( xValue ) == aStruct[ nField ][ DBS_TYPE ] ) - - xVal := PutValue( xValue, aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) - - AEval( aIndexes, {| aInd, n | aKeys[ n ] := Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ) } ) - - IF ! aWAData[ WADATA_EOF ] - aRecords[ nRecNo ][ nField ] := xVal - ENDIF - - AEval( aIndexes, {| aInd, n | ModifyIndex( n, Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aInd, aWAData, aKeys[ n ] ) } ) - - RETURN HB_SUCCESS - ENDIF - - RETURN HB_FAILURE - -STATIC FUNCTION AR_GOTO( nWA, nRecord ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL nRecCount := Len( aRecords ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecord: %2$d, nRecCount: %3$d", nWA, nRecord, nRecCount ) ) - - IF nRecord >= 1 .AND. nRecord <= nRecCount - aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .F. - aWAData[ WADATA_RECNO ] := nRecord - ELSEIF nRecCount == 0 - aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. - aWAData[ WADATA_RECNO ] := 1 - ELSEIF nRecord < 0 - aWAData[ WADATA_BOF ] := .T. - aWAData[ WADATA_EOF ] := .F. - aWAData[ WADATA_RECNO ] := 1 - ELSEIF nRecord == 0 .OR. nRecord > nRecCount - aWAData[ WADATA_BOF ] := .F. - aWAData[ WADATA_EOF ] := .T. - aWAData[ WADATA_RECNO ] := nRecCount + 1 - ENDIF - - AR_UNLOCK( nWA ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "aWAData[ WADATA_BOF ]: %1$s, aWAData[ WADATA_EOF ]: %2$s, aWAData[ WADATA_RECNO ]: %3$d", ; - hb_ValToExp( aWAData[ WADATA_BOF ] ), hb_ValToExp( aWAData[ WADATA_EOF ] ), aWAData[ WADATA_RECNO ] ) ) - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_GOTOID( nWA, nRecord ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecord: %2$d", nWA, nRecord ) ) - - RETURN AR_GOTO( nWA, nRecord ) - -STATIC FUNCTION AR_GOTOP( nWA ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL nRecCount := Len( aRecords ) - LOCAL nIndex := aWAData[ WADATA_INDEX ] - LOCAL nResult := HB_SUCCESS - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF nRecCount == 0 - aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. - aWAData[ WADATA_RECNO ] := 1 - ELSE - aWAData[ WADATA_BOF ] := .F. - aWAData[ WADATA_EOF ] := .F. - IF nIndex == 0 - aWAData[ WADATA_RECNO ] := 1 - ELSEIF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] == NIL - IF Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - aWAData[ WADATA_ORDRECNO ] := 0 - nResult := AR_GOTO( nWA, 0 ) - ELSE - aWAData[ WADATA_ORDRECNO ] := 1 - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ 1 ][ INDEXKEY_RECORD ] ) - ENDIF - ELSE - aWAData[ WADATA_ORDRECNO ] := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] ) - ENDIF - - IF Set( _SET_DELETED ) .AND. aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] - RETURN AR_SKIPFILTER( nWA, 1 ) - ENDIF - ENDIF - - AR_UNLOCK( nWA ) - - RETURN nResult - -STATIC FUNCTION AR_GOBOTTOM( nWA ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL nIndex := aWAData[ WADATA_INDEX ] - LOCAL nResult := HB_SUCCESS - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF Len( aRecords ) == 0 - aWAData[ WADATA_EOF ] := aWAData[ WADATA_BOF ] := .T. - aWAData[ WADATA_RECNO ] := 1 - ELSE - aWAData[ WADATA_BOF ] := .F. - aWAData[ WADATA_EOF ] := .F. - IF nIndex == 0 - aWAData[ WADATA_RECNO ] := Len( aRecords ) - ELSEIF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] == NIL - IF Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - aWAData[ WADATA_ORDRECNO ] := 0 - nResult := AR_GOTO( nWA, 0 ) - ELSE - aWAData[ WADATA_ORDRECNO ] := Len( ATail( aIndexes[ nIndex ][ INDEX_RECORDS ] ) ) - nResult := AR_GOTO( nWA, ATail( aIndexes[ nIndex ][ INDEX_RECORDS ] )[ INDEXKEY_RECORD ] ) - ENDIF - ELSE - aWAData[ WADATA_ORDRECNO ] := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .T. ) - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] ) - ENDIF - - IF Set( _SET_DELETED ) .AND. aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] - RETURN AR_SKIPFILTER( nWA, -1 ) - ENDIF - ENDIF - - AR_UNLOCK( nWA ) - - RETURN nResult - -STATIC FUNCTION AR_SETFILTER( nWa, aDbFilterInfo ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aDbFilterInfo: %2$s", nWA, hb_ValToExp( aDbFilterInfo ) ) ) - - USRRDD_AREADATA( nWA )[ WADATA_FILTERINFO ] := aDbFilterInfo - - RETURN SUCCESS - -STATIC FUNCTION AR_CLEARFILTER( nWA ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - USRRDD_AREADATA( nWA )[ WADATA_FILTERINFO ] := NIL - - RETURN SUCCESS - -STATIC FUNCTION AR_SKIPFILTER( nWA, nRecords ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL lBof, nToSkip - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$d", nWA, nRecords ) ) - - nToSkip := iif( nRecords > 0, 1, iif( nRecords < 0, -1, 0 ) ) - - IF nToSkip != 0 - DO WHILE ! aWAData[ WADATA_BOF ] .AND. ! aWAData[ WADATA_EOF ] - IF ( Set( _SET_DELETED ) .AND. aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] ) .OR. ; - ( aWAData[ WADATA_FILTERINFO ] != NIL .AND. ! Eval( aWAData[ WADATA_FILTERINFO ][ UR_FRI_BEXPR ] ) ) - IF AR_SKIPRAW( nWA, nToSkip ) != HB_SUCCESS - RETURN HB_FAILURE - ENDIF - IF nToSkip < 0 .AND. aWAData[ WADATA_BOF ] - lBof := .T. - aWAData[ WADATA_BOF ] := .F. - nToSkip := 1 - ELSEIF nToSkip > 0 .AND. aWAData[ WADATA_EOF ] - EXIT - ENDIF - LOOP - ENDIF - - /* FILTERS */ - EXIT - ENDDO - - IF lBof != NIL - aWAData[ WADATA_BOF ] := .T. - ENDIF - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_SKIPRAW( nWA, nRecords ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL nIndex := aWAData[ WADATA_INDEX ] - LOCAL aIndexes := aWAData[ WADATA_DATABASE ][ DATABASE_INDEX ] - LOCAL lBof, lEof - LOCAL nResult, nRec, nEnd, lScope0, lScope1 - LOCAL nIni := 0 - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$d", nWA, nRecords ) ) - - IF nRecords == 0 - lBof := aWAData[ WADATA_BOF ] - lEof := aWAData[ WADATA_EOF ] - - nResult := AR_GOTO( nWA, aWAData[ WADATA_RECNO ] ) - - aWAData[ WADATA_BOF ] := lBof - aWAData[ WADATA_EOF ] := lEof - - ELSEIF nIndex > 0 - nRec := ordKeyNo() - lScope0 := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] != NIL - lScope1 := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] != NIL - nEnd := ordKeyCount() - IF nRec == 0 - nRec := nEnd + 1 - ENDIF - IF lScope0 - nIni := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) - nIni-- - ENDIF - IF nIni == -1 .OR. Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - nResult := AR_GOTO( nWA, 0 ) - aWAData[ WADATA_ORDRECNO ] := 0 - ELSEIF nRecords < 0 .AND. -nRecords >= nRec - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ nIni + 1 ][ INDEXKEY_RECORD ] ) - aWAData[ WADATA_ORDRECNO ] := 1 - aWAData[ WADATA_BOF ] := .T. - ELSEIF nRecords > 0 .AND. nRec + nRecords > nEnd - nResult := AR_GOTO( nWA, 0 ) - aWAData[ WADATA_ORDRECNO ] := 0 - ELSE - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ nRec + nRecords + nIni ][ INDEXKEY_RECORD ] ) - aWAData[ WADATA_ORDRECNO ] := nRec + nRecords + nIni - IF aIndexes[ nIndex ][ INDEX_ORCR ][ UR_ORCR_CONDINFO ][ UR_ORC_DESCEND ] - IF nRecords < 0 - IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] != NIL .AND. aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] < aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_KEY ] - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ 1 ][ INDEXKEY_RECORD ] ) - aWAData[ WADATA_ORDRECNO ] := 1 - aWAData[ WADATA_BOF ] := .T. - ENDIF - ELSEIF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] != NIL .AND. aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] > aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_KEY ] - nResult := AR_GOTO( nWA, 0 ) - aWAData[ WADATA_ORDRECNO ] := 0 - ENDIF - ELSEIF lScope0 .AND. ! aIndexes[ nIndex ][ INDEX_RECORDS ][ nRec + nRecords + nIni ][ INDEXKEY_KEY ] >= aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] .OR. lScope1 .AND. ! aIndexes[ nIndex ][ INDEX_RECORDS ][ nRec + nRecords + nIni ][ INDEXKEY_KEY ] <= aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] - IF nRecords < 0 - IF aIndexes[ nIndex ][ INDEX_RECORDS ][ nIni + 1 ][ INDEXKEY_KEY ] - ENDIF - aWAData[ WADATA_ORDRECNO ] := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) - aWAData[ WADATA_BOF ] := aWAData[ WADATA_EOF ] - ELSE - nResult := AR_GOTO( nWA, 0 ) - aWAData[ WADATA_ORDRECNO ] := 0 - ENDIF - ENDIF - ENDIF - - ELSEIF nRecords < 0 .AND. -nRecords >= aWAData[ WADATA_RECNO ] - nResult := AR_GOTO( nWA, 1 ) - aWAData[ WADATA_BOF ] := .T. - ELSE - nResult := AR_GOTO( nWA, aWAData[ WADATA_RECNO ] + nRecords ) - ENDIF - - RETURN nResult - -STATIC FUNCTION AR_BOF( nWA, lBof ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lBof: %2$s", nWA, hb_ValToExp( lBof ) ) ) - - /* This is a hack to protect from dbf1.c skipraw hack */ - IF aWAData[ WADATA_FORCEBOF ] .AND. lBof - aWAData[ WADATA_BOF ] := lBof - aWAData[ WADATA_FORCEBOF ] := .F. - ELSE - lBof := aWAData[ WADATA_BOF ] - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_EOF( nWA, lEof ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lEof: %2$s", nWA, hb_ValToExp( lEof ) ) ) - - lEof := aWAData[ WADATA_EOF ] - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_DELETE( nWA ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL aKeys[ Len( aIndexes ) ] - LOCAL oError - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF aOpenInfo[ UR_OI_READONLY ] - oError := ErrorNew() - oError:GenCode := EG_READONLY - oError:SubCode := 1025 /* EDBF_READONLY */ - oError:Description := hb_langErrMsg( EG_READONLY ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - IF ! aWAData[ WADATA_EOF ] - - IF aOpenInfo[ UR_OI_SHARED ] .AND. AScan( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) == 0 - oError := ErrorNew() - oError:GenCode := EG_UNLOCKED - oError:SubCode := 1022 /* EDBF_UNLOCKED */ - oError:Description := hb_langErrMsg( EG_UNLOCKED ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - IF Len( aRecInfo ) > 0 .AND. aWAData[ WADATA_RECNO ] <= Len( aRecInfo ) - AEval( aIndexes, {| aInd, n | aKeys[ n ] := Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ) } ) - - aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] := .T. - - AEval( aIndexes, {| aInd, n | ModifyIndex( n, Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aInd, aWAData, aKeys[ n ] ) } ) - ENDIF - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_DELETED( nWA, lDeleted ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lDeleted: %2$s", nWA, hb_ValToExp( lDeleted ) ) ) - - IF Len( aRecInfo ) > 0 .AND. aWAData[ WADATA_RECNO ] <= Len( aRecInfo ) - lDeleted := aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] - ELSE - lDeleted := .F. - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_RECALL( nWA ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL aKeys[ Len( aIndexes ) ] - LOCAL oError - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF aOpenInfo[ UR_OI_READONLY ] - oError := ErrorNew() - oError:GenCode := EG_READONLY - oError:SubCode := 1025 /* EDBF_READONLY */ - oError:Description := hb_langErrMsg( EG_READONLY ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - IF ! aWAData[ WADATA_EOF ] - - IF aOpenInfo[ UR_OI_SHARED ] .AND. AScan( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) == 0 - oError := ErrorNew() - oError:GenCode := EG_UNLOCKED - oError:SubCode := 1022 /* EDBF_UNLOCKED */ - oError:Description := hb_langErrMsg( EG_UNLOCKED ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - IF Len( aRecInfo ) > 0 .AND. aWAData[ WADATA_RECNO ] <= Len( aRecInfo ) - AEval( aIndexes, {| aInd, n | aKeys[ n ] := Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ) } ) - aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] := .F. - AEval( aIndexes, {| aInd, n | ModifyIndex( n, Eval( aInd[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aInd, aWAData, aKeys[ n ] ) } ) - ENDIF - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_APPEND( nWA, nRecords ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL aStruct := aDBFData[ DATABASE_STRUCT ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] - LOCAL oError, aRecord, aRecDataInit - - HB_SYMBOL_UNUSED( nRecords ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$s", nWA, hb_ValToExp( nRecords ) ) ) - - IF aOpenInfo[ UR_OI_READONLY ] - oError := ErrorNew() - oError:GenCode := EG_READONLY - oError:SubCode := 1025 /* EDBF_READONLY */ - oError:Description := hb_langErrMsg( EG_READONLY ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] -#if 0 - oError:OsCode := FError() -#endif - oError:CanDefault := .T. - oError:CanRetry := .T. - NetErr( .T. ) - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - - ENDIF - aRecord := BlankRecord( aStruct ) - AAdd( aRecords, aRecord ) - - aRecDataInit := AR_RECDATAINIT() - AAdd( aRecInfo, aRecDataInit ) - - NetErr( .F. ) - AR_GOTO( nWa, Len( aRecords ) ) - AEval( aIndexes, {| aIndex, n | ModifyIndex( n, Eval( aIndex[ INDEX_ORCR ][ UR_ORCR_BKEY ] ), aIndex, aWAData ) } ) - - /* SHARED ACCESS */ - IF aWAData[ WADATA_OPENINFO ][ UR_OI_SHARED ] - aRecDataInit[ RECDATA_LOCKED ] := nWA - AAdd( aWAData[ WADATA_LOCKS ], aWAData[ WADATA_RECNO ] ) - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_LOCK( nWA, aLock ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL nRec := iif( aLock[ UR_LI_RECORD ] == NIL, aWAData[ WADATA_RECNO ], aLock[ UR_LI_RECORD ] ) - LOCAL aRecInfo - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aLock: %2$s", nWA, hb_ValToExp( aLock ) ) ) - - IF aWAData[ WADATA_EOF ] - aLock[ UR_LI_RESULT ] := .T. - - ELSE - aRecInfo := aWAData[ WADATA_DATABASE ][ DATABASE_RECINFO ][ nRec ] - IF aWAData[ WADATA_OPENINFO ][ UR_OI_SHARED ] - IF aRecInfo[ RECDATA_LOCKED ] == nWA - aLock[ UR_LI_RESULT ] := .T. - ELSEIF aRecInfo[ RECDATA_LOCKED ] != 0 - aLock[ UR_LI_RESULT ] := .F. - ELSE - aRecInfo[ RECDATA_LOCKED ] := nWA - AAdd( aWAData[ WADATA_LOCKS ], nRec ) - aLock[ UR_LI_RESULT ] := .T. - ENDIF - ELSE - aLock[ UR_LI_RESULT ] := .T. - ENDIF - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_UNLOCK( nWA, nRec ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aRecords := aWAData[ WADATA_LOCKS ] - LOCAL aRecInfo := aWAData[ WADATA_DATABASE ][ DATABASE_RECINFO ] - LOCAL nPos - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRec: %2$d", nWA, nRec ) ) - - IF ! Empty( aRecords ) - IF nRec == NIL /* Unlock All */ - FOR EACH nRec IN aRecords - aRecInfo[ nRec ][ RECDATA_LOCKED ] := 0 - NEXT - ASize( aRecords, 0 ) - ELSE - IF ( nPos := AScan( aRecords, nRec ) ) > 0 - aRecInfo[ nRec ][ RECDATA_LOCKED ] := 0 - hb_ADel( aRecords, nPos, .T. ) - ENDIF - ENDIF - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_RECID( nWA, nRecNo ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL nRecCount := Len( aRecords ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecNo: %2$s", nWA, hb_ValToExp( nRecNo ) ) ) - - IF aWAData[ WADATA_EOF ] - nRecNo := nRecCount + 1 - ELSE - nRecNo := aWAData[ WADATA_RECNO ] - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_RECCOUNT( nWA, nRecords ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nRecords: %2$s", nWA, hb_ValToExp( nRecords ) ) ) - - nRecords := Len( aRecords ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nRecords: %1$d", nRecords ) ) - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_PACK( nWA ) - - LOCAL oError, nRec, aIndex - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] - LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL nDel := 0 - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF ! aDBFData[ DATABASE_LOCKED ] - oError := ErrorNew() - oError:GenCode := EG_UNLOCKED - oError:SubCode := 1022 /* EDBF_UNLOCKED */ - oError:Description := hb_langErrMsg( EG_UNLOCKED ) - UR_SUPER_ERROR( nWA, oError ) - RETURN FAILURE - - ENDIF - - AEval( aIndexes, {| aIndex, n | ModifyIndex( n, Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ), aIndex, aWAData ) } ) - FOR EACH aIndex IN aIndexes - FOR nRec := Len( aIndex[ INDEX_RECORDS ] ) TO 1 STEP -1 - IF aRecInfo[ aIndex[ INDEX_RECORDS, INDEXKEY_RECORD ], RECDATA_DELETED ] - ADel( aIndex[ INDEX_RECORDS ], nRec ) - nDel++ - ENDIF - NEXT - IF nDel > 0 - ASize( aIndex[ INDEX_RECORDS ], Len( aIndex[ INDEX_RECORDS ] ) - nDel ) - nDel := 0 - ENDIF - NEXT - - FOR nRec := Len( aRecInfo ) TO 1 STEP -1 - IF aRecInfo[ nRec ][ RECDATA_DELETED ] - ADel( aRecInfo, nRec ) - ADel( aRecords, nRec ) - nDel++ - ENDIF - NEXT - IF nDel > 0 - ASize( aRecInfo, Len( aRecInfo ) - nDel ) - ASize( aRecords, Len( aRecInfo ) ) - ENDIF - - AR_GOTOP( nWA ) - - RETURN SUCCESS - -STATIC FUNCTION AR_ZAP( nWA ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aOpenInfo := aWAData[ WADATA_OPENINFO ] - LOCAL oError - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d", nWA ) ) - - IF aOpenInfo[ UR_OI_READONLY ] - oError := ErrorNew() - oError:GenCode := EG_READONLY - oError:SubCode := 1025 /* EDBF_READONLY */ - oError:Description := hb_langErrMsg( EG_READONLY ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - IF aOpenInfo[ UR_OI_SHARED ] - oError := ErrorNew() - oError:GenCode := EG_SHARED - oError:SubCode := 1023 /* EDBF_SHARED */ - oError:Description := hb_langErrMsg( EG_SHARED ) - oError:FileName := aOpenInfo[ UR_OI_NAME ] - UR_SUPER_ERROR( nWA, oError ) - RETURN HB_FAILURE - ENDIF - - /* empty records */ - aDBFData[ DATABASE_RECORDS ] := {} - aDBFData[ DATABASE_RECINFO ] := {} - - /* move to 0 recno */ - AR_GOTO( nWA, 0 ) - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_GOCOLD( nWA ) - - HB_SYMBOL_UNUSED( nWA ) - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_FOUND( nWa, lFound ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lFound: %2$s", nWa, hb_ValToExp( lFound ) ) ) - - lFound := USRRDD_AREADATA( nWA )[ WADATA_FOUND ] - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_SEEK( nWa, lSoftSeek, xSeek, lLast ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aIndexes := aWAData[ WADATA_DATABASE ][ DATABASE_INDEX ] - LOCAL nIndex := aWAData[ WADATA_INDEX ] - LOCAL nResult /* := HB_SUCCESS */ - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, lSoftSeek: %2$s, xSeek: %3$s, lLast: %4$s", nWa, hb_ValToExp( lSoftSeek ), hb_ValToExp( xSeek ), hb_ValToExp( lLast ) ) ) - - aWAData[ WADATA_ORDRECNO ] := Seek( xSeek, lSoftSeek, lLast, aIndexes[ nIndex ] ) - IF aWAData[ WADATA_ORDRECNO ] == 0 .OR. aWAData[ WADATA_ORDRECNO ] > Len( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - aWAData[ WADATA_FOUND ] := .F. - nResult := AR_GOTO( nWA, 0 ) - ELSE - aWAData[ WADATA_FOUND ] := LEFTEQUAL( aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_KEY ], xSeek ) - nResult := AR_GOTO( nWA, aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] ) - ENDIF - - RETURN nResult - -STATIC FUNCTION AR_INFO( nWA, nMsg, xValue ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nMsg: %2$s, xValue: %3$s", nWA, hb_ValToExp( nMsg ), hb_ValToExp( xValue ) ) ) - - SWITCH nMsg - CASE DBI_TABLEEXT - xValue := "" - EXIT - CASE DBI_SHARED - xValue := aDBFData[ DATABASE_LOCKED ] - EXIT - OTHERWISE - RETURN UR_SUPER_INFO( nWA, nMsg, @xValue ) - ENDSWITCH - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_ORDLSTADD( nWA, aOrderInfo ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - - HB_SYMBOL_UNUSED( aOrderInfo ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOrderInfo: %2$s", nWA, hb_ValToExp( aOrderInfo ) ) ) - - IF Empty( aIndexes ) - aWAData[ WADATA_INDEX ] := 0 - ELSE - aWAData[ WADATA_INDEX ] := 1 - IF Empty( aWAData[ WADATA_WAORDINFO ] ) - AEval( aWAData[ WADATA_WAORDINFO ] := Array( Len( aIndexes ) ), {| x, y | HB_SYMBOL_UNUSED( x ), aWAData[ WADATA_WAORDINFO ][ y ] := AR_WAOIINIT() } ) - ENDIF - - ENDIF - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_ORDLSTFOCUS( nWA, aOrderInfo ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aDBFData := aWAData[ WADATA_DATABASE ] - LOCAL aIndexes := aDBFData[ DATABASE_INDEX ] - LOCAL xIndex := aOrderInfo[ UR_ORI_TAG ] - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOrderInfo: %2$s", nWA, hb_ValToExp( aOrderInfo ) ) ) - - aOrderInfo[ UR_ORI_RESULT ] := iif( aWAData[ WADATA_INDEX ] > 0, aIndexes[ aWAData[ WADATA_INDEX ], INDEX_TAG ], "" ) - - SWITCH ValType( xIndex ) - CASE "N" - aWAData[ WADATA_INDEX ] := iif( xIndex >= 1 .AND. xIndex <= Len( aIndexes ), Int( xIndex ), 0 ) - EXIT - CASE "C" - xIndex := Upper( xIndex ) - aWAData[ WADATA_INDEX ] := AScan( aIndexes, {| x | x[ INDEX_TAG ] == xIndex } ) - EXIT - ENDSWITCH - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_ORDCREATE( nWA, aOrderCreate ) - - LOCAL aWAData, aDBFData, aOCInfo, nNext - LOCAL aIndexes, nContNext, nContStep - LOCAL bWhile, nRec, bNext, bEval, bEvalOCI, nStep, nIndex, cIndex, aIndex - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, aOrderCreate: %2$s", nWA, hb_ValToExp( aOrderCreate ) ) ) - - aWAData := USRRDD_AREADATA( nWA ) - aDBFData := aWAData[ WADATA_DATABASE ] - - IF HB_ISARRAY( aOrderCreate[ UR_ORCR_CONDINFO ] ) - aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ] - ELSE - aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ] := { ; - .F., ; /* #define UR_ORC_ACTIVE 1 */ - "", ; /* #define UR_ORC_CFOR 2 */ - "", ; /* #define UR_ORC_CWHILE 3 */ - NIL, ; /* #define UR_ORC_BFOR 4 */ - NIL, ; /* #define UR_ORC_BWHILE 5 */ - NIL, ; /* #define UR_ORC_BEVAL 6 */ - 0, ; /* #define UR_ORC_STEP 7 */ - 0, ; /* #define UR_ORC_STARTREC 8 */ - 0, ; /* #define UR_ORC_NEXT 9 */ - 0, ; /* #define UR_ORC_RECORD 10 */ - .F., ; /* #define UR_ORC_REST 11 */ - .F., ; /* #define UR_ORC_DESCEND 12 */ - .F., ; /* #define UR_ORC_SCOPED 13 */ - .T., ; /* #define UR_ORC_ALL 14 */ - .F., ; /* #define UR_ORC_ADDITIVE 15 */ - .F., ; /* #define UR_ORC_USECURRENT 16 */ - .F., ; /* #define UR_ORC_CUSTOM 17 */ - .F., ; /* #define UR_ORC_NOOPTIMIZE 18 */ - .F., ; /* #define UR_ORC_COMPOUND 19 */ - .F., ; /* #define UR_ORC_USEFILTER 20 */ - .F., ; /* #define UR_ORC_TEMPORARY 21 */ - .F., ; /* #define UR_ORC_EXCLUSIVE 22 */ - NIL ; /* #define UR_ORC_CARGO 23 */ - } - ENDIF - - nNext := aOCInfo[ UR_ORC_NEXT ] - aIndexes := aDBFData[ DATABASE_INDEX ] - nContNext := 1 - nContStep := 0 - - IF Empty( aOrderCreate[ UR_ORCR_TAGNAME ] ) - aOrderCreate[ UR_ORCR_TAGNAME ] := aOrderCreate[ UR_ORCR_BAGNAME ] - ENDIF - cIndex := aOrderCreate[ UR_ORCR_TAGNAME ] := Upper( aOrderCreate[ UR_ORCR_TAGNAME ] ) - aIndex := AR_INDEXINIT() - aIndex[ INDEX_TAG ] := cIndex - aIndex[ INDEX_ORCR ] := aOrderCreate - IF ( nIndex := AScan( aIndexes, {| x | x[ INDEX_TAG ] == cIndex } ) ) > 0 - ADel( aIndexes, nIndex ) - aIndexes[ Len( aIndexes ) ] := aIndex - ELSE - AAdd( aIndexes, aIndex ) - ENDIF - - IF aOCInfo[ UR_ORC_BWHILE ] == NIL .AND. nNext == 0 - nRec := 1 - AR_GOTO( nWA, nRec ) - ELSE - nRec := aOCInfo[ UR_ORC_STARTREC ] - AR_GOTO( nWA, nRec ) - ENDIF - IF aOCInfo[ UR_ORC_BWHILE ] == NIL - bWhile := {|| .T. } - ELSE - bWhile := aOCInfo[ UR_ORC_BWHILE ] - ENDIF - IF nNext == 0 - bNext := {|| .T. } - ELSE - bNext := {|| nContNext++ <= nNext } - ENDIF - IF aOCInfo[ UR_ORC_BEVAL ] == NIL - HB_TRACE( HB_TR_DEBUG, "bEval = {|| .T. }" ) - bEval := {|| .T. } - ELSEIF aOCInfo[ UR_ORC_STEP ] == NIL - bEval := aOCInfo[ UR_ORC_BEVAL ] - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "bEval = %1$s", hb_ValToExp( bEval ) ) ) - ELSE - bEvalOCI := aOCInfo[ UR_ORC_BEVAL ] - nStep := aOCInfo[ UR_ORC_STEP ] - bEval := {|| iif( ++nContStep == nStep, ( nContStep := 0, Eval( bEvalOCI ) ), .T. ) } - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "bEvalOCI = %1$s, nStep = %2$d, bEval = %3$s", hb_ValToExp( bEvalOCI ), nStep, hb_ValToExp( bEval ) ) ) - ENDIF - - AAdd( aWAData[ WADATA_WAORDINFO ], AR_WAOIINIT() ) - aWAData[ WADATA_INDEX ] := Len( aIndexes ) - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "aWAData[ WADATA_EOF ] = %1$s", hb_ValToExp( aWAData[ WADATA_EOF ] ) ) ) - - DO WHILE ! aWAData[ WADATA_EOF ] .AND. Eval( bEval ) .AND. Eval( bNext ) .AND. Eval( bWhile ) - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "aWAData[ WADATA_INDEX ] = %1$s, Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ) = %2$s, aIndex = %3$s, aWAData = %4$s", ; - hb_ValToExp( aWAData[ WADATA_INDEX ] ), hb_ValToExp( Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ) ), ; - hb_ValToExp( hb_ValToExp( aIndex ) ), hb_ValToExp( aWAData ) ) ) - ModifyIndex( aWAData[ WADATA_INDEX ], Eval( aIndex[ INDEX_ORCR, UR_ORCR_BKEY ] ), aIndex, aWAData ) - AR_GOTO( nWA, ++nRec ) - ENDDO - - RETURN AR_GOTOP( nWA ) - -STATIC FUNCTION AR_ORDINFO( nWA, nMsg, aOrderInfo ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aIndexes := aWAData[ WADATA_DATABASE ][ DATABASE_INDEX ] - LOCAL nIndex, nPos - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA: %1$d, nMsg: %2$s, aOrderInfo: %3$s", nWA, hb_ValToExp( nMsg ), hb_ValToExp( aOrderInfo ) ) ) - - IF Empty( aOrderInfo[ UR_ORI_TAG ] ) - aOrderInfo[ UR_ORI_TAG ] := aOrderInfo[ UR_ORI_BAG ] - ENDIF - - SWITCH ValType( aOrderInfo[ UR_ORI_TAG ] ) - CASE "C" - nIndex := Upper( aOrderInfo[ UR_ORI_TAG ] ) - nIndex := AScan( aIndexes, {| x | x[ INDEX_TAG ] == nIndex } ) - EXIT - CASE "N" - nIndex := aOrderInfo[ UR_ORI_TAG ] - EXIT - OTHERWISE - nIndex := aWAData[ WADATA_INDEX ] - ENDSWITCH - - SWITCH nMsg - CASE DBOI_EXPRESSION - IF nIndex < 1 .OR. Empty( aIndexes ) .OR. nIndex > Len( aIndexes[ nIndex ] ) - aOrderInfo[ UR_ORI_RESULT ] := "" - ELSE - aOrderInfo[ UR_ORI_RESULT ] := aIndexes[ nIndex ][ INDEX_ORCR ][ UR_ORCR_CKEY ] - ENDIF - EXIT - CASE DBOI_POSITION - IF nIndex < 1 .OR. Empty( aIndexes ) .OR. nIndex > Len( aIndexes[ nIndex ] ) .OR. Empty( aIndexes[ nIndex ][ INDEX_RECORDS ] ) .OR. aWAData[ WADATA_ORDRECNO ] == 0 - aOrderInfo[ UR_ORI_RESULT ] := 0 - ELSE - IF aIndexes[ nIndex ][ INDEX_RECORDS ][ aWAData[ WADATA_ORDRECNO ] ][ INDEXKEY_RECORD ] != aWAData[ WADATA_RECNO ] - aWAData[ WADATA_ORDRECNO ] := Seek( Eval( aIndexes[ nIndex ][ INDEX_ORCR ][ UR_ORCR_BKEY ] ), .F., .F., aIndexes[ nIndex ], aWAData[ WADATA_RECNO ] ) - ENDIF - IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] == NIL - aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_ORDRECNO ] - ELSE - nPos := Seek( aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ], .T., .F., aIndexes[ nIndex ] ) - IF nPos > 0 .AND. ! LEFTEQUAL( aIndexes[ nIndex ][ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ], aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] ) - IF nPos > 1 .AND. aIndexes[ nIndex ][ INDEX_RECORDS ][ nPos - 1 ][ INDEXKEY_KEY ] >= aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] - nPos-- - ELSE - aOrderInfo[ UR_ORI_RESULT ] := 0 - EXIT - ENDIF - ENDIF - aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_ORDRECNO ] - nPos + 1 - ENDIF - ENDIF - EXIT - CASE DBOI_BAGNAME - aOrderInfo[ UR_ORI_RESULT ] := "" - EXIT - CASE DBOI_KEYCOUNT - IF nIndex >= 1 .AND. ! Empty( aWAData[ WADATA_DATABASE ][ DATABASE_RECORDS ] ) - IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] == NIL - nPos := 0 - ELSE - nPos := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .F. ) - IF nPos == 0 - aOrderInfo[ UR_ORI_RESULT ] := 0 - EXIT - ENDIF - ENDIF - IF aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] == NIL - IF nPos > 0 - nPos := Len( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - nPos + 1 - ENDIF - ELSE - nMsg := SeekScope( aIndexes[ nIndex ], aWAData[ WADATA_WAORDINFO ][ nIndex ], .T. ) - IF nMsg > 0 - IF nPos == 0 - nPos := nMsg - ELSE - nPos := nMsg - nPos + 1 - ENDIF - ENDIF - ENDIF - IF nPos > 0 - aOrderInfo[ UR_ORI_RESULT ] := nPos - ELSE - aOrderInfo[ UR_ORI_RESULT ] := Len( aIndexes[ nIndex ][ INDEX_RECORDS ] ) - ENDIF - ELSE - aOrderInfo[ UR_ORI_RESULT ] := 0 - ENDIF - EXIT - CASE DBOI_SCOPETOP - aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] - IF aOrderInfo[ UR_ORI_ALLTAGS ] != NIL - aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] := aOrderInfo[ UR_ORI_NEWVAL ] - ENDIF - EXIT - CASE DBOI_SCOPEBOTTOM - aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] - IF aOrderInfo[ UR_ORI_ALLTAGS ] != NIL - aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] := aOrderInfo[ UR_ORI_NEWVAL ] - ENDIF - EXIT - CASE DBOI_SCOPETOPCLEAR - aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] - aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_0 ] := NIL - EXIT - CASE DBOI_SCOPEBOTTOMCLEAR - aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] - aWAData[ WADATA_WAORDINFO ][ nIndex ][ WAOI_SCOPE_1 ] := NIL - EXIT - OTHERWISE - RETURN HB_FAILURE - ENDSWITCH - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_CLEARLOCATE( nWA ) - - USRRDD_AREADATA( nWA )[ WADATA_LOCATE ] := Array( UR_SI_SIZE ) - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_SETLOCATE( nWA, aScopeInfo ) - - USRRDD_AREADATA( nWA )[ WADATA_LOCATE ] := aScopeInfo - - RETURN HB_SUCCESS - -STATIC FUNCTION AR_LOCATE( nWA, lContinue ) - - LOCAL aWAData := USRRDD_AREADATA( nWA ) - LOCAL aScopeInfo := aWAData[ WADATA_LOCATE ] - LOCAL bFor := aScopeInfo[ UR_SI_BFOR ] - LOCAL bWhile := aScopeInfo[ UR_SI_BWHILE ] - LOCAL bLocate - - IF lContinue - AR_SKIPRAW( nWA, 1 ) - ENDIF - IF bWhile == NIL - bLocate := {|| ! Eval( bFor ) } - IF ! lContinue .AND. aScopeInfo[ UR_SI_NEXT ] == NIL .AND. aScopeInfo[ UR_SI_RECORD ] == NIL .AND. ! aScopeInfo[ UR_SI_REST ] - AR_GOTOP( nWA ) - ENDIF - ELSE - bLocate := {|| ! Eval( bFor ) .AND. Eval( bWhile ) } - ENDIF - dbEval( {|| NIL },, bLocate, aScopeInfo[ UR_SI_NEXT ], aScopeInfo[ UR_SI_RECORD ], aScopeInfo[ UR_SI_REST ] .OR. lContinue ) - aWAData[ WADATA_FOUND ] := ! aWAData[ WADATA_EOF ] .AND. Eval( bFor ) - - RETURN HB_SUCCESS - - -STATIC FUNCTION AR_DUMMY() - - RETURN HB_SUCCESS - -/* - * This function have to exist in all RDD and then name have to be in - * format: _GETFUNCTABLE - */ - -FUNCTION ARRAYRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - - LOCAL cSuperRDD := NIL /* NO SUPER RDD */ - LOCAL aMyFunc[ UR_METHODCOUNT ] - - s_nRddID := nRddID - - aMyFunc[ UR_INIT ] := ( @AR_INIT() ) - aMyFunc[ UR_NEW ] := ( @AR_NEW() ) - aMyFunc[ UR_FLUSH ] := ( @AR_DUMMY() ) - aMyFunc[ UR_CREATE ] := ( @AR_CREATE() ) - aMyFunc[ UR_CREATEFIELDS ] := ( @AR_CREATEFIELDS() ) - aMyFunc[ UR_OPEN ] := ( @AR_OPEN() ) - aMyFunc[ UR_CLOSE ] := ( @AR_CLOSE() ) - aMyFunc[ UR_BOF ] := ( @AR_BOF() ) - aMyFunc[ UR_EOF ] := ( @AR_EOF() ) - aMyFunc[ UR_APPEND ] := ( @AR_APPEND() ) - aMyFunc[ UR_DELETE ] := ( @AR_DELETE() ) - aMyFunc[ UR_DELETED ] := ( @AR_DELETED() ) - aMyFunc[ UR_RECALL ] := ( @AR_RECALL() ) - aMyFunc[ UR_SETFILTER ] := ( @AR_SETFILTER() ) - aMyFunc[ UR_CLEARFILTER ] := ( @AR_CLEARFILTER() ) - aMyFunc[ UR_SKIPFILTER ] := ( @AR_SKIPFILTER() ) - aMyFunc[ UR_SKIPRAW ] := ( @AR_SKIPRAW() ) - aMyFunc[ UR_GOTO ] := ( @AR_GOTO() ) - aMyFunc[ UR_GOTOID ] := ( @AR_GOTOID() ) - aMyFunc[ UR_GOTOP ] := ( @AR_GOTOP() ) - aMyFunc[ UR_GOBOTTOM ] := ( @AR_GOBOTTOM() ) - aMyFunc[ UR_RECID ] := ( @AR_RECID() ) - aMyFunc[ UR_LOCK ] := ( @AR_LOCK() ) - aMyFunc[ UR_UNLOCK ] := ( @AR_UNLOCK() ) - aMyFunc[ UR_RECCOUNT ] := ( @AR_RECCOUNT() ) - aMyFunc[ UR_GETVALUE ] := ( @AR_GETVALUE() ) - aMyFunc[ UR_PUTVALUE ] := ( @AR_PUTVALUE() ) - aMyFunc[ UR_PACK ] := ( @AR_PACK() ) - aMyFunc[ UR_ZAP ] := ( @AR_ZAP() ) - aMyFunc[ UR_GOCOLD ] := ( @AR_GOCOLD() ) - aMyFunc[ UR_FOUND ] := ( @AR_FOUND() ) - aMyFunc[ UR_SEEK ] := ( @AR_SEEK() ) - aMyFunc[ UR_INFO ] := ( @AR_INFO() ) - aMyFunc[ UR_ORDLSTADD ] := ( @AR_ORDLSTADD() ) - aMyFunc[ UR_ORDLSTFOCUS ] := ( @AR_ORDLSTFOCUS() ) - aMyFunc[ UR_ORDCREATE ] := ( @AR_ORDCREATE() ) - aMyFunc[ UR_ORDINFO ] := ( @AR_ORDINFO() ) - aMyFunc[ UR_CLEARLOCATE ] := ( @AR_CLEARLOCATE() ) - aMyFunc[ UR_SETLOCATE ] := ( @AR_SETLOCATE() ) - aMyFunc[ UR_LOCATE ] := ( @AR_LOCATE() ) - - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc, pSuperRddID ) - -INIT PROCEDURE ARRAYRDD_INIT() - - rddRegister( "ARRAYRDD", RDT_FULL ) - - RETURN - -/* -------------------------------------------------- */ -/* UTILITY FUNCTIONS */ -/* -------------------------------------------------- */ - -/* - hb_EraseArrayRdd() function is equivalent of FErase() function, but works here in memory -*/ - -FUNCTION hb_EraseArrayRdd( cFullName ) - - LOCAL nReturn := HB_FAILURE - LOCAL aDBFData, oError - LOCAL hRDDData - - IF s_nRddID >= 0 - hRDDData := USRRDD_RDDDATA( s_nRddID ) - - IF hRDDData != NIL - IF HB_ISSTRING( cFullName ) - cFullName := Upper( cFullName ) - /* First search if memory dbf exists */ - IF cFullName $ hRDDData - - /* Get ARRAY DATA */ - aDBFData := hRDDData[ cFullName ] - - /* Check if there are current opened workarea */ - IF aDBFData[ DATABASE_OPENNUMBER ] > 0 - oError := ErrorNew() - - oError:GenCode := EG_UNSUPPORTED - oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ - oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; - "database in use)" - oError:FileName := cFullName - oError:CanDefault := .T. - Throw( oError ) - - nReturn := HB_FAILURE - - ELSE - /* Delete database from slot */ - hb_HDel( hRDDData, cFullName ) - nReturn := HB_SUCCESS - - ENDIF - ENDIF - ENDIF - - ELSE - oError := ErrorNew() - - oError:GenCode := EG_UNSUPPORTED - oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ - oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; - "ARRAYRDD not inizialized)" - oError:FileName := cFullName - oError:CanDefault := .T. - /* UR_SUPER_ERROR( 0, oError ) */ - Throw( oError ) - - nReturn := HB_FAILURE - - ENDIF - - ELSE - oError := ErrorNew() - - oError:GenCode := EG_UNSUPPORTED - oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ - oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; - "ARRAYRDD not inizialized)" - oError:FileName := cFullName - oError:CanDefault := .T. - THROW( oError ) - - nReturn := HB_FAILURE - - ENDIF - - RETURN nReturn - -/* - hb_FileArrayRdd( cFullName ) --> lExist - This function is equivalent of File() function, but works here in memory -*/ - -FUNCTION hb_FileArrayRdd( cFullName ) - - LOCAL nReturn := HB_FAILURE - LOCAL oError - LOCAL hRDDData - - IF s_nRddID >= 0 - hRDDData := USRRDD_RDDDATA( s_nRddID ) - - IF hRDDData != NIL - IF HB_ISSTRING( cFullName ) - cFullName := Upper( cFullName ) - /* First search if memory dbf exists */ - IF cFullName $ hRDDData - nReturn := HB_SUCCESS - ENDIF - ENDIF - - ELSE - oError := ErrorNew() - - oError:GenCode := EG_UNSUPPORTED - oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ - oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; - "ARRAYRDD not inizialized)" - oError:FileName := cFullName - oError:CanDefault := .T. - Throw( oError ) - - nReturn := HB_FAILURE - ENDIF - - ELSE - oError := ErrorNew() - - oError:GenCode := EG_UNSUPPORTED - oError:SubCode := 1000 /* EDBF_UNSUPPORTED */ - oError:Description := hb_langErrMsg( EG_UNSUPPORTED ) + " (" + ; - "ARRAYRDD not in use)" - oError:FileName := cFullName - oError:CanDefault := .T. - Throw( oError ) - - nReturn := HB_FAILURE - - ENDIF - - RETURN nReturn == HB_SUCCESS - -/* hb_SetArrayRdd( aArray ) --> NIL - This function set DBF with aArray like APPEND FROM aArray in an empty DBF */ -PROCEDURE hb_SetArrayRdd( aArray ) - - LOCAL aRecInfo - LOCAL nWA := Select() - LOCAL aDBFData := USRRDD_AREADATA( nWA )[ WADATA_DATABASE ] - - aDBFData[ DATABASE_RECORDS ] := aArray - aDBFData[ DATABASE_RECINFO ] := Array( Len( aArray ) ) - FOR EACH aRecInfo IN aDBFData[ DATABASE_RECINFO ] - aRecInfo := AR_RECDATAINIT() - NEXT - AR_GOTOP( nWA ) - - RETURN - -STATIC FUNCTION BlankRecord( aStruct ) - - LOCAL nLenStruct := Len( aStruct ) - LOCAL aRecord := Array( nLenStruct ) - LOCAL nField - - FOR nField := 1 TO nLenStruct - aRecord[ nField ] := EmptyValue( aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) - NEXT - - RETURN aRecord - -STATIC FUNCTION PutValue( xValue, cType, nLen, nDec ) - - LOCAL xVal - - DO CASE - CASE cType == "C" - xVal := PadR( xValue, nLen ) - CASE cType == "M" - xVal := xValue /* No limit for a memo field */ - CASE cType == "N" - xVal := Val( Str( xValue, nLen, nDec ) ) - OTHERWISE - xVal := xValue - ENDCASE - - RETURN xVal - -STATIC FUNCTION EmptyValue( cType, nLen, nDec ) - - LOCAL xVal - - hb_default( @nLen, 0 ) - hb_default( @nDec, 0 ) - - DO CASE - CASE cType == "C" .OR. cType == "M" - xVal := Space( nLen ) - CASE cType == "D" - xVal := hb_SToD() - CASE cType == "L" - xVal := .F. - CASE cType == "N" - xVal := Val( Str( 0, nLen, nDec ) ) - ENDCASE - - RETURN xVal - -/** - * Function .......: hb_Decode( , [ ]> ) ---> - * Author .........: Francesco Saverio Giudice - * Date of creation: 1991-01-25 - * Last revision ..: 2006-01-24 1.13 - rewritten for xHarbour and renamed in hb_Decode() - * - * Decode a value from a list. - */ - -STATIC FUNCTION hb_Decode( ... ) - - LOCAL aParams, nParams, xDefault - LOCAL xVal, cKey, xRet - LOCAL aValues, aResults, n, i, nPos, nLen - - aParams := hb_AParams() - nParams := PCount() - xDefault := NIL - - DO CASE - CASE nParams > 1 /* More parameters, real CASE */ - xVal := aParams[ 1 ] - - hb_ADel( aParams, 1, .T. ) /* Resize params */ - nParams := Len( aParams ) - - /* if I have a odd number of members, last is DEFAULT */ - IF ( nParams % 2 ) != 0 - xDefault := ATail( aParams ) - /* Resize again deleting last */ - hb_ADel( aParams, nParams, .T. ) - nParams := Len( aParams ) - ENDIF - - /* Ok because I have no other value than default, I will check if it is a complex value */ - /* like an array or an hash, so I can get it to decode values */ - IF xDefault != NIL .AND. ; - ( HB_ISARRAY( xDefault ) .OR. HB_ISHASH( xDefault ) ) - - /* If it is an array I will restart this function creating a linear call */ - IF HB_ISARRAY( xDefault ) .AND. Len( xDefault ) > 0 - /* I can have a linear array like { 1, "A", 2, "B", 3, "C" } - * or an array of array couples like { { 1, "A" }, { 2, "B" }, { 3, "C" } } - * first element tell me what type is */ - - /* couples of values */ - IF HB_ISARRAY( xDefault[ 1 ] ) - /* If i have an array as default, this contains couples of key / value */ - /* so I have to convert in a linear array */ - - nLen := Len( xDefault ) - - /* Check if array has a default value, this will be last value and has a value */ - /* different from an array */ - IF ! HB_ISARRAY( ValType( xDefault[ nLen ] ) ) - aParams := Array( ( nLen - 1 ) * 2 ) - - n := 1 - FOR i := 1 TO nLen - 1 - aParams[ n++ ] := xDefault[ i ][ 1 ] - aParams[ n++ ] := xDefault[ i ][ 2 ] - NEXT - - AAdd( aParams, xDefault[ nLen ] ) - - ELSE - /* I haven't a DEFAULT */ - aParams := Array( Len( xDefault ) * 2 ) - - n := 1 - FOR i := 1 TO Len( xDefault ) - aParams[ n++ ] := xDefault[ i ][ 1 ] - aParams[ n++ ] := xDefault[ i ][ 2 ] - NEXT - - ENDIF - ELSE - /* I have a linear array */ - aParams := xDefault - - ENDIF - - ELSEIF HB_ISHASH( xDefault ) /* If it is an hash, translate it in an array */ - - aParams := Array( Len( xDefault ) * 2 ) - - i := 1 - FOR EACH cKey IN xDefault:Keys - aParams[ i++ ] := cKey - aParams[ i++ ] := xDefault[ cKey ] - NEXT - - ENDIF - - /* Then add Decoding value at beginning */ - hb_AIns( aParams, 1, xVal, .T. ) - - /* And run decode() again */ - xRet := hb_ExecFromArray( @hb_Decode(), aParams ) - - ELSE - /* Ok let's go ahead with real FUNCTION */ - - /* Combine in 2 lists having elements as { value } and { decode } */ - aValues := Array( nParams / 2 ) - aResults := Array( nParams / 2 ) - - i := 1 - FOR n := 1 TO nParams - 1 STEP 2 - aValues[ i ] := aParams[ n ] - aResults[ i ] := aParams[ n + 1 ] - i++ - NEXT - - /* Check if value exists (valtype of values MUST be same of xVal, - * otherwise I will get a runtime error) - * TODO: Have I to check also between different valtypes, jumping different ? */ - nPos := AScan( aValues, {| e | e == xVal } ) - - IF nPos == 0 /* Not Found, returning DEFAULT */ - xRet := xDefault /* it could be also NIL because not present */ - - ELSE - xRet := aResults[ nPos ] - - ENDIF - ENDIF - - CASE nParams == 0 /* No parameters */ - xRet := NIL - - CASE nParams == 1 /* Only value to decode as parameter, return an empty value of itself */ - xRet := DecEmptyValue( aParams[ 1 ] ) - - ENDCASE - - RETURN xRet - -STATIC FUNCTION DecEmptyValue( xVal ) - - LOCAL xRet - LOCAL cType := ValType( xVal ) - - SWITCH cType - CASE "C" /* Char */ - CASE "M" /* Memo */ - xRet := "" - EXIT - CASE "D" /* Date */ - xRet := hb_SToD() - EXIT - CASE "L" /* Logical */ - xRet := .F. - EXIT - CASE "N" /* Number */ - xRet := 0 - EXIT - CASE "B" /* code block */ - xRet := {|| NIL } - EXIT - CASE "A" /* array */ - xRet := {} - EXIT - CASE "H" /* hash */ - xRet := { => } - EXIT - CASE "U" /* undefined */ - xRet := NIL - EXIT - CASE "O" /* Object */ - xRet := NIL /* Or better another value ? */ - EXIT - OTHERWISE - /* Create a runtime error for new datatypes */ - xRet := "" - IF xRet == 0 /* BANG! */ - ENDIF - - ENDSWITCH - - RETURN xRet - -STATIC PROCEDURE ModifyIndex( nIndex, xValue, aIndex, aWAData, xValorAnt ) - - LOCAL nPos, aOCInfo, lFor, lDel - - HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nIndex = %1$d, xValue = %2$s, aIndex = %3$s, aWAData = %4$s, xValorAnt = %5$s", ; - nIndex, hb_ValToExp( xValue ), hb_ValToExp( aIndex ), hb_ValToExp( aWAData ), hb_ValToExp( xValorAnt ) ) ) - - aOCInfo := aIndex[ INDEX_ORCR, UR_ORCR_CONDINFO ] - lFor := ( aOCInfo[ UR_ORC_BFOR ] == NIL .OR. Eval( aOCInfo[ UR_ORC_BFOR ] ) ) - lDel := .F. - - IF xValorAnt != NIL .AND. ( ! lFor .OR. ! xValue == xValorAnt ) - ADel( aIndex[ INDEX_RECORDS ], Seek( xValorAnt, .F., .F., aIndex, aWAData[ WADATA_RECNO ] ) ) - lDel := .T. - ENDIF - - IF lFor .AND. ! xValue == xValorAnt - nPos := Seek( xValue, .T., .T., aIndex ) - IF xValorAnt == NIL - AAdd( aIndex[ INDEX_RECORDS ], NIL ) - ENDIF - IF nPos > 0 - IF aIndex[ INDEX_RECORDS ][ nPos ] != NIL .AND. aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ] <= xValue - nPos++ - ENDIF - ELSE - nPos := Len( aIndex[ INDEX_RECORDS ] ) - ENDIF - AIns( aIndex[ INDEX_RECORDS ], nPos ) - aIndex[ INDEX_RECORDS ][ nPos ] := AR_INDEXKEYINIT() - aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ] := xValue - aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_RECORD ] := aWAData[ WADATA_RECNO ] - IF nIndex == aWAData[ WADATA_INDEX ] - aWAData[ WADATA_ORDRECNO ] := nPos - ENDIF - - ELSEIF lDel - ASize( aIndex[ INDEX_RECORDS ], Len( aIndex[ INDEX_RECORDS ] ) - 1 ) - IF nIndex == aWAData[ WADATA_INDEX ] - aWAData[ WADATA_ORDRECNO ] := 0 - ENDIF - ENDIF - - RETURN - -STATIC FUNCTION Seek( xSeek, lSoft, lLast, aIndexInfo, nRec ) - - LOCAL nPos, bFirst, bBefore, bAfter, bAjust - LOCAL aIndex := aIndexInfo[ INDEX_RECORDS ] - LOCAL nIni := 1 - LOCAL nEnd := Len( aIndex ) - - SWITCH nEnd - CASE 0 /* empty archive */ - nPos := 0 - EXIT - CASE 1 /* Archive with 1 record */ - IF aIndex[ 1 ] == NIL .OR. ; - iif( lSoft, ; - iif( aIndexInfo[ INDEX_ORCR ][ UR_ORCR_CONDINFO ][ UR_ORC_DESCEND ], ; - aIndex[ 1 ][ INDEXKEY_KEY ] <= xSeek, ; - aIndex[ 1 ][ INDEXKEY_KEY ] >= xSeek ), ; - LEFTEQUAL( aIndex[ 1 ][ INDEXKEY_KEY ], xSeek ) ) - nPos := 1 - ELSE - nPos := 0 - ENDIF - EXIT - OTHERWISE /* Archive with 2 or more records */ - IF aIndexInfo[ INDEX_ORCR ][ UR_ORCR_CONDINFO ][ UR_ORC_DESCEND ] - bFirst := {|| aIndex[ 2 ][ INDEXKEY_KEY ] >= xSeek } - bBefore := {|| xSeek > aIndex[ nPos ][ INDEXKEY_KEY ] } - bAfter := {|| xSeek < aIndex[ nPos ][ INDEXKEY_KEY ] } - bAjust := {|| ! aIndex[ nPos ][ INDEXKEY_KEY ] <= xSeek } - ELSE - bFirst := {|| aIndex[ 2 ][ INDEXKEY_KEY ] <= xSeek } - bBefore := {|| ! aIndex[ nPos ][ INDEXKEY_KEY ] <= xSeek } - bAfter := {|| xSeek > aIndex[ nPos ][ INDEXKEY_KEY ] } - bAjust := {|| ! aIndex[ nPos ][ INDEXKEY_KEY ] >= xSeek } - ENDIF - - IF aIndex[ 2 ] != NIL .AND. Eval( bFirst ) - DO WHILE nIni <= nEnd - nPos := Int( ( nIni + nEnd ) / 2 ) - IF aIndex[ nPos ] == NIL .OR. Eval( bBefore ) - nEnd := nPos - 1 - ELSEIF Eval( bAfter ) - nIni := nPos + 1 - ELSE - IF lLast - IF nPos < nEnd .AND. aIndex[ nPos + 1 ] != NIL .AND. LEFTEQUAL( aIndex[ nPos + 1 ][ INDEXKEY_KEY ], xSeek ) - nIni := nPos + 1 - ELSE - EXIT - ENDIF - ELSE - nEnd := nPos - 1 - ENDIF - IF nRec != NIL .AND. nRec == aIndex[ nPos ][ INDEXKEY_RECORD ] - EXIT - ENDIF - ENDIF - ENDDO - IF aIndex[ nPos ] != NIL .AND. Eval( bAjust ) - nPos++ - ENDIF - ELSE - nPos := 1 - ENDIF - IF nRec != NIL - IF nIni <= nEnd .AND. ! Empty( aIndex ) .AND. aIndex[ nPos ] != NIL .AND. nRec != aIndex[ nPos ][ INDEXKEY_RECORD ] - nEnd := Len( aIndex ) - FOR nPos := nIni TO nEnd - IF aIndex[ nPos ] == NIL .OR. ! LEFTEQUAL( xSeek, aIndex[ nPos ][ INDEXKEY_KEY ] ) - nPos := 0 - EXIT - ELSEIF aIndex[ nPos ][ INDEXKEY_RECORD ] == nRec - EXIT - ENDIF - NEXT - IF nPos > nEnd - nPos := 0 - ENDIF - ENDIF - ELSEIF ! lSoft - IF nPos > Len( aIndex ) .OR. ! LEFTEQUAL( aIndex[ nPos ][ INDEXKEY_KEY ], xSeek ) - nPos := 0 - ENDIF - ENDIF - - ENDSWITCH - - RETURN nPos - -STATIC FUNCTION SeekScope( aIndex, aOrdInfo, lBottom ) - - LOCAL nPos := Seek( aOrdInfo[ WAOI_SCOPE_0 ], .T., lBottom, aIndex ) - - IF nPos > 0 .AND. ! LEFTEQUAL( aIndex[ INDEX_RECORDS ][ nPos ][ INDEXKEY_KEY ], aOrdInfo[ WAOI_SCOPE_1 ] ) - IF nPos > 1 .AND. aIndex[ INDEX_RECORDS ][ nPos - 1 ][ INDEXKEY_KEY ] >= aOrdInfo[ WAOI_SCOPE_0 ] - nPos-- - ELSE - nPos := 0 - ENDIF - ENDIF - - RETURN nPos +#include "../../../../contrib/rddmisc/arrayrdd.prg" diff --git a/src/rdd/usrrdd/rdds/dbtcdx.prg b/src/rdd/usrrdd/rdds/dbtcdx.prg index 91e0d82320..a2e0c59c4b 100644 --- a/src/rdd/usrrdd/rdds/dbtcdx.prg +++ b/src/rdd/usrrdd/rdds/dbtcdx.prg @@ -1,73 +1 @@ -/* - * DBTCDX RDD - * - * Copyright 2006 Przemyslaw Czerpak - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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 "dbinfo.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -/* - * DBTCDX RDD - * Very simple RDD which inherits from DBFCDX and - * set default memo type to DBT - */ - -/* Force linking DBFCDX and DBFFPT from which our RDD inherits */ -REQUEST DBFCDX -REQUEST DBFFPT - -/* Announce our RDD for foreign REQUESTs */ -ANNOUNCE DBTCDX - -FUNCTION DBTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - "DBFCDX", {}, pSuperRddID ) /* We are inheriting from DBFCDX */ - -INIT PROCEDURE DBTCDX_INIT() - - rddRegister( "DBTCDX", RDT_FULL ) - rddInfo( RDDI_MEMOTYPE, DB_MEMO_DBT, "DBTCDX" ) - - RETURN +#include "../../../../contrib/rddmisc/dbtcdx.prg" diff --git a/src/rdd/usrrdd/rdds/fptcdx.prg b/src/rdd/usrrdd/rdds/fptcdx.prg index fd99e1c8a2..c128a44be5 100644 --- a/src/rdd/usrrdd/rdds/fptcdx.prg +++ b/src/rdd/usrrdd/rdds/fptcdx.prg @@ -1,73 +1 @@ -/* - * FPTCDX RDD - * - * Copyright 2006 Przemyslaw Czerpak - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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 "dbinfo.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -/* - * FPTCDX RDD - * Very simple RDD which inherits from DBFCDX and - * set default memo type to FPT - */ - -/* Force linking DBFCDX and DBFFPT from which our RDD inherits */ -REQUEST DBFCDX -REQUEST DBFFPT - -/* Announce our RDD for foreign REQUESTs */ -ANNOUNCE FPTCDX - -FUNCTION FPTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - "DBFCDX", {}, pSuperRddID ) /* We are inheriting from DBFCDX */ - -INIT PROCEDURE FPTCDX_INIT() - - rddRegister( "FPTCDX", RDT_FULL ) - rddInfo( RDDI_MEMOTYPE, DB_MEMO_FPT, "FPTCDX" ) - - RETURN +#include "../../../../contrib/rddmisc/fptcdx.prg" diff --git a/src/rdd/usrrdd/rdds/hscdx.prg b/src/rdd/usrrdd/rdds/hscdx.prg index 4cc46b7782..62056a1531 100644 --- a/src/rdd/usrrdd/rdds/hscdx.prg +++ b/src/rdd/usrrdd/rdds/hscdx.prg @@ -1,284 +1 @@ -/* - * HSCDX - * - * Copyright 2006 Przemyslaw Czerpak - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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. - * - */ - -/* - * A simple RDD which adds automatically update HSX indexes to DBFCDX - * To create new HSX index for current work area use: hsx_Create() - * To open already existing one use hsx_Open(), - * To close use: hsx_Close() - * To retrieve an handle use: hsx_Handle() - */ - -#include "dbinfo.ch" -#include "fileio.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -ANNOUNCE HSCDX - -/* - * methods: NEW and RELEASE receive pointer to work area structure - * not work area number. It's necessary because the can be executed - * before work area is allocated - * these methods does not have to execute SUPER methods - this is - * always done by low-level USRRDD code - */ - -STATIC FUNCTION _HSX_NEW( pWA ) - - LOCAL aWData := { .F., {}, {} } - - /* - * Set in our private AREA item the array where we will keep HSX indexes - * and HOT buffer flag - */ - - USRRDD_AREADATA( pWA, aWData ) - - RETURN HB_SUCCESS - -STATIC FUNCTION _HSX_CLOSE( nWA ) - - LOCAL aWData := USRRDD_AREADATA( nWA ), nHSX - - /* close all HSX indexes */ - - FOR EACH nHSX IN aWData[ 2 ] - hs_Close( nHSX ) - NEXT - - /* clean the HSX index array */ - ASize( aWData[ 2 ], 0 ) - ASize( aWData[ 3 ], 0 ) - - /* call SUPER CLOSE method to close parent RDD */ - - RETURN UR_SUPER_CLOSE( nWA ) - -STATIC FUNCTION _HSX_GOCOLD( nWA ) - - LOCAL nResult, aWData, nHSX, nRecNo, nKeyNo - - IF ( nResult := UR_SUPER_GOCOLD( nWA ) ) == HB_SUCCESS - aWData := USRRDD_AREADATA( nWA ) - IF aWData[ 1 ] - IF ! Empty( aWData[ 2 ] ) - nRecNo := RecNo() - /* update HSX indexes */ - FOR EACH nHSX IN aWData[ 2 ] - nKeyNo := hs_KeyCount( nHSX ) - DO WHILE nKeyNo >= 0 .AND. nKeyNo < nRecNo - nKeyNo := hs_Add( nHSX, "" ) - ENDDO - IF nKeyNo >= nRecNo - hs_Replace( nHSX,, nRecNo ) - ENDIF - NEXT - ENDIF - aWData[ 1 ] := .F. - ENDIF - ENDIF - - RETURN nResult - -STATIC FUNCTION _HSX_GOHOT( nWA ) - - LOCAL nResult, aWData - - IF ( nResult := UR_SUPER_GOHOT( nWA ) ) == HB_SUCCESS - aWData := USRRDD_AREADATA( nWA ) - aWData[ 1 ] := .T. - ENDIF - - RETURN nResult - -STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll ) - - LOCAL nResult, aWData - - IF ( nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) ) == HB_SUCCESS - aWData := USRRDD_AREADATA( nWA ) - aWData[ 1 ] := .T. - ENDIF - - RETURN nResult - -/* - * Three public functions for CREATE, OPEN and CLOSE HSX indexes bound - * with current work are and automatically updated. - */ - -FUNCTION hsx_Create( cFile, cExpr, nKeySize, nBufSize, lCase, nFiltSet ) - - LOCAL aWData, nHsx := -1, nOpenMode - - IF ! Used() - ELSEIF ! rddName() == "HSCDX" - ELSE - aWData := USRRDD_AREADATA( Select() ) - nOpenMode := iif( dbInfo( DBI_SHARED ), 1, 0 ) + ; - iif( dbInfo( DBI_ISREADONLY ), 2, 0 ) - IF ( nHsx := hs_Index( cFile, cExpr, nKeySize, nOpenMode, nBufSize, lCase, nFiltSet ) ) >= 0 - AAdd( aWData[ 2 ], nHsx ) - AAdd( aWData[ 3 ], cFile ) - ENDIF - ENDIF - - RETURN nHsx - -PROCEDURE hsx_Open( cFile, nBufSize ) - - LOCAL aWData, nHsx, nOpenMode - - IF ! Used() - ELSEIF ! rddName() == "HSCDX" - ELSE - aWData := USRRDD_AREADATA( Select() ) - nOpenMode := iif( dbInfo( DBI_SHARED ), 1, 0 ) + ; - iif( dbInfo( DBI_ISREADONLY ), 2, 0 ) - IF ( nHsx := hs_Open( cFile, nBufSize, nOpenMode ) ) >= 0 - AAdd( aWData[ 2 ], nHsx ) - AAdd( aWData[ 3 ], cFile ) - ENDIF - ENDIF - - RETURN - -PROCEDURE hsx_Close( xHSX ) - - LOCAL aWData, nSlot - - IF Used() .AND. rddName() == "HSCDX" - aWData := USRRDD_AREADATA( Select() ) - DO CASE - CASE HB_ISNUMERIC( xHSX ) - nSlot := AScan( aWData[ 2 ], xHSX ) - CASE HB_ISSTRING( xHSX ) - nSlot := AScan( aWData[ 3 ], {| _1 | _1 == xHSX } ) - OTHERWISE - nSlot := 0 - ENDCASE - IF nSlot > 0 - hb_ADel( aWData[ 2 ], nSlot, .T. ) - hb_ADel( aWData[ 3 ], nSlot, .T. ) - ENDIF - ENDIF - - RETURN - -FUNCTION hsx_Handle( cFile ) - - LOCAL aWData, nSlot - - IF Used() .AND. rddName() == "HSCDX" - aWData := USRRDD_AREADATA( Select() ) - nSlot := AScan( aWData[ 3 ], {| _1 | _1 == cFile } ) - IF nSlot != 0 - RETURN aWData[ 2 ][ nSlot ] - ENDIF - ENDIF - - RETURN -1 - -FUNCTION hsx_File( nHsx ) - - LOCAL aWData, nSlot - - IF Used() .AND. rddName() == "HSCDX" - aWData := USRRDD_AREADATA( Select() ) - nSlot := AScan( aWData[ 3 ], nHsx ) - IF nSlot != 0 - RETURN aWData[ 3 ][ nSlot ] - ENDIF - ENDIF - - RETURN "" - -FUNCTION hsx_Get( nSlot ) - - LOCAL aWData - - IF Used() .AND. rddName() == "HSCDX" - aWData := USRRDD_AREADATA( Select() ) - IF nSlot > 0 .AND. nSlot <= Len( aWData[ 2 ] ) - RETURN aWData[ 2 ][ nSlot ] - ENDIF - ENDIF - - RETURN -1 - -/* Force linking DBFCDX from which our RDD inherits */ - -REQUEST DBFCDX - -/* - * This function have to exist in all RDD and then name have to be in - * format: _GETFUNCTABLE - */ - -FUNCTION HSCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - - LOCAL cSuperRDD := "DBFCDX" /* We are inheriting from DBFCDX */ - LOCAL aMyFunc[ UR_METHODCOUNT ] - - aMyFunc[ UR_NEW ] := @_HSX_NEW() - aMyFunc[ UR_CLOSE ] := @_HSX_CLOSE() - aMyFunc[ UR_GOCOLD ] := @_HSX_GOCOLD() - aMyFunc[ UR_GOHOT ] := @_HSX_GOHOT() - aMyFunc[ UR_APPEND ] := @_HSX_APPEND() - - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc, pSuperRddID ) - -/* - * Register our HSCDX at program startup - */ - -INIT PROCEDURE HSCDX_INIT() - - rddRegister( "HSCDX", RDT_FULL ) - - RETURN +#include "../../../../contrib/rddmisc/hscdx.prg" diff --git a/src/rdd/usrrdd/rdds/logrdd.prg b/src/rdd/usrrdd/rdds/logrdd.prg index 781024ecf8..dcec7006c7 100644 --- a/src/rdd/usrrdd/rdds/logrdd.prg +++ b/src/rdd/usrrdd/rdds/logrdd.prg @@ -1,467 +1 @@ -/* - * LOGRDD - * - * Copyright 2009 Francesco Saverio Giudice - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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. - * - */ - -/* - * A simple RDD which introduce logging to file. It inherits from - * any existent RDD but if you write / replace / delete something - * on tables it writes changes in a log file. - */ - -#include "dbinfo.ch" -#include "fileio.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -#define ARRAY_FILENAME 1 -#define ARRAY_FHANDLE 2 -#define ARRAY_TAG 3 -#define ARRAY_ACTIVE 4 -#define ARRAY_RDDNAME 5 -#define ARRAY_MSGLOGBLOCK 6 -#define ARRAY_USERLOGBLOCK 7 - -ANNOUNCE LOGRDD - -DYNAMIC hb_LogRddInherit /* To be defined at user level */ - -STATIC s_nRddID := -1 - -STATIC FUNCTION LOGRDD_INIT( nRDD ) - - /* Defaults */ - - LOCAL cFileName := "changes.log" - LOCAL lActive := .F. - LOCAL cTag := NetName() + "\" + hb_UserName() - LOCAL cRDDName := hb_LogRddInherit() - - /* Log File will be open later so user can change parameters */ - - /* Store data in RDD cargo */ - /* cFileName, hFile, cTag, lActive, cRDDName, bMsgLogBlock, bUserLogBlock */ - USRRDD_RDDDATA( nRDD, { cFileName, NIL, cTag, lActive, cRDDName, NIL, NIL } ) - - RETURN HB_SUCCESS - -STATIC FUNCTION LOGRDD_EXIT( nRDD ) - - LOCAL aRDDData := USRRDD_RDDDATA( nRDD ) - - /* Closing log file */ - - IF aRDDData[ ARRAY_FHANDLE ] != NIL - FClose( aRDDData[ ARRAY_FHANDLE ] ) - aRDDData[ ARRAY_FHANDLE ] := NIL - ENDIF - - RETURN HB_SUCCESS - -// Create database from current WA fields definition - -STATIC FUNCTION LOGRDD_CREATE( nWA, aOpenInfo ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_CREATE( nWA, aOpenInfo ) ) == HB_SUCCESS - ToLog( "CREATE", nWA, aOpenInfo ) - ENDIF - - RETURN nResult - -// Creating fields for new DBF - dbCreate() in current workarea - -STATIC FUNCTION LOGRDD_CREATEFIELDS( nWA, aStruct ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_CREATEFIELDS( nWA, aStruct ) ) == HB_SUCCESS - ToLog( "CREATEFIELDS", nWA, aStruct ) - ENDIF - - RETURN nResult - -// Open workarea - -STATIC FUNCTION LOGRDD_OPEN( nWA, aOpenInfo ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_OPEN( nWA, aOpenInfo ) ) == HB_SUCCESS - ToLog( "OPEN", nWA, aOpenInfo ) - ENDIF - - RETURN nResult - -// Close workarea - -STATIC FUNCTION LOGRDD_CLOSE( nWA ) - - LOCAL cFile := dbInfo( DBI_FULLPATH ) - LOCAL cAlias := Alias() - LOCAL nResult - - IF ( nResult := UR_SUPER_CLOSE( nWA ) ) == HB_SUCCESS - ToLog( "CLOSE", nWA, cFile, cAlias ) - ENDIF - - RETURN nResult - -STATIC FUNCTION LOGRDD_APPEND( nWA, lUnlockAll ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) ) == HB_SUCCESS - ToLog( "APPEND", nWA, lUnlockAll ) - ENDIF - - RETURN nResult - -STATIC FUNCTION LOGRDD_DELETE( nWA ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_DELETE( nWA ) ) == HB_SUCCESS - ToLog( "DELETE", nWA ) - ENDIF - - RETURN nResult - -STATIC FUNCTION LOGRDD_RECALL( nWA ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_RECALL( nWA ) ) == HB_SUCCESS - ToLog( "RECALL", nWA ) - ENDIF - - RETURN nResult - -STATIC FUNCTION LOGRDD_PUTVALUE( nWA, nField, xValue ) - - LOCAL xOldValue := FieldGet( nField ) - LOCAL nResult := UR_SUPER_PUTVALUE( nWA, nField, xValue ) - - // Log changes only - - IF ! xOldValue == xValue - ToLog( "PUTVALUE", nWA, nField, xValue, xOldValue ) - ENDIF - - RETURN nResult - -STATIC FUNCTION LOGRDD_ZAP( nWA ) - - LOCAL nResult - - IF ( nResult := UR_SUPER_ZAP( nWA ) ) == HB_SUCCESS - ToLog( "ZAP", nWA ) - ENDIF - - RETURN nResult - -/* Force linking DBFCDX from which our RDD inherits */ - -REQUEST DBFCDX - -/* - * This function have to exist in all RDD and then name have to be in - * format: _GETFUNCTABLE - */ - -FUNCTION LOGRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - - LOCAL cSuperRDD := hb_LogRddInherit() /* We are inheriting from a User Defined RDD */ - LOCAL aMyFunc[ UR_METHODCOUNT ] - - s_nRddID := nRddID - - aMyFunc[ UR_INIT ] := @LOGRDD_INIT() - aMyFunc[ UR_EXIT ] := @LOGRDD_EXIT() - aMyFunc[ UR_CREATE ] := @LOGRDD_CREATE() - aMyFunc[ UR_CREATEFIELDS ] := @LOGRDD_CREATEFIELDS() - aMyFunc[ UR_OPEN ] := @LOGRDD_OPEN() - aMyFunc[ UR_CLOSE ] := @LOGRDD_CLOSE() - aMyFunc[ UR_APPEND ] := @LOGRDD_APPEND() - aMyFunc[ UR_DELETE ] := @LOGRDD_DELETE() - aMyFunc[ UR_RECALL ] := @LOGRDD_RECALL() - aMyFunc[ UR_PUTVALUE ] := @LOGRDD_PUTVALUE() - aMyFunc[ UR_ZAP ] := @LOGRDD_ZAP() - - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc, pSuperRddID ) - -INIT PROCEDURE _LOGRDD_INIT() - - rddRegister( "LOGRDD", RDT_FULL ) - - RETURN - -/* User utility functions */ - -FUNCTION hb_LogRddLogFileName( cFileName ) - - LOCAL aRDDData - LOCAL cOldFileName - - IF s_nRddID >= 0 - - aRDDData := USRRDD_RDDDATA( s_nRddID ) - - cOldFileName := aRDDData[ ARRAY_FILENAME ] - - IF HB_ISSTRING( cFileName ) - aRDDData[ ARRAY_FILENAME ] := cFileName - ENDIF - ENDIF - - RETURN cOldFileName - -FUNCTION hb_LogRddTag( cTag ) - - LOCAL aRDDData - LOCAL cOldTag - - IF s_nRddID >= 0 - - aRDDData := USRRDD_RDDDATA( s_nRddID ) - - cOldTag := aRDDData[ ARRAY_TAG ] - - IF HB_ISSTRING( cTag ) - aRDDData[ ARRAY_TAG ] := cTag - ENDIF - ENDIF - - RETURN cOldTag - -FUNCTION hb_LogRddActive( lActive ) - - LOCAL aRDDData - LOCAL lOldActive - - IF s_nRddID >= 0 - - aRDDData := USRRDD_RDDDATA( s_nRddID ) - - lOldActive := aRDDData[ ARRAY_ACTIVE ] - - IF HB_ISLOGICAL( lActive ) - aRDDData[ ARRAY_ACTIVE ] := lActive - ENDIF - ENDIF - - RETURN lOldActive - -FUNCTION hb_LogRddMsgLogBlock( bMsgLogBlock ) - - LOCAL aRDDData - LOCAL bOldMsgLogBlock - - IF s_nRddID >= 0 - - aRDDData := USRRDD_RDDDATA( s_nRddID ) - - bOldMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ] - - IF HB_ISEVALITEM( bMsgLogBlock ) - aRDDData[ ARRAY_MSGLOGBLOCK ] := bMsgLogBlock - ENDIF - ENDIF - - RETURN bOldMsgLogBlock - -FUNCTION hb_LogRddUserLogBlock( bUserLogBlock ) - - LOCAL aRDDData - LOCAL bOldUserLogBlock - - IF s_nRddID >= 0 - - aRDDData := USRRDD_RDDDATA( s_nRddID ) - - bOldUserLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ] - - IF HB_ISEVALITEM( bUserLogBlock ) - aRDDData[ ARRAY_USERLOGBLOCK ] := bUserLogBlock - ENDIF - ENDIF - - RETURN bOldUserLogBlock - -FUNCTION hb_LogRddValueToText( uValue ) - - LOCAL cType - LOCAL cText - - SWITCH cType := ValType( uValue ) - CASE "C" ; cText := hb_StrToExp( uValue ) ; EXIT - CASE "N" ; cText := hb_ntos( uValue ) ; EXIT - CASE "D" ; cText := DToS( uValue ) ; cText := "0d" + iif( Empty( cText ), "00000000", cText ) ; EXIT - OTHERWISE ; cText := hb_ValToStr( uValue ) - ENDSWITCH - - RETURN "[" + cType + "]>>>" + cText + "<<<" - -/* Local utility functions */ - -STATIC PROCEDURE OpenLogFile( nWA ) - - LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) - LOCAL cFileName := aRDDData[ ARRAY_FILENAME ] - LOCAL hFile := aRDDData[ ARRAY_FHANDLE ] - LOCAL lActive := aRDDData[ ARRAY_ACTIVE ] - -#if 0 - TraceLog( "hFile " + CStr( hFile ) ) -#endif - - IF lActive .AND. hFile == NIL - - /* Open Access Log File */ - IF hb_FileExists( cFileName ) - hFile := FOpen( cFileName, FO_READWRITE + FO_SHARED ) - ELSE - hFile := FCreate( cFileName ) - /* Close and reopen in shared mode */ - IF FError() == 0 .AND. hFile != F_ERROR - FClose( hFile ) - hFile := FOpen( cFileName, FO_READWRITE + FO_SHARED ) - ENDIF - ENDIF - IF FError() == 0 .AND. hFile != F_ERROR - /* Move to end of file */ - FSeek( hFile, 0, FS_END ) - ELSE - hFile := NIL - ENDIF - - aRDDData[ ARRAY_FHANDLE ] := hFile - ENDIF - - RETURN - -STATIC FUNCTION ToString( cCmd, nWA, xPar1, xPar2, xPar3 ) - - SWITCH cCmd - CASE "CREATE" - // Parameters received: xPar1: aOpenInfo - RETURN xPar1[ UR_OI_NAME ] - CASE "CREATEFIELDS" - // Parameters received: xPar1: aStruct - RETURN hb_ValToExp( xPar1 ) - CASE "OPEN" - // Parameters received: xPar1: aOpenInfo - RETURN 'Table: "' + xPar1[ UR_OI_NAME ] + '", Alias: "' + Alias() + '", WorkArea: ' + hb_ntos( nWA ) - CASE "CLOSE" - // Parameters received: xPar1: cTableName, xPar2: cAlias - RETURN 'Table: "' + xPar1 + '", Alias: "' + xPar2 + '", WorkArea: ' + hb_ntos( nWA ) - CASE "APPEND" - // Parameters received: xPar1: lUnlockAll - RETURN Alias() + "->RecNo() == " + hb_ntos( RecNo() ) - CASE "DELETE" - // Parameters received: none - RETURN Alias() + "->RecNo() == " + hb_ntos( RecNo() ) - CASE "RECALL" - // Parameters received: none - RETURN Alias() + "->RecNo() == " + hb_ntos( RecNo() ) - CASE "PUTVALUE" - // Parameters received: xPar1: nField, xPar2: xValue, xPar3: xOldValue - HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value - RETURN Alias() + "(" + hb_ntos( RecNo() ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 ) - CASE "ZAP" - // Parameters received: none - RETURN 'Alias: "' + Alias() + ' Table: "' + dbInfo( DBI_FULLPATH ) + '"' - ENDSWITCH - - RETURN NIL - -STATIC PROCEDURE ToLog( cCmd, nWA, xPar1, xPar2, xPar3 ) - - LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) - LOCAL lActive := aRDDData[ ARRAY_ACTIVE ] - LOCAL hFile, cTag, cRDDName, bMsgLogBlock, bUserLogBlock, cLog - - // Check if logging system is active - - IF lActive - - cTag := aRDDData[ ARRAY_TAG ] - cRDDName := aRDDData[ ARRAY_RDDNAME ] - bUserLogBlock := aRDDData[ ARRAY_USERLOGBLOCK ] - - // If not defined a User codeblock - IF ! HB_ISEVALITEM( bUserLogBlock ) - - hFile := aRDDData[ ARRAY_FHANDLE ] - - // If log file is not already open I open now - IF hFile == NIL - OpenLogFile( nWA ) - ENDIF - - IF hFile != NIL - - bMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ] - - // If defined a codeblock I send to user infos and he has to return a formatted string - // Look at local ToString() function for details - IF HB_ISEVALITEM( bMsgLogBlock ) - cLog := Eval( bMsgLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) - ELSE - cLog := DToS( Date() ) + " " + Time() + " " + cTag + ": " + PadR( cRDDName + "_" + cCmd, 20 ) + " - " + ToString( cCmd, nWA, xPar1, xPar2, xPar3 ) - ENDIF - // Log to file only if cLog is a valid string - IF HB_ISSTRING( cLog ) - FWrite( hFile, cLog + hb_eol() ) - ENDIF - ENDIF - ELSE - // Otherwise I send all to user that is responsible to log everywhere - Eval( bUserLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) - ENDIF - ENDIF - - RETURN +#include "../../../../contrib/rddmisc/logrdd.prg" diff --git a/src/rdd/usrrdd/rdds/rlcdx.prg b/src/rdd/usrrdd/rdds/rlcdx.prg index 5e839df89c..ae723e3cdf 100644 --- a/src/rdd/usrrdd/rdds/rlcdx.prg +++ b/src/rdd/usrrdd/rdds/rlcdx.prg @@ -1,222 +1 @@ -/* - * RLCDX - * - * Copyright 2006 Przemyslaw Czerpak - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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. - * - */ - -/* - * A simple RDD which introduce lock counters. It has full DBFCDX - * functionality from which it inherits but if you execute dbRLock( 100 ) - * twice then you will have to also repeat call to dbRUnlock( 100 ) to - * really unlock the record 100. The same if for FLock() - * This idea comes from one of messages sent by Mindaugas Kavaliauskas. - */ - -#include "hbusrrdd.ch" -#include "rddsys.ch" - -ANNOUNCE RLCDX - -/* - * methods: NEW and RELEASE receive pointer to work area structure - * not work area number. It's necessary because the can be executed - * before work area is allocated - * these methods does not have to execute SUPER methods - this is - * always done by low-level USRRDD code - */ - -STATIC FUNCTION RLCDX_NEW( pWA ) - - LOCAL aWData := { 0, {} } - - /* - * Set in our private AREA item the array with number of FLOCKs - * recursively called and array with LOCKED records - */ - - USRRDD_AREADATA( pWA, aWData ) - - RETURN HB_SUCCESS - -STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) - - LOCAL aWData, nResult, xRecId, i - - aWData := USRRDD_AREADATA( nWA ) - - /* Convert EXCLUSIVE locks to DBLM_MULTIPLE */ - IF aLockInfo[ UR_LI_METHOD ] == DBLM_EXCLUSIVE - aLockInfo[ UR_LI_METHOD ] := DBLM_MULTIPLE - aLockInfo[ UR_LI_RECORD ] := RecNo() - ENDIF - - IF aLockInfo[ UR_LI_METHOD ] == DBLM_MULTIPLE /* RLOCK */ - - IF aWData[ 1 ] > 0 - aLockInfo[ UR_LI_RESULT ] := .T. - RETURN HB_SUCCESS - ENDIF - - xRecID := aLockInfo[ UR_LI_RECORD ] - IF Empty( xRecID ) - xRecID := RecNo() - ENDIF - - IF aWData[ 1 ] > 0 - aLockInfo[ UR_LI_RESULT ] := .T. - RETURN HB_SUCCESS - ELSEIF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) > 0 - ++aWData[ 2 ][ i ][ 2 ] - aLockInfo[ UR_LI_RESULT ] := .T. - RETURN HB_SUCCESS - ENDIF - - IF ( nResult := UR_SUPER_LOCK( nWA, aLockInfo ) ) == HB_SUCCESS - IF aLockInfo[ UR_LI_RESULT ] - AAdd( aWData[ 2 ], { xRecID, 1 } ) - ENDIF - ENDIF - - RETURN nResult - - ELSEIF aLockInfo[ UR_LI_METHOD ] == DBLM_FILE /* FLOCK */ - - IF aWData[ 1 ] > 0 - ++aWData[ 1 ] - RETURN HB_SUCCESS - ENDIF - - IF ( nResult := UR_SUPER_LOCK( nWA, aLockInfo ) ) == HB_SUCCESS - - /* FLOCK always first remove all RLOCKs, even if it fails */ - ASize( aWData[ 2 ], 0 ) - - IF aLockInfo[ UR_LI_RESULT ] - aWData[ 1 ] := 1 - ENDIF - ENDIF - - RETURN nResult - - ENDIF - - aLockInfo[ UR_LI_RESULT ] := .F. - - RETURN HB_FAILURE - -STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID ) - - LOCAL aWData := USRRDD_AREADATA( nWA ), i - - IF HB_ISNUMERIC( xRecID ) .AND. xRecID > 0 - IF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) > 0 - IF --aWData[ 2 ][ i ][ 2 ] > 0 - RETURN HB_SUCCESS - ENDIF - hb_ADel( aWData[ 2 ], i, .T. ) - ELSE - RETURN HB_SUCCESS - ENDIF - ELSE - IF aWData[ 1 ] > 1 - --aWData[ 1 ] - RETURN HB_SUCCESS - ENDIF - aWData[ 1 ] := 0 - ASize( aWData[ 2 ], 0 ) - ENDIF - - RETURN UR_SUPER_UNLOCK( nWA, xRecID ) - -STATIC FUNCTION RLCDX_APPEND( nWA, lUnlockAll ) - - LOCAL aWData, nResult, xRecId, i - - /* Never unlock other records, they have to be explicitly unlocked */ - - lUnlockAll := .F. - - IF ( nResult := UR_SUPER_APPEND( nWA, lUnlockAll ) ) == HB_SUCCESS - - aWData := USRRDD_AREADATA( nWA ) - IF aWData[ 1 ] == 0 - xRecId := RecNo() - /* Some RDDs may allow to set phantom locks with RLOCK so we should - check if it's not the case and increase the counter when it is */ - IF ( i := AScan( aWData[ 2 ], {| x | x[ 1 ] == xRecID } ) ) > 0 - ++aWData[ 2 ][ i ][ 2 ] - ELSE - AAdd( aWData[ 2 ], { xRecID, 1 } ) - ENDIF - ENDIF - ENDIF - - RETURN nResult - -/* Force linking DBFCDX from which our RDD inherits */ - -REQUEST DBFCDX - -/* - * This function have to exist in all RDD and then name have to be in - * format: _GETFUNCTABLE - */ - -FUNCTION RLCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - - LOCAL cSuperRDD := "DBFCDX" /* We are inheriting from DBFCDX */ - LOCAL aMethods[ UR_METHODCOUNT ] - - aMethods[ UR_NEW ] := @RLCDX_NEW() - aMethods[ UR_LOCK ] := @RLCDX_LOCK() - aMethods[ UR_UNLOCK ] := @RLCDX_UNLOCK() - aMethods[ UR_APPEND ] := @RLCDX_APPEND() - - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMethods, pSuperRddID ) - -INIT PROCEDURE RLCDX_INIT() - - rddRegister( "RLCDX", RDT_FULL ) - - RETURN +#include "../../../../contrib/rddmisc/rlcdx.prg" diff --git a/src/rdd/usrrdd/rdds/smtcdx.prg b/src/rdd/usrrdd/rdds/smtcdx.prg index 7befe78a51..984d7bd219 100644 --- a/src/rdd/usrrdd/rdds/smtcdx.prg +++ b/src/rdd/usrrdd/rdds/smtcdx.prg @@ -1,73 +1 @@ -/* - * SMTCDX RDD - * - * Copyright 2006 Przemyslaw Czerpak - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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. - * - */ - -/* - * SMTCDX RDD - * Very simple RDD which inherits from DBFCDX and - * set default memo type to SMT - */ - -#include "dbinfo.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -/* Force linking DBFCDX and DBFFPT from which our RDD inherits */ -REQUEST DBFCDX -REQUEST DBFFPT - -/* Announce our RDD for foreign REQUESTs */ -ANNOUNCE SMTCDX - -FUNCTION SMTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - "DBFCDX", {}, pSuperRddID ) /* We are inheriting from DBFCDX */ - -INIT PROCEDURE SMTCDX_INIT() - - rddRegister( "SMTCDX", RDT_FULL ) - rddInfo( RDDI_MEMOTYPE, DB_MEMO_SMT, "SMTCDX" ) - - RETURN +#include "../../../../contrib/rddmisc/smtcdx.prg" diff --git a/src/rdd/usrrdd/rdds/vfpcdx.prg b/src/rdd/usrrdd/rdds/vfpcdx.prg index c1c4706bbb..bf1fff0633 100644 --- a/src/rdd/usrrdd/rdds/vfpcdx.prg +++ b/src/rdd/usrrdd/rdds/vfpcdx.prg @@ -1,70 +1 @@ -/* - * VFPCDX - * - * Copyright 2007 Miguel Angel Marchuet Frutos - * - * 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 program; see the file LICENSE.txt. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/). - * - * 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 "dbinfo.ch" -#include "hbusrrdd.ch" -#include "rddsys.ch" - -/* Force linking DBFCDX from which our RDD inherits */ -REQUEST DBFCDX -REQUEST DBFFPT - -ANNOUNCE VFPCDX - -/* We are inheriting from DBFCDX */ -FUNCTION VFPCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, pSuperRddID ) - RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, "DBFCDX", {}, pSuperRddID ) - -INIT PROCEDURE VFPCDX_INIT() - - rddRegister( "VFPCDX", RDT_FULL ) - - rddInfo( RDDI_TABLETYPE, DB_DBF_VFP, "VFPCDX" ) - rddInfo( RDDI_MEMOTYPE, DB_MEMO_FPT, "VFPCDX" ) - rddInfo( RDDI_MEMOVERSION, DB_MEMOVER_STD, "VFPCDX" ) - rddInfo( RDDI_LOCKSCHEME, DB_DBFLOCK_VFP, "VFPCDX" ) - - RETURN +#include "../../../../contrib/rddmisc/vfpcdx.prg"