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

2006-06-02 14:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/bin/hb-func.sh
  * harbour/config/global.cf
  + harbour/include/usrrdd.ch
  + harbour/source/rdd/usrrdd/Makefile
  + harbour/source/rdd/usrrdd/usrrdd.c
  + harbour/source/rdd/usrrdd/rdds/Makefile
    + added USRRDD library. It allows to create new RDD from scratch
      or by inheriting from any other RDDs (except USRRDDs) and overloading
      any of their methods at .prg level.
      I hope you will find a lot of fun in creating your own RDDs.
      I wanted to create more examples and added some documentation
      but I do not have time for it now - sorry. Try to look at examples
      below and if you need some more detail information then look at
      Clipper's NG Technical Reference Guide or ask me. I'll try to help.
      Two RDDs which seems to be requested by users are ARRAY RDD and
      OLE RDD. I hope that some of you implement them.

  + harbour/source/rdd/usrrdd/rdds/dbtcdx.prg
    * Very simple RDD DBTCDX which inherits from DBFCDX and
      set default memo type to DBT, see exmemo.prg as an example.

  + harbour/source/rdd/usrrdd/rdds/fptcdx.prg
    * Very simple RDD FPTCDX which inherits from DBFCDX and
      set default memo type to FPT, see exmemo.prg as an example.

  + harbour/source/rdd/usrrdd/rdds/smtcdx.prg
    * Very simple RDD SMTCDX which inherits from DBFCDX and
      set default memo type to SMT, see exmemo.prg as an example.

  + harbour/source/rdd/usrrdd/rdds/fcomma.prg
    * A simple RDD which uses HB_F*() functions from MISC library
      to access CSV files. It allow to open an CSV file and navigate
      using SKIP()/GOTO()/GOTOP()/GOBOTTOM() functions using
      BOF()/EOF()/RECNO()/LASTREC() to check current state.
      HB_F*() functions does not support single field access and allow
      to read only the whole line. This RDD also. I only added one
      virtual field which exist in all tables open by this RDD called
      LINE which contains the current .csv file line.

  + harbour/source/rdd/usrrdd/rdds/hscdx.prg
    * 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 retieve an handle use: HSX_HANDLE()

  + harbour/source/rdd/usrrdd/rdds/rlcdx.prg
    * 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.

  + harbour/source/rdd/usrrdd/example/exfcm.prg
    * example of using FCOMMA RDD

  + harbour/source/rdd/usrrdd/example/exhsx.prg
    * example of using HSCDX RDD

  + harbour/source/rdd/usrrdd/example/exrlx.prg
    * example of using RLCDX RDD

  + harbour/source/rdd/usrrdd/example/exmemo.prg
    * example of using DBTCDX, FPTCDX and SMTCDX RDDs
This commit is contained in:
Przemyslaw Czerpak
2006-06-02 12:41:01 +00:00
parent 7db31d8504
commit b8b5e032be
18 changed files with 5828 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
harbour/ChangeLog
View File

@@ -8,6 +8,72 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* harbour/source/rdd/dbf1.c
* DBI_LOCKOFFSET now returns DBF record lock offset really used
(f.e. updated in FP locking after open/close production index)
* harbour/source/rdd/delim1.c
* cleaned BCC warning
* harbour/source/rdd/dbfcdx/dbfcdx1.c
! updated internal production index flag after manual opening
production index
2006-06-02 14:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/bin/hb-func.sh
* harbour/config/global.cf
+ harbour/include/usrrdd.ch
+ harbour/source/rdd/usrrdd/Makefile
+ harbour/source/rdd/usrrdd/usrrdd.c
+ harbour/source/rdd/usrrdd/rdds/Makefile
+ added USRRDD library. It allows to create new RDD from scratch
or by inheriting from any other RDDs (except USRRDDs) and overloading
any of their methods at .prg level.
I hope you will find a lot of fun in creating your own RDDs.
I wanted to create more examples and added some documentation
but I do not have time for it now - sorry. Try to look at examples
below and if you need some more detail information then look at
Clipper's NG Technical Reference Guide or ask me. I'll try to help.
Two RDDs which seems to be requested by users are ARRAY RDD and
OLE RDD. I hope that some of you implement them.
+ harbour/source/rdd/usrrdd/rdds/dbtcdx.prg
* Very simple RDD DBTCDX which inherits from DBFCDX and
set default memo type to DBT, see exmemo.prg as an example.
+ harbour/source/rdd/usrrdd/rdds/fptcdx.prg
* Very simple RDD FPTCDX which inherits from DBFCDX and
set default memo type to FPT, see exmemo.prg as an example.
+ harbour/source/rdd/usrrdd/rdds/smtcdx.prg
* Very simple RDD SMTCDX which inherits from DBFCDX and
set default memo type to SMT, see exmemo.prg as an example.
+ harbour/source/rdd/usrrdd/rdds/fcomma.prg
* A simple RDD which uses HB_F*() functions from MISC library
to access CSV files. It allow to open an CSV file and navigate
using SKIP()/GOTO()/GOTOP()/GOBOTTOM() functions using
BOF()/EOF()/RECNO()/LASTREC() to check current state.
HB_F*() functions does not support single field access and allow
to read only the whole line. This RDD also. I only added one
virtual field which exist in all tables open by this RDD called
LINE which contains the current .csv file line.
+ harbour/source/rdd/usrrdd/rdds/hscdx.prg
* 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 retieve an handle use: HSX_HANDLE()
+ harbour/source/rdd/usrrdd/rdds/rlcdx.prg
* 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.
+ harbour/source/rdd/usrrdd/example/exfcm.prg
* example of using FCOMMA RDD
@@ -22,7 +88,7 @@
2006-06-02 14:15 UTC+0100 Ryszard Glab <rglab//imid.med.pl>
* harbour.spec
* include/hbver.h
* updated to set version 0.46.1 for build46
2006-06-02 14:00 UTC+0100 Ryszard Glab <rglab//imid.med.pl>

