DBF using CHEETAH2 in BBC BASIC for Windows

ivega718 · Post by **ivega718** » Thu 06 Jun 2019, 03:43

An alternative to Random Access File using the great CHEETAH2.DLL (by Paul Squires) working with DBF files:

      REM Sample BBCBASIC using CHEETAH2.DLL
      INSTALL @lib$+"WINLIB5"

      REM EQUATES FOR CHEETAH2.DLL Copyright ©  by Paul Squares
      REM  ----------------------------------------------------------------------------------------------------
      REM  EQUATES - General and Error Codes
      REM ----------------------------------------------------------------------------------------------------

      XDBTRUE% = 1
      XDBFALSE% = 0
      MAX_INDEXES%           = 100
      MAX_FIELDS%            = 1000
      MAX_CONDITIONS%        = 50
      MAX_INDEXKEYS%         = 6
      MAX_CHARFIELD_SIZE%    = 256
      MAX_NUMFIELD_SIZE%     = 20
      ENCRYPT_NONE%          = 0
      ENCRYPT_RC4%           = 1
      ENCRYPT_KEYEDXOR%      = 2
      ENCRYPT_SUPERSCRAMBLE% = 3
      QUERY_AND% = 1
      QUERY_OR%  = 2
      EQUAL_TO%              = 1
      ISNOT_EQUAL_TO%          = 2
      LESS_THAN%             = 3
      GREATER_THAN%          = 4
      LESS_THAN_EQUAL_TO%    = 5
      GREATER_THAN_EQUAL_TO% = 6
      CONTAINS%              = 7
      BETWEEN%               = 8
      SSUM%                   = 9
      MINIMUM%               = 10
      MAXIMUM%               = 11
      AVERAGE%               = 12
      WILDCARD%              = 13
      SORT_ASCEND%           = 1
      SORT_DESCEND%          = 0
      XDBREADONLY%  = 0
      XDBWRITEONLY% = 1
      XDBREADWRITE% = 2
      XDBDENYREADWRITE% = 1
      XDBDENYWRITE%     = 2
      XDBDENYREAD%      = 3
      XDBDENYNONE%      = 4
      XDBUNIQUE_CONTINUE% = 0
      XDBUNIQUE_ERROR% = 1
      FILE_ACCESS_ERROR% = 4000
      INVALID_DATE_FORMAT% = 4001
      FILE_READ_ONLY% = 4002
      FILE_WRITE_ONLY% = 4003
      INVALID_FILENAME% = 4004
      ENGINE_NOT_INITIALIZED% = 5000
      FILE_NOT_FOUND% = 5001
      MANY_FILES_OPEN% = 5002
      INVALID_STRUCTURE% = 5003
      FILE_NOT_OPEN% = 5004
      RECORD_OUT_OF_RANGE% = 5005
      FIELD_NOT_FOUND% = 5006
      INVALID_FILE_HANDLE% = 5007
      INVALID_FIELD_LENGTH% = 5008
      DUPLICATE_ALIAS_NAME% = 5009
      INVALID_ACCESSMODE% = 5010
      INVALID_SHAREMODE% = 5011
      RECORD_BUSY% = 5012
      INCOMPATIBLE_MEMO_FIELDS% = 5013
      RECORDSIZE_EXCEEDED% = 5014
      INVALID_ENCRYPTIONKEY% = 5015
      DTABASE_NOT_OPEN% = 7000
      MANY_INDEXES_OPEN% = 7002
      INVALID_KEY_EXPRESSION% = 7003
      INDEX_NOT_OPEN% = 7004
      INDEX_UNIQUE_KEYS_ONLY% = 7005
      SEEK_NO_INDEX_SET% = 7006
      INDEX_NOT_FOUND% = 7007
      QUERY_NOT_GENERATED% = 9000
      QUERY_INVALID_FIELDNAME% = 9001
      QUERY_INVALID_COMPARISON% = 9002
      QUERY_MISSING_DELIMITERS% = 9003
      QUERY_MISSING_SEARCHSTRING% = 9004
      QUERY_TOO_MANY_EXPRESSIONS% = 9005
      QUERY_EXPECTED_NUMERIC_STRING% = 9006
      QUERY_ERROR_GETRECORD% = 9007
      QUERY_INVALID_HANDLE% = 9008
      QUERY_INVALID_JOINPHRASE% = 9009
      QUERY_NO_WILDCARD_FOUND% = 9010
      QUERY_INVALID_PARENTHESIS% = 9011


      SYS "LoadLibrary", "CHEETAH2.DLL" TO CHEETAH2%
      SYS "GetProcAddress", CHEETAH2%, "XDBMULTIUSER_Z" TO xdbMultiUser%
      SYS "GetProcAddress", CHEETAH2%, "XDBCREATE_Z" TO xdbCreate%
      SYS "GetProcAddress", CHEETAH2%, "XDBOPENEX_Z" TO xdbOpen%
      SYS "GetProcAddress", CHEETAH2%, "XDBCLEARBUFFER_Z" TO xdbClearBuffer%
      SYS "GetProcAddress", CHEETAH2%, "XDBASSIGNFIELD_Z" TO xdbAssignField%
      SYS "GetProcAddress", CHEETAH2%, "XDBADDRECORD_Z" TO xdbAddRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBAPPENDRECORD_Z" TO xdbAppendRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBCLOSE" TO xdbClose%

      SYS xdbMultiUser%,XDBFALSE%,0,0 TO result%
      FIELDS$ = "CODE,C,5,0;NAME,C,20,0;ADDRESS,C,30,0"
      DBFNAME$ = "DATABASE.DBF"
      SYS xdbCreate%,DBFNAME$,FIELDS$ TO result%
      SYS xdbOpen%,DBFNAME$,2,4 TO buffer%
      
      FOR X%=1 TO 1000
        SYS xdbClearBuffer%,buffer%
        SYS xdbAssignField%,buffer%,"CODE",0,STR$(X%)
        SYS xdbAssignField%,buffer%,"NAME",0,"ISRAEL VEGA"+STR$(X%)
        SYS xdbAssignField%,buffer%,"ADDRESS",0,"MEXICO"+STR$(X%)
        SYS xdbAddRecord%,buffer%
        RECORDS%=RECORDS%+1
      NEXT X%

      SYS xdbClose%,buffer%
      SYS "FreeLibrary", CHEETAH2%

      PRINT "File "+@dir$+DBFNAME$+" created with "+STR$(RECORDS%)+" Records"

      q$=GET$
      END

