fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2017-09-13 11:57 UTC Viktor Szakats (vszakats users.noreply.github.com)

Browse Source 
+ 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.
This commit is contained in:
Viktor Szakats
2017-09-13 12:00:53 +00:00
parent fa876ddc8a
commit b6cc8296fb
17 changed files with 3340 additions and 3310 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
ChangeLog.txt
View File

@@ -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

2048
contrib/rddmisc/arrayrdd.prg Normal file
View File

File diff suppressed because it is too large Load Diff

73
contrib/rddmisc/dbtcdx.prg Normal file
View File

@@ -0,0 +1,73 @@
/*
* DBTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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

73
contrib/rddmisc/fptcdx.prg Normal file
View File

@@ -0,0 +1,73 @@
/*
* FPTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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

284
contrib/rddmisc/hscdx.prg Normal file
View File

@@ -0,0 +1,284 @@
/*
* HSCDX
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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: <RDDNAME>_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

467
contrib/rddmisc/logrdd.prg Normal file
View File

@@ -0,0 +1,467 @@
/*
* LOGRDD
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
*
* 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: <RDDNAME>_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

222
contrib/rddmisc/rlcdx.prg Normal file
View File

@@ -0,0 +1,222 @@
/*
* RLCDX
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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: <RDDNAME>_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

73
contrib/rddmisc/smtcdx.prg Normal file
View File

@@ -0,0 +1,73 @@
/*
* SMTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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

70
contrib/rddmisc/vfpcdx.prg Normal file
View File

@@ -0,0 +1,70 @@
/*
* VFPCDX
*
* Copyright 2007 Miguel Angel Marchuet Frutos <miguelangel /at/ marchuet.net>
*
* 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

2049
src/rdd/usrrdd/rdds/arrayrdd.prg
View File

File diff suppressed because it is too large Load Diff

74
src/rdd/usrrdd/rdds/dbtcdx.prg
View File

@@ -1,73 +1 @@
/*
* DBTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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"

74
src/rdd/usrrdd/rdds/fptcdx.prg
View File

@@ -1,73 +1 @@
/*
* FPTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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"

285
src/rdd/usrrdd/rdds/hscdx.prg
View File

@@ -1,284 +1 @@
/*
* HSCDX
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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: <RDDNAME>_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"

468
src/rdd/usrrdd/rdds/logrdd.prg
View File

@@ -1,467 +1 @@
/*
* LOGRDD
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
*
* 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: <RDDNAME>_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"

223
src/rdd/usrrdd/rdds/rlcdx.prg
View File

@@ -1,222 +1 @@
/*
* RLCDX
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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: <RDDNAME>_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"

74
src/rdd/usrrdd/rdds/smtcdx.prg
View File

@@ -1,73 +1 @@
/*
* SMTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
*
* 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"

71
src/rdd/usrrdd/rdds/vfpcdx.prg
View File

@@ -1,70 +1 @@
/*
* VFPCDX
*
* Copyright 2007 Miguel Angel Marchuet Frutos <miguelangel /at/ marchuet.net>
*
* 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"