2
harbour/bin/hb-func.sh
View File

@@ -63,7 +63,7 @@ mk_hbgetlibs()
{
if [ -z "$@" ]
then
echo -n "vm pp rtl rdd dbffpt dbfcdx dbfntx hsx hbsix ${HB_DB_DRVEXT} macro common lang codepage gtcrs gtsln gtxvt gtxwc gtalleg gtcgi gtstd gtpca gtwin gtwvt gtdos gtos2 debug profiler"
echo -n "vm pp rtl rdd dbffpt dbfcdx dbfntx hsx hbsix usrrdd ${HB_DB_DRVEXT} macro common lang codepage gtcrs gtsln gtxvt gtxwc gtalleg gtcgi gtstd gtpca gtwin gtwvt gtdos gtos2 debug profiler"
else
echo -n "$@"
fi

1
harbour/config/global.cf
View File

@@ -12,6 +12,7 @@ HB_DB_DRIVERS=\
dbffpt \
hbsix \
hsx \
usrrdd \
ifneq ($(HB_DB_DRVEXT),)

345
harbour/include/usrrdd.ch Normal file
View File

@@ -0,0 +1,345 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* USRRDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/* Movement and positioning methods */
#define UR_BOF 1
#define UR_EOF 2
#define UR_FOUND 3
#define UR_GOTO 4
#define UR_GOTOID 5
#define UR_GOBOTTOM 6
#define UR_GOTOP 7
#define UR_SEEK 8
#define UR_SKIP 9
#define UR_SKIPFILTER 10
#define UR_SKIPRAW 11
/* Data management */
#define UR_ADDFIELD 12
#define UR_APPEND 13
#define UR_CREATEFIELDS 14
#define UR_DELETE 15
#define UR_DELETED 16
#define UR_FIELDCOUNT 17
#define UR_FIELDDISPLAY 18
#define UR_FIELDINFO 19
#define UR_FIELDNAME 20
#define UR_FLUSH 21
#define UR_GETREC 22
#define UR_GETVALUE 23
#define UR_GETVARLEN 24
#define UR_GOCOLD 25
#define UR_GOHOT 26
#define UR_PUTREC 27
#define UR_PUTVALUE 28
#define UR_RECALL 29
#define UR_RECCOUNT 30
#define UR_RECINFO 31
#define UR_RECNO 32
#define UR_RECID 33
#define UR_SETFIELDEXTENT 34
/* WorkArea/Database management */
#define UR_ALIAS 35
#define UR_CLOSE 36
#define UR_CREATE 37
#define UR_INFO 38
#define UR_NEW 39
#define UR_OPEN 40
#define UR_RELEASE 41
#define UR_STRUCTSIZE 42
#define UR_SYSNAME 43
#define UR_DBEVAL 44
#define UR_PACK 45
#define UR_PACKREC 46
#define UR_SORT 47
#define UR_TRANS 48
#define UR_TRANSREC 49
#define UR_ZAP 50
/* Relational Methods */
#define UR_CHILDEND 51
#define UR_CHILDSTART 52
#define UR_CHILDSYNC 53
#define UR_SYNCCHILDREN 54
#define UR_CLEARREL 55
#define UR_FORCEREL 56
#define UR_RELAREA 57
#define UR_RELEVAL 58
#define UR_RELTEXT 59
#define UR_SETREL 60
/* Order Management */
#define UR_ORDLSTADD 61
#define UR_ORDLSTCLEAR 62
#define UR_ORDLSTDELETE 63
#define UR_ORDLSTFOCUS 64
#define UR_ORDLSTREBUILD 65
#define UR_ORDSETCOND 66
#define UR_ORDCREATE 67
#define UR_ORDDESTROY 68
#define UR_ORDINFO 69
/* Filters and Scope Settings */
#define UR_CLEARFILTER 70
#define UR_CLEARLOCATE 71
#define UR_CLEARSCOPE 72
#define UR_COUNTSCOPE 73
#define UR_FILTERTEXT 74
#define UR_SCOPEINFO 75
#define UR_SETFILTER 76
#define UR_SETLOCATE 77
#define UR_SETSCOPE 78
#define UR_SKIPSCOPE 79
#define UR_LOCATE 80
/* Miscellaneous */
#define UR_COMPILE 81
#define UR_ERROR 82
#define UR_EVALBLOCK 83
/* Network operations */
#define UR_RAWLOCK 84
#define UR_LOCK 85
#define UR_UNLOCK 86
/* Memofile functions */
#define UR_CLOSEMEMFILE 87
#define UR_CREATEMEMFILE 88
#define UR_GETVALUEFILE 89
#define UR_OPENMEMFILE 90
#define UR_PUTVALUEFILE 91
/* Database file header handling */
#define UR_READDBHEADER 92
#define UR_WRITEDBHEADER 93
/* non WorkArea functions */
#define UR_INIT 94
#define UR_EXIT 95
#define UR_DROP 96
#define UR_EXISTS 97
#define UR_RDDINFO 98
/* Special and reserved methods */
#define UR_WHOCARES 99
#define UR_METHODCOUNT 99
/* FIELD types */
#define HB_FT_STRING 0x0400
#define HB_FT_LOGICAL 0x0080
#define HB_FT_MEMO 0x0C00
#define HB_FT_ANY -1
#define HB_FT_DATE 0x0020
#define HB_FT_INTEGER 0x0002
#define HB_FT_LONG 0x0008
#define HB_FT_DOUBLE 0x0010
/* Flags for DBTRANSINFO */
#define DBTF_MATCH 0x0001
#define DBTF_PUTREC 0x0002
/* Codes for Locking methods */
#define DBLM_EXCLUSIVE 1
#define DBLM_MULTIPLE 2
#define DBLM_FILE 3
/* Codes for RawLock types */
#define FILE_LOCK 1
#define FILE_UNLOCK 2
#define REC_LOCK 3
#define REC_UNLOCK 4
#define HEADER_LOCK 5
#define HEADER_UNLOCK 6
#define APPEND_LOCK 7
#define APPEND_UNLOCK 8
/* DBOPENINFO */
#define UR_OI_AREA 1
#define UR_OI_NAME 2
#define UR_OI_ALIAS 3
#define UR_OI_SHARED 4
#define UR_OI_READONLY 5
#define UR_OI_CDPID 6
#define UR_OI_CONNECT 7
#define UR_OI_HEADER 8
#define UR_OI_SIZE 8
/* DBFIELDINFO */
#define UR_FI_NAME 1
#define UR_FI_TYPE 2
#define UR_FI_TYPEEXT 3
#define UR_FI_LEN 4
#define UR_FI_DEC 5
#define UR_FI_SIZE 5
/* DBLOCKINFO */
#define UR_LI_RECORD 1
#define UR_LI_METHOD 2
#define UR_LI_RESULT 3
#define UR_LI_SIZE 3
/* DBFILTERINFO */
#define UR_FRI_BEXPR 1
#define UR_FRI_CEXPR 2
#define UR_FRI_ACTIVE 3
#define UR_FRI_OPTIMIZED 4
#define UR_FRI_CARGO 5
#define UR_FRI_SIZE 5
/* DBRELINFO */
#define UR_RI_BEXPR 1
#define UR_RI_CEXPR 2
#define UR_RI_SCOPED 3
#define UR_RI_OPTIMIZED 4
#define UR_RI_PARENT 5
#define UR_RI_CHILD 6
#define UR_RI_NEXT 7
#define UR_RI_SIZE 7
/* DBSCOPEINFO */
#define UR_SI_BFOR 1
#define UR_SI_CFOR 2
#define UR_SI_BWHILE 3
#define UR_SI_CWHILE 4
#define UR_SI_NEXT 5
#define UR_SI_RECORD 6
#define UR_SI_REST 7
#define UR_SI_IGNOREFILTER 8
#define UR_SI_INCLUDEDELETED 9
#define UR_SI_LAST 10
#define UR_SI_IGNOREDUPS 11
#define UR_SI_BACKWARD 12
#define UR_SI_OPTIMIZED 13
#define UR_SI_SIZE 13
/* DBEVALINFO */
#define UR_EI_BLOCK 1
#define UR_EI_CEXPR 2
#define UR_EI_SCOPE 3
#define UR_EI_SIZE 3
/* DBTRANSINFO */
#define UR_TI_SRCAREA 1
#define UR_TI_DSTAREA 2
#define UR_TI_SCOPE 3
#define UR_TI_FLAGS 4
#define UR_TI_ITEMCOUNT 5
#define UR_TI_ITEMS 6
#define UR_TI_SIZE 6
/* DBTRANSITEM */
#define UR_TITEM_SOURCE 1
#define UR_TITEM_DESTIN 2
#define UR_TITEM_SIZE 2
/* DBSORTINFO */
#define UR_SRI_TRANSINFO 1
#define UR_SRI_ITEMS 2
#define UR_SRI_ITEMCOUNT 3
#define UR_SRI_SIZE 3
/* DBSORTITEM */
#define UR_SITEM_FIELD 1
#define UR_SITEM_FLAGS 2
#define UR_SITEM_SIZE 2
/* DBORDERINFO */
#define UR_ORI_BAG 1
#define UR_ORI_TAG 2
#define UR_ORI_BLOCK 3
#define UR_ORI_RESULT 4
#define UR_ORI_NEWVAL 5
#define UR_ORI_ALLTAGS 6
#define UR_ORI_SIZE 6
/* DBORDERCONDINFO */
#define UR_ORC_ACTIVE 1
#define UR_ORC_CFOR 2
#define UR_ORC_CWHILE 3
#define UR_ORC_BFOR 4
#define UR_ORC_BWHILE 5
#define UR_ORC_BEVAL 6
#define UR_ORC_STEP 7
#define UR_ORC_STARTREC 8
#define UR_ORC_NEXT 9
#define UR_ORC_RECORD 10
#define UR_ORC_REST 11
#define UR_ORC_DESCEND 12
#define UR_ORC_SCOPED 13
#define UR_ORC_ALL 14
#define UR_ORC_ADDITIVE 15
#define UR_ORC_USECURRENT 16
#define UR_ORC_CUSTOM 17
#define UR_ORC_NOOPTIMIZE 18
#define UR_ORC_COMPOUND 19
#define UR_ORC_USEFILTER 20
#define UR_ORC_TEMPORARY 21
#define UR_ORC_EXCLUSIVE 22
#define UR_ORC_CARGO 23
#define UR_ORC_SIZE 23
/* DBORDERCREATEINFO */
#define UR_ORCR_CONDINFO 1
#define UR_ORCR_BAGNAME 2
#define UR_ORCR_TAGNAME 3
#define UR_ORCR_ORDER 4
#define UR_ORCR_UNIQUE 5
#define UR_ORCR_BKEY 6
#define UR_ORCR_CKEY 7
#define UR_ORCR_SIZE 7
#define SUCCESS 0
#define FAILURE 1

12
harbour/source/rdd/usrrdd/Makefile Normal file
View File

@@ -0,0 +1,12 @@
#
# $Id$
#
ROOT = ../../../
C_SOURCES=\
usrrdd.c \
LIBNAME=usrrdd
include $(TOP)$(ROOT)config/lib.cf

40
harbour/source/rdd/usrrdd/example/exfcm.prg Normal file
View File

@@ -0,0 +1,40 @@
REQUEST FCOMMA
PROC MAIN()
USE test.csv VIA "FCOMMA"
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? RECNO(), '"' + FIELD->LINE + '"'
DBGOBOTTOM()
? RECNO(), '"' + FIELD->LINE + '"'
DBGOTOP()
? RECNO(), '"' + FIELD->LINE + '"'
WAIT
WHILE !EOF()
? RECNO(), '"' + FIELD->LINE + '"'
IF RECNO()==20
INKEY(0)
ENDIF
DBSKIP()
ENDDO
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
WAIT
DBGOBOTTOM()
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
WAIT
WHILE !BOF()
? RECNO(), '[' + FIELD->LINE + ']'
IF RECNO()==LASTREC()-20
INKEY(0)
ENDIF
DBSKIP(-1)
ENDDO
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
WAIT
BROWSE()
RETURN

44
harbour/source/rdd/usrrdd/example/exhsx.prg Normal file
View File

@@ -0,0 +1,44 @@
#include "dbinfo.ch"
REQUEST HSXRDD
PROC MAIN()
FIELD FIRST, LAST, STREET, CITY
LOCAL n, hs
rddSetDefault("HSXRDD")
dbCreate("_tst", {{"FIRST", "C", 20, 0},;
{"LAST", "C", 20, 0},;
{"STREET", "C", 30, 0},;
{"CITY", "C", 30, 0},;
{"STATE", "C", 2, 0},;
{"ZIP", "C", 10, 0},;
{"HIREDATE", "D", 8, 0},;
{"MARRIED", "L", 1, 0},;
{"AGE", "N", 2, 0},;
{"SALARY", "N", 6, 0},;
{"NOTES", "C", 70, 0}})
USE _tst
HSX_CREATE( "_tst", "FIRST+LAST+STREET+CITY", 2, 0, .T., 3 )
APPEND FROM test
/* Look for all records which have 'SHERMAN' string inside */
hs := HSX_HANDLE( "_tst" )
HS_SET( hs, "SHERMAN" )
WHILE ( n := HS_NEXT( hs ) ) > 0
DBGOTO( n )
IF HS_VERIFY( hs ) > 0
? RTRIM( FIRST+LAST+STREET+CITY )
ENDIF
ENDDO
WAIT
/* Does RDD support Record Map Filters? */
IF DBINFO( DBI_RM_SUPPORTED )
/* if yest then let set filter for all records with 'SHERMAN'
word and look at them in browser */
HS_FILTER( hs, "SHERMAN" )
DBGOTOP()
BROWSE()
ENDIF
RETURN

11
harbour/source/rdd/usrrdd/example/exmemo.prg Normal file
View File

@@ -0,0 +1,11 @@
REQUEST DBTCDX
REQUEST FPTCDX
REQUEST SMTCDX
PROC MAIN()
DBCREATE("table1", {{"F1","M",4,0}}, "DBTCDX")
DBCREATE("table2", {{"F1","M",4,0}}, "FPTCDX")
DBCREATE("table3", {{"F1","M",4,0}}, "SMTCDX")
RETURN

46
harbour/source/rdd/usrrdd/example/exrlx.prg Normal file
View File

@@ -0,0 +1,46 @@
REQUEST RLCDX
PROC MAIN()
DBCREATE( "_tst", {{"F1","C",10,0}}, "RLCDX" )
USE _tst VIA "RLCDX" SHARED
? "Table: ", ALIAS(), " open VIA: ", RDDNAME()
? "APPEND"
DBAPPEND()
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "APPEND"
DBAPPEND()
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "UNLOCK"
DBUNLOCK()
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "Locking record 1", DBRLOCK(1)
? "Locking record 1", DBRLOCK(1)
? "Locking record 1", DBRLOCK(1)
? "Locking record 2", DBRLOCK(2)
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "UnLocking record 1..."
DBRUNLOCK(1)
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "UnLocking record 2..."
DBRUNLOCK(2)
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "UnLocking record 1..."
DBRUNLOCK(1)
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
? "UnLocking record 1..."
DBRUNLOCK(1)
? "Current record locks:"
AEVAL( DBRLOCKLIST(), { | nRecNo | qqout( nRecNo ) } )
CLOSE
RETURN

18
harbour/source/rdd/usrrdd/rdds/Makefile Normal file
View File

@@ -0,0 +1,18 @@
#
# $Id$
#
ROOT = ../../../../
PRG_SOURCES=\
fcomma.prg \
hscdx.prg \
rlcdx.prg \
dbtcdx.prg \
fptcdx.prg \
smtcdx.prg \
LIBNAME=usrrdds
include $(TOP)$(ROOT)config/lib.cf

79
harbour/source/rdd/usrrdd/rdds/dbtcdx.prg Normal file
View File

@@ -0,0 +1,79 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* DBTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "dbinfo.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 forign REQUESTs */
ANNOUNCE DBTCDX
PROC DBTCDX(); RETURN
FUNCTION DBTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
"DBFCDX", {} ) /* We are inheriting from DBFCDX */
INIT PROC DBTCDX_INIT()
rddRegister( "DBTCDX", RDT_FULL )
rddInfo( RDDI_MEMOTYPE, DB_MEMO_DBT, "DBTCDX" )
RETURN