ivega718 · Post by **ivega718** » Mon 10 Jun 2019, 21:14

Now a sample using INDEX with MoveFirst, MoveNext, MoveLast and MovePrev:

Code: Select all

      REM Sample BBCBASIC using CHEETAH2.DLL
      INSTALL @lib$+"WINLIB5"


      REM EQUATES FOR CHEETAH2.DLL Copyright Â©  by Paul Squares
      REM  ----------------------------------------------------------------------------------------------------
      REM  EQUATES - General and Error Codes
      REM ----------------------------------------------------------------------------------------------------

      XDBTRUE% = 1
      XDBFALSE% = 0
      MAX_INDEXES%           = 100
      MAX_FIELDS%            = 1000
      MAX_CONDITIONS%        = 50
      MAX_INDEXKEYS%         = 6
      MAX_CHARFIELD_SIZE%    = 256
      MAX_NUMFIELD_SIZE%     = 20
      ENCRYPT_NONE%          = 0
      ENCRYPT_RC4%           = 1
      ENCRYPT_KEYEDXOR%      = 2
      ENCRYPT_SUPERSCRAMBLE% = 3
      QUERY_AND% = 1
      QUERY_OR%  = 2
      EQUAL_TO%              = 1
      ISNOT_EQUAL_TO%          = 2
      LESS_THAN%             = 3
      GREATER_THAN%          = 4
      LESS_THAN_EQUAL_TO%    = 5
      GREATER_THAN_EQUAL_TO% = 6
      CONTAINS%              = 7
      BETWEEN%               = 8
      SSUM%                   = 9
      MINIMUM%               = 10
      MAXIMUM%               = 11
      AVERAGE%               = 12
      WILDCARD%              = 13
      SORT_ASCEND%           = 1
      SORT_DESCEND%          = 0
      XDBREADONLY%  = 0
      XDBWRITEONLY% = 1
      XDBREADWRITE% = 2
      XDBDENYREADWRITE% = 1
      XDBDENYWRITE%     = 2
      XDBDENYREAD%      = 3
      XDBDENYNONE%      = 4
      XDBUNIQUE_CONTINUE% = 0
      XDBUNIQUE_ERROR% = 1
      FILE_ACCESS_ERROR% = 4000
      INVALID_DATE_FORMAT% = 4001
      FILE_READ_ONLY% = 4002
      FILE_WRITE_ONLY% = 4003
      INVALID_FILENAME% = 4004
      ENGINE_NOT_INITIALIZED% = 5000
      FILE_NOT_FOUND% = 5001
      MANY_FILES_OPEN% = 5002
      INVALID_STRUCTURE% = 5003
      FILE_NOT_OPEN% = 5004
      RECORD_OUT_OF_RANGE% = 5005
      FIELD_NOT_FOUND% = 5006
      INVALID_FILE_HANDLE% = 5007
      INVALID_FIELD_LENGTH% = 5008
      DUPLICATE_ALIAS_NAME% = 5009
      INVALID_ACCESSMODE% = 5010
      INVALID_SHAREMODE% = 5011
      RECORD_BUSY% = 5012
      INCOMPATIBLE_MEMO_FIELDS% = 5013
      RECORDSIZE_EXCEEDED% = 5014
      INVALID_ENCRYPTIONKEY% = 5015
      DTABASE_NOT_OPEN% = 7000
      MANY_INDEXES_OPEN% = 7002
      INVALID_KEY_EXPRESSION% = 7003
      INDEX_NOT_OPEN% = 7004
      INDEX_UNIQUE_KEYS_ONLY% = 7005
      SEEK_NO_INDEX_SET% = 7006
      INDEX_NOT_FOUND% = 7007
      QUERY_NOT_GENERATED% = 9000
      QUERY_INVALID_FIELDNAME% = 9001
      QUERY_INVALID_COMPARISON% = 9002
      QUERY_MISSING_DELIMITERS% = 9003
      QUERY_MISSING_SEARCHSTRING% = 9004
      QUERY_TOO_MANY_EXPRESSIONS% = 9005
      QUERY_EXPECTED_NUMERIC_STRING% = 9006
      QUERY_ERROR_GETRECORD% = 9007
      QUERY_INVALID_HANDLE% = 9008
      QUERY_INVALID_JOINPHRASE% = 9009
      QUERY_NO_WILDCARD_FOUND% = 9010
      QUERY_INVALID_PARENTHESIS% = 9011
      SYS "LoadLibrary", "CHEETAH2.DLL" TO CHEETAH2%
      SYS "GetProcAddress", CHEETAH2%, "XDBMULTIUSER_Z" TO xdbMultiUser%
      SYS "GetProcAddress", CHEETAH2%, "XDBCREATE_Z" TO xdbCreate%
      SYS "GetProcAddress", CHEETAH2%, "XDBCREATEINDEX_Z" TO xdbCreateIndex%
      SYS "GetProcAddress", CHEETAH2%, "XDBOPENEX_Z" TO xdbOpen%
      SYS "GetProcAddress", CHEETAH2%, "XDBOPENINDEX_Z" TO xdbOpenIndex%
      SYS "GetProcAddress", CHEETAH2%, "XDBCLEARBUFFER_Z" TO xdbClearBuffer%
      SYS "GetProcAddress", CHEETAH2%, "XDBASSIGNFIELD_Z" TO xdbAssignField%
      SYS "GetProcAddress", CHEETAH2%, "XDBADDRECORD_Z" TO xdbAddRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBAPPENDRECORD_Z" TO xdbAppendRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBUPDATERECORD_Z" TO xdbUpdateRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBDELETERECORD_Z" TO xdbDeleteRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBSEEK_Z" TO xdbSeek%
      SYS "GetProcAddress", CHEETAH2%, "XDBGETRECORD_Z" TO xdbGetRecord%
      SYS "GetProcAddress", CHEETAH2%, "XDBFIELDVALUE_Z" TO xdbFieldValue%
      SYS "GetProcAddress", CHEETAH2%, "XDBMOVEFIRST_Z" TO xdbMoveFirst%
      SYS "GetProcAddress", CHEETAH2%, "XDBMOVELAST_Z" TO xdbMoveLast%
      SYS "GetProcAddress", CHEETAH2%, "XDBMOVENEXT_Z" TO xdbMoveNext%
      SYS "GetProcAddress", CHEETAH2%, "XDBMOVEPREV_Z" TO xdbMovePrev%
      SYS "GetProcAddress", CHEETAH2%, "XDBRECORDNUMBER_Z" TO xdbRecordNumber%
      SYS "GetProcAddress", CHEETAH2%, "XDBCLOSE_Z" TO xdbClose%
      SYS "GetProcAddress", CHEETAH2%, "XDBRESETERROR_Z" TO xdbResetError%
      SYS "GetProcAddress", CHEETAH2%, "XDBCLOSEINDEX_Z" TO xdbCloseIndex%

      REM ---------------------START:-------------------------------
      Multiuser%=XDBFALSE%
      FIELDS$ = "CODE,N,7,0;NAME,C,20,0;ADDRESS,C,30,0"
      DBFNAME$ = @dir$+"DATABASE.DBF"
      IDXNAME$ = @dir$+"DATABASE.IDX"
      Duplicates% = XDBFALSE%

      SYS xdbMultiUser%,XDBFALSE%,0,0 TO result%

      DBFexist%=OPENIN(DBFNAME$)
      IF DBFexist%=0 THEN
        SYS xdbCreate%,DBFNAME$,FIELDS$ TO result%
        PRINT "Database created=";result%
      ENDIF

      SYS xdbOpen%,DBFNAME$,2,4 TO DBF_buffer%

      IDXexist%=OPENIN(IDXNAME$)
      IF IDXexist%=0 THEN
        SYS xdbCreateIndex%,IDXNAME$,DBF_buffer%,"CODE",Duplicates% TO result%
        PRINT "Index created=";result%
      ENDIF

      SYS xdbOpenIndex%,IDXNAME$,DBF_buffer% TO IDX_buffer%


      RECORDS%=0
      FOR X%=1 TO 10000
        SYS xdbClearBuffer%,DBF_buffer%
        KEY$=STR$(X%)
        REM        PRINT KEY$
        SYS xdbAssignField%,DBF_buffer%,"CODE",1,KEY$
        SYS xdbAssignField%,DBF_buffer%,"NAME",2,"Name"+STR$(X%)
        SYS xdbAssignField%,DBF_buffer%,"ADDRESS",3,"Address"+STR$(X%)
        SYS xdbAddRecord%,DBF_buffer%
        RECORDS%=RECORDS%+1
        SYS xdbResetError%,DBF_buffer%
      NEXT X%

      Search%=1
      WHILE Search%=1
        INPUT "Number of CODE to Find: ",KEYX$
        IF VAL(KEYX$)=0 THEN Search%=0
        KEY$=STRING$(7-LEN(KEYX$)," ")+KEYX$
        SYS xdbResetError%,DBF_buffer%
        SYS xdbSeek%,DBF_buffer%,IDX_buffer%,KEY$ TO stat%
  
        IF stat%=XDBTRUE% THEN
          SYS xdbRecordNumber%,DBF_buffer% TO CurrentRecord%
          SYS xdbGetRecord%,DBF_buffer%,CurrentRecord% TO result%
          SYS xdbFieldValue%,DBF_buffer%,"CODE",1 TO CODEX%
          SYS xdbFieldValue%,DBF_buffer%,"NAME",2 TO NAMEX%
          SYS xdbFieldValue%,DBF_buffer%,"ADDRESS",3 TO ADDRESSX%
          CODE$=$$CODEX%
          NAME$=$$NAMEX%
          ADDRESS$=$$ADDRESSX%
          PRINT "   CODE:  "+CODE$
          PRINT "   NAME:  "+NAME$
          PRINT "ADDRESS:  "+ADDRESS$
        ENDIF
      ENDWHILE

      REM MOVEFIRST
      PRINT "FIRST RECORD:"
      SYS xdbMoveFirst%,DBF_buffer%,IDX_buffer% TO result%
      SYS xdbFieldValue%,DBF_buffer%,"CODE",1 TO CODEX%
      SYS xdbFieldValue%,DBF_buffer%,"NAME",2 TO NAMEX%
      SYS xdbFieldValue%,DBF_buffer%,"ADDRESS",3 TO ADDRESSX%
      CODE$=$$CODEX%
      NAME$=$$NAMEX%
      ADDRESS$=$$ADDRESSX%
      PRINT "   CODE:  "+CODE$
      PRINT "   NAME:  "+NAME$
      PRINT "ADDRESS:  "+ADDRESS$

      REM MOVENEXT
      PRINT "NEXT RECORD:"
      SYS xdbMoveNext%,DBF_buffer%,IDX_buffer% TO result%
      SYS xdbFieldValue%,DBF_buffer%,"CODE",1 TO CODEX%
      SYS xdbFieldValue%,DBF_buffer%,"NAME",2 TO NAMEX%
      SYS xdbFieldValue%,DBF_buffer%,"ADDRESS",3 TO ADDRESSX%
      CODE$=$$CODEX%
      NAME$=$$NAMEX%
      ADDRESS$=$$ADDRESSX%
      PRINT "   CODE:  "+CODE$
      PRINT "   NAME:  "+NAME$
      PRINT "ADDRESS:  "+ADDRESS$


      REM MOVELAST
      PRINT "LAST RECORD:"
      SYS xdbMoveLast%,DBF_buffer%,IDX_buffer% TO result%
      SYS xdbFieldValue%,DBF_buffer%,"CODE",1 TO CODEX%
      SYS xdbFieldValue%,DBF_buffer%,"NAME",2 TO NAMEX%
      SYS xdbFieldValue%,DBF_buffer%,"ADDRESS",3 TO ADDRESSX%
      CODE$=$$CODEX%
      NAME$=$$NAMEX%
      ADDRESS$=$$ADDRESSX%
      PRINT "   CODE:  "+CODE$
      PRINT "   NAME:  "+NAME$
      PRINT "ADDRESS:  "+ADDRESS$

      REM MOVEPREV
      PRINT "PREV RECORD:"
      SYS xdbMovePrev%,DBF_buffer%,IDX_buffer% TO result%
      SYS xdbFieldValue%,DBF_buffer%,"CODE",1 TO CODEX%
      SYS xdbFieldValue%,DBF_buffer%,"NAME",2 TO NAMEX%
      SYS xdbFieldValue%,DBF_buffer%,"ADDRESS",3 TO ADDRESSX%
      CODE$=$$CODEX%
      NAME$=$$NAMEX%
      ADDRESS$=$$ADDRESSX%
      PRINT "   CODE:  "+CODE$
      PRINT "   NAME:  "+NAME$
      PRINT "ADDRESS:  "+ADDRESS$


      SYS xdbClose%,DBF_buffer%
      SYS xdbCloseIndex%,IDX_buffer%
      SYS "FreeLibrary", CHEETAH2%

      N$=GET$

      QUIT
      *BYE

BBC BASIC forum

DBF using CHEETAH2 in BBC BASIC for Windows

DBF using CHEETAH2 in BBC BASIC for Windows

Re: DBF using CHEETAH2 in BBC BASIC for Windows