333
harbour/source/rdd/usrrdd/rdds/fcomma.prg Normal file
View File

@@ -0,0 +1,333 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* FCOMMA RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
* A simple RDD which uses HB_F*() functions from MISC library
* to access CSV files. It allow to open an CSV file and navigate
* using SKIP()/GOTO()/GOTOP()/GOBOTTOM() functions using
* BOF()/EOF()/RECNO()/LASTREC() to check current state.
* HB_F*() functions does not support single field access and allow
* to read only the whole line. This RDD also. I only added one
* virtual field which exist in all tables open by this RDD called
* LINE which contains the current .csv file line.
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "fileio.ch"
#include "error.ch"
ANNOUNCE FCOMMA
/*
* non work area methods receive RDD ID as first parameter
* Methods INIT and EXIT does not have to execute SUPER methods - these is
* always done by low level USRRDD code
*/
STATIC FUNCTION FCM_INIT( nRDD )
LOCAL aRData := ARRAY( 10 )
/* Set in our private RDD ITEM the array with HB_F*() work are numbers */
AFILL( aRData, -1 )
USRRDD_RDDDATA( nRDD, aRData )
RETURN SUCCESS
/*
* 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 - these is
* always done by low level USRRDD code
*/
STATIC FUNCTION FCM_NEW( pWA )
LOCAL aWData := { -1, .F., .F. }
/*
* 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, aWData )
RETURN SUCCESS
STATIC FUNCTION FCM_CREATE( nWA, aOpenInfo )
LOCAL oError := ErrorNew()
oError:GenCode := EG_CREATE
oError:SubCode := 1004
oError:Description := HB_LANGERRMSG( EG_CREATE ) + " (" + ;
HB_LANGERRMSG( EG_UNSUPPORTED ) + ")"
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
RETURN FAILURE
STATIC FUNCTION FCM_OPEN( nWA, aOpenInfo )
LOCAL cName, nMode, nSlot, nHandle, aRData, aWData, aField, oError, nResult
/* When there is no ALIAS we will create new one using file name */
IF aOpenInfo[ UR_OI_ALIAS ] == NIL
HB_FNAMESPLIT( aOpenInfo[ UR_OI_NAME ], , @cName )
aOpenInfo[ UR_OI_ALIAS ] := cName
ENDIF
nMode := IIF( aOpenInfo[ UR_OI_SHARED ], FO_SHARED , FO_EXCLUSIVE ) + ;
IIF( aOpenInfo[ UR_OI_READONLY ], FO_READ, FO_READWRITE )
aRData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
aWData := USRRDD_AREADATA( nWA )
nSlot := ASCAN( aRData, -1 )
IF nSlot == 0
oError := ErrorNew()
oError:GenCode := EG_OPEN
oError:SubCode := 1000
oError:Description := HB_LANGERRMSG( EG_OPEN ) + ", no free slots"
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
RETURN FAILURE
ENDIF
HB_FSELECT( nSlot )
nHandle := HB_FUSE( aOpenInfo[ UR_OI_NAME ], nMode )
IF nHandle == -1
oError := ErrorNew()
oError:GenCode := EG_OPEN
oError:SubCode := 1001
oError:Description := HB_LANGERRMSG( EG_OPEN )
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:OsCode := fError()
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
RETURN FAILURE
ENDIF
aRData[ nSlot ] := nHandle
aWData[ 1 ] := nSlot
aWData[ 2 ] := aWData[ 3 ] := .F.
/* Set one field called LINE to access current record buffer */
UR_SUPER_SETFIELDEXTENT( nWA, 1 )
aField := ARRAY( UR_FI_SIZE )
aField[ UR_FI_NAME ] := "LINE"
aField[ UR_FI_TYPE ] := HB_FT_STRING
aField[ UR_FI_TYPEEXT ] := 0
aField[ UR_FI_LEN ] := 80 // set any arbitrary length - the real size will be differ
aField[ UR_FI_DEC ] := 0
UR_SUPER_ADDFIELD( nWA, aField )
/* Call SUPER OPEN to finish allocating work area (f.e.: alias settings) */
nResult := UR_SUPER_OPEN( nWA, aOpenInfo )
IF nResult == SUCCESS
FCM_GOTOP( nWA )
ENDIF
RETURN nResult
STATIC FUNCTION FCM_CLOSE( nWA )
LOCAL aRData, nSlot := USRRDD_AREADATA( nWA )[ 1 ]
IF nSlot >= 0
HB_FSELECT( nSlot )
HB_FUSE()
aRData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
aRData[ nSlot ] := -1
ENDIF
RETURN UR_SUPER_CLOSE( nWA )
STATIC FUNCTION FCM_GETVALUE( nWA, nField, xValue )
LOCAL aWData := USRRDD_AREADATA( nWA )
IF nField == 1
IF aWData[ 3 ]
/* We are at EOF position, return empty value */
xValue := ""
ELSE
HB_FSELECT( aWData[ 1 ] )
xValue := HB_FREADLN()
ENDIF
RETURN SUCCESS
ENDIF
RETURN FAILURE
STATIC FUNCTION FCM_GOTO( nWA, nRecord )
LOCAL aWData := USRRDD_AREADATA( nWA )
HB_FSELECT( aWData[ 1 ] )
IF nRecord <= 0
aWData[ 2 ] := aWData[ 3 ] := .T.
ELSEIF nRecord == 1
HB_FGOTOP()
aWData[ 2 ] := aWData[ 3 ] := HB_FEOF()
ELSE
HB_FSKIP(0) /* Clear the EOF flag inside HB_F* engin
- it's not done automatically in HB_FGOBOTTOM() :-( */
HB_FGOTO( nRecord )
aWData[ 2 ] := HB_FRECNO() == 0
aWData[ 3 ] := HB_FEOF()
ENDIF
RETURN SUCCESS
STATIC FUNCTION FCM_GOTOID( nWA, nRecord )
RETURN FCM_GOTO( nWA, nRecord )
STATIC FUNCTION FCM_GOTOP( nWA )
LOCAL aWData := USRRDD_AREADATA( nWA )
HB_FSELECT( aWData[ 1 ] )
HB_FGOTOP()
aWData[ 2 ] := aWData[ 3 ] := HB_FEOF()
RETURN SUCCESS
STATIC FUNCTION FCM_GOBOTTOM( nWA )
LOCAL aWData := USRRDD_AREADATA( nWA )
HB_FSELECT( aWData[ 1 ] )
IF HB_FLASTREC() == 0
aWData[ 2 ] := aWData[ 3 ] := .T.
ELSE
HB_FSKIP(0) /* Clear the EOF flag inside HB_F* engin
- it's not done automatically in HB_FGOBOTTOM() :-( */
HB_FGOBOTTOM()
aWData[ 2 ] := aWData[ 3 ] := .F.
ENDIF
RETURN SUCCESS
STATIC FUNCTION FCM_SKIPRAW( nWA, nRecords )
LOCAL aWData
IF nRecords != 0
aWData := USRRDD_AREADATA( nWA )
HB_FSELECT( aWData[ 1 ] )
IF aWData[ 3 ]
IF nRecords > 0
RETURN SUCCESS
ENDIF
FCM_GOBOTTOM( nWA )
++nRecords
ENDIF
IF nRecords < 0 .AND. HB_FRECNO() <= -nRecords
HB_FGOTOP()
aWData[ 2 ] := .T.
aWData[ 3 ] := HB_FEOF()
ELSEIF nRecords != 0
HB_FSKIP( nRecords )
aWData[ 2 ] := .F.
aWData[ 3 ] := HB_FEOF()
ENDIF
ENDIF
RETURN SUCCESS
STATIC FUNCTION FCM_BOF( nWA, lBof )
LOCAL aWData := USRRDD_AREADATA( nWA )
lBof := aWData[ 2 ]
RETURN SUCCESS
STATIC FUNCTION FCM_EOF( nWA, lEof )
LOCAL aWData := USRRDD_AREADATA( nWA )
lEof := aWData[ 3 ]
RETURN SUCCESS
STATIC FUNCTION FCM_DELETED( nWA, lDeleted )
lDeleted := .F.
RETURN SUCCESS
STATIC FUNCTION FCM_RECID( nWA, nRecNo )
LOCAL aWData := USRRDD_AREADATA( nWA )
HB_FSELECT( aWData[ 1 ] )
IF aWData[ 3 ]
nRecNo := HB_FLASTREC() + 1
ELSE
nRecNo := HB_FRECNO()
ENDIF
RETURN SUCCESS
STATIC FUNCTION FCM_RECCOUNT( nWA, nRecords )
HB_FSELECT( USRRDD_AREADATA( nWA )[ 1 ] )
nRecords := HB_FLASTREC()
RETURN SUCCESS
/*
* This function have to exist in all RDD and then name have to be in
* format: <RDDNAME>_GETFUNCTABLE
*/
FUNCTION FCOMMA_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
LOCAL cSuperRDD := NIL /* NO SUPER RDD */
LOCAL aMyFunc[ UR_METHODCOUNT ]
aMyFunc[ UR_INIT ] := ( @FCM_INIT() )
aMyFunc[ UR_NEW ] := ( @FCM_NEW() )
aMyFunc[ UR_CREATE ] := ( @FCM_CREATE() )
aMyFunc[ UR_OPEN ] := ( @FCM_OPEN() )
aMyFunc[ UR_CLOSE ] := ( @FCM_CLOSE() )
aMyFunc[ UR_BOF ] := ( @FCM_BOF() )
aMyFunc[ UR_EOF ] := ( @FCM_EOF() )
aMyFunc[ UR_DELETED ] := ( @FCM_DELETED() )
aMyFunc[ UR_SKIPRAW ] := ( @FCM_SKIPRAW() )
aMyFunc[ UR_GOTO ] := ( @FCM_GOTO() )
aMyFunc[ UR_GOTOID ] := ( @FCM_GOTOID() )
aMyFunc[ UR_GOTOP ] := ( @FCM_GOTOP() )
aMyFunc[ UR_GOBOTTOM ] := ( @FCM_GOBOTTOM() )
aMyFunc[ UR_RECID ] := ( @FCM_RECID() )
aMyFunc[ UR_RECCOUNT ] := ( @FCM_RECCOUNT() )
aMyFunc[ UR_GETVALUE ] := ( @FCM_GETVALUE() )
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
cSuperRDD, aMyFunc )
INIT PROC FCOMMA_INIT()
rddRegister( "FCOMMA", RDT_FULL )
RETURN

77
harbour/source/rdd/usrrdd/rdds/fptcdx.prg Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* FPTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "dbinfo.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 forign REQUESTs */
ANNOUNCE FPTCDX
FUNCTION FPTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
"DBFCDX", {} ) /* We are inheriting from DBFCDX */
INIT PROC FPTCDX_INIT()
rddRegister( "FPTCDX", RDT_FULL )
rddInfo( RDDI_MEMOTYPE, DB_MEMO_FPT, "FPTCDX" )
RETURN

266
harbour/source/rdd/usrrdd/rdds/hscdx.prg Normal file
View File

@@ -0,0 +1,266 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HSCDX
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
* 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 retieve an handle use: HSX_HANDLE()
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "fileio.ch"
#include "dbinfo.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 - these 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 kepp HSX indexes
* and HOT buffer flag
*/
USRRDD_AREADATA( pWA, aWData )
RETURN 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
nResult := UR_SUPER_GOCOLD( nWA )
IF nResult == 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 )
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
nResult := UR_SUPER_GOHOT( nWA )
IF nResult == SUCCESS
aWData:= USRRDD_AREADATA( nWA )
aWData[ 1 ] := .T.
ENDIF
RETURN nResult
STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll )
LOCAL nResult, aWData
nResult := UR_SUPER_APPEND( nWA, lUnlockAll )
IF nResult == 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 )
nHsx := HS_INDEX( cFile, cExpr, nKeySize, nOpenMode, ;
nBufSize, lCase, nFiltSet )
IF nHsx >= 0
AADD( aWData[ 2 ], nHsx )
AADD( aWData[ 3 ], cFile )
ENDIF
ENDIF
RETURN nHsx
FUNCTION HSX_OPEN( cFile, nBufSize )
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 )
nHsx := HS_OPEN( cFile, nBufSize, nOpenMode )
IF nHsx >= 0
AADD( aWData[ 2 ], nHsx )
AADD( aWData[ 3 ], cFile )
ENDIF
ENDIF
RETURN NIL
FUNCTION HSX_CLOSE( xHSX )
LOCAL aWData, nSlot
IF USED() .AND. RDDNAME() == "HSCDX"
aWData:= USRRDD_AREADATA( SELECT() )
IF VALTYPE( xHSX ) == "N"
nSlot := ASCAN( aWData[ 2 ], xHSX )
ELSEIF VALTYPE( xHSX ) == "C"
nSlot := ASCAN( aWData[ 3 ], { |_1| _1 == xHSX } )
ELSE
nSlot := 0
ENDIF
IF nSlot != 0
ADEL( aWData[ 2 ], nSlot )
ADEL( aWData[ 3 ], nSlot )
ASIZE( aWData[ 2 ], LEN( aWData[ 2 ] ) - 1 )
ASIZE( aWData[ 3 ], LEN( aWData[ 3 ] ) - 1 )
ENDIF
ENDIF
RETURN NIL
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 )
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 )
/*
* Register our HSCDX at program startup
*/
INIT PROC HSCDX_INIT()
rddRegister( "HSCDX", RDT_FULL )
RETURN

224
harbour/source/rdd/usrrdd/rdds/rlcdx.prg Normal file
View File

@@ -0,0 +1,224 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* RLCDX
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
* 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 "rddsys.ch"
#include "usrrdd.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 - these 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 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 SUCCESS
ENDIF
xRecID := aLockInfo[ UR_LI_RECORD ]
IF EMPTY( xRecID )
xRecID := RECNO()
ENDIF
IF aWData[ 1 ] > 0
aLockInfo[ UR_LI_RESULT ] := .T.
RETURN SUCCESS
ELSEIF ( i:= ASCAN( aWData[ 2 ], { |x| x[ 1 ] == xRecID } ) ) != 0
++aWData[ 2, i, 2 ]
aLockInfo[ UR_LI_RESULT ] := .T.
RETURN SUCCESS
ENDIF
nResult := UR_SUPER_LOCK( nWA, aLockInfo )
IF nResult == 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 SUCCESS
ENDIF
nResult := UR_SUPER_LOCK( nWA, aLockInfo )
IF nResult == 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 FAILURE
STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID )
LOCAL aWData := USRRDD_AREADATA( nWA ), i
IF VALTYPE( xRecID ) == "N" .AND. xRecID > 0
IF ( i:= ASCAN( aWData[ 2 ], { |x| x[ 1 ] == xRecID } ) ) != 0
IF --aWData[ 2, i, 2 ] > 0
RETURN SUCCESS
ENDIF
ADEL( aWData[ 2 ], i )
ASIZE( aWData[ 2 ], LEN( aWData[ 2 ] ) - 1 )
ELSE
RETURN SUCCESS
ENDIF
ELSE
IF aWData[ 1 ] > 1
--aWData[ 1 ]
RETURN 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.
nResult := UR_SUPER_APPEND( nWA, lUnlockAll )
IF nResult == 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 )
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 )
INIT PROC RLCDX_INIT()
rddRegister( "RLCDX", RDT_FULL )
RETURN

77
harbour/source/rdd/usrrdd/rdds/smtcdx.prg Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SMTCDX RDD
*
* Copyright 2006 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
* SMTCDX RDD
* Very simple RDD which inherits from DBFCDX and
* set default memo type to SMT
*/
#include "rddsys.ch"
#include "usrrdd.ch"
#include "dbinfo.ch"
/* Force linking DBFCDX and DBFFPT from which our RDD inherits */
REQUEST DBFCDX
REQUEST DBFFPT
/* Announce our RDD for forign REQUESTs */
ANNOUNCE SMTCDX
FUNCTION SMTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
"DBFCDX", {} ) /* We are inheriting from DBFCDX */
INIT PROC SMTCDX_INIT()
rddRegister( "SMTCDX", RDT_FULL )
rddInfo( RDDI_MEMOTYPE, DB_MEMO_SMT, "SMTCDX" )
RETURN

4185
harbour/source/rdd/usrrdd/usrrdd.c Normal file
View File

File diff suppressed because it is too large Load Diff

4
harbour/source/vm/hvm.c
View File

@@ -2609,8 +2609,8 @@ static void hb_vmFuncPtr( void ) /* pushes a function address pointer. Removes
if( HB_IS_SYMBOL( pItem ) )
{
/* do nothing when we will begin to use HB_IT_SYMBOL */
#if 1
/* do nothing - now we are using HB_IT_SYMBOL */
#if 0
hb_stackPop();
hb_vmPushPointer( ( void* ) pItem->item.asSymbol.value->value.pFunPtr );
#endif