PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PureBASIC wrapper for Cheetah database module

https://www.purebasic.fr/english/viewtopic.php?t=12956

Page 1 of 1

PureBASIC wrapper for Cheetah database module

Posted: Fri Oct 29, 2004 6:42 am
by Stefan Schnell
Code updated For 5.20+

Hello community,
you find a full featured PureBASIC wrapper for the Cheetah2 database module here:
http://www.planetsquires.com/cheetah.htm.
The full source and a small example is included.
Enjoy it. :D
Regards
Stefan

Posted: Fri Oct 29, 2004 1:06 pm
by blueb
Thanks Stephan,

Much appreciated.

I have been working on this (on and off) for quite some time. I have written most of the examples in the demo to PureBasic method sucessfully, but I have trouble with one command.... xdbPutRecord

Can anyone out there show a small example of the above command that works? I cannot get to the debug stage, because it just GPF's before I can get a result. (I was going to check out every single command, before contacting the developer)

Any help would be appreciated.

--blueb

Posted: Fri Oct 29, 2004 2:28 pm
by blueb
Just looked over your example Stephan.

Looks like I was using xdbCreateExtended wrongly... I'll spend some time here and report back. (I needed it for memo fields) :?

Thanks again. This will be a good addition to the PureBasic community because Cheetah is extremely quick and capable.

--Blueb

Posted: Fri Oct 29, 2004 4:09 pm
by blueb
Stephan,

Couldn't create an index... kept getting errors

Found a small typo error in the PBI source file at: xdbCreateIndex

should be: DBFhandle.l

instead of: DBFhandle,l,

I'll have to get my eyes checked, it took me about 10 minutes to find this small detail. :lol:

--blueb

Posted: Sat Oct 30, 2004 10:20 am
by carolight
blueb - I haven't done anything with Cheetah, except for work out the basic functions, but I had difficulty with puts until I used the record number:

Code: Select all

; Find Record
CallFunction(0, "XDBMOVEFIRST_Z", DBHandle,0)
; Get Record Number
recno.l = CallFunction(0, "XDBRECORDNUMBER_Z", DBHandle)
; (Do assigns, etc.)
; Put using the record number
CallFunction(0, "XDBPUTRECORD_Z", DBHandle, @recno)
Does that help?

-Edit - Just realised I'm not using the new wrapper there, so it probably doesn't!

Posted: Sat Oct 30, 2004 1:34 pm
by blueb
Thanks carolight, every little bit helps... :D

Thanks to Stephan, I'm moving ahead rapidly. I've even got a sample using two tables that are linked in multiuser mode.

The people on this board are great, I couldn't have done this without their help.

---blueb

PureBASIC wrapper for Cheetah database module

Posted: Sat Oct 30, 2004 3:52 pm
by Stefan Schnell
Code updated For 5.20+

Hello blueb,
you are right and I am sorry. There are 5 small errors in the wrapper, I forgot the adress operator (@) in front of the variables name :oops:.
I forgot it in CreateFields, CreateFieldsExtended, CreateIndex, DaysApart and QueryDistinct.
Here the corrected wrapper:

Code: Select all

;-Begin-----------------------------------------------------------------

  ;-Global variables----------------------------------------------------

    Global xdbhDLL.l

  ;-Cheetah database constants------------------------------------------

    Enumeration
      #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
      #NOT_EQUAL_TO = 2
      #LESS_THAN = 3
      #GREATER_THAN = 4
      #LESS_THAN_EQUAL_TO = 5
      #GREATER_THAN_EQUAL_TO = 6
      #CONTAINS = 7
      #BETWEEN = 8
      #SUM = 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
      #TOO_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
      #DATABASE_NOT_OPEN = 7000
      #TOO_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
      #DLL_EXPIRED = 99999
    EndEnumeration

  ;-Cheetah database functions------------------------------------------

    ;-------------------------------------------------------------------

      Procedure.s xdbCToD(BASICdate.s)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "CTOD_Z", @BASICdate))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbDToS(CheetahDate.s)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "DTOS_Z", @CheetahDate))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbActivate(RegNumber.l)
        CallFunction(xdbhDLL, "XDBACTIVATE_Z", RegNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbAddDate(StartDate.s, NumDays.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBADDATE_Z", @StartDate, NumDays))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbAddField(FieldInfo.s)
        CallFunction(xdbhDLL, "XDBADDFIELD_Z", @FieldInfo)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbAddRecord(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBADDRECORD_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbAlias(DBFhandle.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBALIAS_Z", DBFhandle))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbAppendRecord(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBAPPENDRECORD_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbAppPath()
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBAPPPATH_Z"))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbAssignField(DBFhandle.l, FieldName.s, FieldNumber.l, FieldString.s)
        CallFunction(xdbhDLL, "XDBASSIGNFIELD_Z", DBFhandle, @FieldName, FieldNumber, @FieldString)
      EndProcedure

    ;-Currency: 8byte float---------------------------------------------
    ;-
    ;- This function does not work with PureBASIC, because PureBASIC
    ;- supports only 4byte floating point
    ;-
    ;-------------------------------------------------------------------

      ;Procedure xdbAssignFieldCUR(DBFhandle.l, FieldName.s, FieldNumber.l, CurrencyValue.f)
      ;  CallFunction(xdbhDLL, "XDBASSIGNFIELDCUR_Z", DBFhandle, @FieldName, FieldNumber, @CurrencyValue)
      ;EndProcedure

    ;-Double: 8byte float-----------------------------------------------
    ;-
    ;- This function does not work with PureBASIC, because PureBASIC
    ;- supports only 4byte floating point
    ;-
    ;-------------------------------------------------------------------

      ;Procedure xdbAssignFieldDBL(DBFhandle.l, FieldName.s, FieldNumber.l, DoubleValue.f)
      ;  CallFunction(xdbhDLL, "XDBASSIGNFIELDDBL_Z", DBFhandle, @FieldName, FieldNumber, @DoubleValue)
      ;EndProcedure

    ;-Integer: From -32768 to +32767------------------------------------

      Procedure xdbAssignFieldINT(DBFhandle.l, FieldName.s, FieldNumber.l, IntValue.w)
        CallFunction(xdbhDLL, "XDBASSIGNFIELDINT_Z", DBFhandle, @FieldName, FieldNumber, IntValue)
      EndProcedure

    ;-Long: From -2147483648 to +2147483647-----------------------------

      Procedure xdbAssignFieldLNG(DBFhandle.l, FieldName.s, FieldNumber.l, LongValue.l)
        CallFunction(xdbhDLL, "XDBASSIGNFIELDLNG_Z", DBFhandle, @FieldName, FieldNumber, LongValue)
      EndProcedure

    ;-Single: 4byte float-----------------------------------------------

      Procedure xdbAssignFieldSNG(DBFhandle.l, FieldName.s, FieldNumber.l, SingleValue.f)
        CallFunction(xdbhDLL, "XDBASSIGNFIELDSNG_Z", DBFhandle, @FieldName, FieldNumber, @SingleValue)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbAssignMemo(DBFhandle.l, FieldName.s, FieldNumber.l, MemAddress.l, StringLength.l)
        CallFunction(xdbhDLL, "XDBASSIGNMEMO_Z", DBFhandle, @FieldName, FieldNumber, MemAddress, StringLength)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbBOF(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBBOF_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbClearBuffer(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBCLEARBUFFER_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbClose(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBCLOSE_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCloseAllIndexes(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBCLOSEALLINDEXES_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCloseIndex(DBFhandle.l, idxHandle.l)
        CallFunction(xdbhDLL, "XDBCLOSEINDEX_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCreate(FileName.s, FieldArray.s)
        CallFunction(xdbhDLL, "XDBCREATE_Z", @FileName, @FieldArray)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCreateExtended(FileName.s, FieldArray.s, MemoBlockSize.l, Algorithm.l, EncryptionKey.s)
        CallFunction(xdbhDLL, "XDBCREATEEXTENDED_Z", @FileName, @FieldArray, MemoBlockSize, Algorithm, @EncryptionKey)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCreateFields(DBFname.s)
        CallFunction(xdbhDLL, "XDBCREATEFIELDS_Z", @DBFname)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCreateFieldsExtended(FileName.s, MemoBlockSize.l, Algorithm.l, EncryptionKey.s)
        CallFunction(xdbhDLL, "XDBCREATEFIELDSEXTENDED_Z", @FileName, MemoBlockSize, Algorithm, @EncryptionKey)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbCreateIndex(IndexFileName.s, DBFhandle.l, IndexExpression.s, Duplicates.l)
        CallFunction(xdbhDLL, "XDBCREATEINDEX_Z", @IndexFileName, DBFhandle, @IndexExpression, Duplicates)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbCreateQuery(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBCREATEQUERY_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbDatabaseHandles(DBFileName.s, CheetahHandle.l, WindowsHandle.l)
        CallFunction(xdbhDLL, "XDBDATABASEHANDLES_Z", @DBFileName, CheetahHandle, WindowsHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbDateToJulian(DateString.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBDATETOJULIAN_Z", @DateString)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbDaysApart(DateFrom.s, DateTo.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBDAYSAPART_Z", @DateFrom, @DateTo)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbDaysInMonth(Year.l, Month.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBDAYSINMONTH_Z", Year, Month)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbDebugMode(TrueFalse.l)
        CallFunction(xdbhDLL, "XDBDEBUGMODE_Z", TrueFalse)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbDeleted(DBFhandle.l, RecordNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBDELETED_Z", DBFhandle, RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbDeleteRecord(DBFhandle.l, RecordNumber.l)
        CallFunction(xdbhDLL, "XDBDELETERECORD_Z", DBFhandle, RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbDestroyQuery(QueryHandle.l)
        CallFunction(xdbhDLL, "XDBDESTROYQUERY_Z", QueryHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbEncryptionMethod(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBENCRYPTIONMETHOD_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbEOF(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBEOF_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbError()
        ProcedureReturn CallFunction(xdbhDLL, "XDBERROR_Z")
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbFailedLockInfo(DBFhandle.l, Reason.s, Username.s, Workstation.s, LockDate.s, LockTime.s)
        CallFunction(xdbhDLL, "XDBFAILEDLOCKINFO_Z", DBFhandle, @Reason, @Username, @Workstation, @LockDate, @LockTime)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbFieldCount(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDCOUNT_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbFieldDecimals(DBFhandle.l, FieldNumber.l, FieldName.s, FieldType.s, FieldLength.l, FieldDecimals.l)
        CallFunction(xdbhDLL, "XDBFIELDDECIMALS_Z", DBFhandle, FieldNumber, @FieldName, @FieldType, FieldLength, FieldDecimals)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbFieldInfo(DBFhandle.l, FieldNumber.l, FieldName.s, FieldType.s, FieldLength.l, FieldDecimals.l)
        CallFunction(xdbhDLL, "XDBFIELDINFO_Z", DBFhandle, FieldNumber, @FieldName, @FieldType, FieldLength, FieldDecimals)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbFieldLength(DBFhandle.l, FieldNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDLENGTH_Z", DBFhandle, FieldNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbFieldName(DBFhandle.l, FieldNumber.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBFIELDNAME_Z", DBFhandle, FieldNumber))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbFieldNumber(DBFhandle.l, FieldName.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDNUMBER_Z", DBFhandle, @FieldName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbFieldPadding(DBFhandle.l, TrueFalse.l)
        CallFunction(xdbhDLL, "XDBFIELDPADDING_Z", DBFhandle, TrueFalse)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbFieldType(DBFhandle.l, FieldNumber.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBFIELDTYPE_Z", DBFhandle, FieldNumber))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbFieldValue(DBFhandle.l, FieldName.s, FieldNumber.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBFIELDVALUE_Z", DBFhandle, @FieldName, FieldNumber))
      EndProcedure

    ;-Currency: 8byte float---------------------------------------------
    ;-
    ;- This function does not work with PureBASIC, because PureBASIC
    ;- supports only 4byte floating point
    ;-
    ;-------------------------------------------------------------------

      ;Procedure.f xdbFieldValueCUR(DBFhandle.l, FieldName.s, FieldNumber.l)
      ;  ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDVALUECUR_Z", DBFhandle, @FieldName, FieldNumber)
      ;EndProcedure

    ;-Double: 8byte float-----------------------------------------------
    ;-
    ;- This function does not work with PureBASIC, because PureBASIC
    ;- supports only 4byte floating point
    ;-
    ;-------------------------------------------------------------------

      ;Procedure.f xdbFieldValueDBL(DBFhandle.l, FieldName.s, FieldNumber.l)
      ;  ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDVALUEDBL_Z", DBFhandle, @FieldName, FieldNumber)
      ;EndProcedure

    ;-Integer: From -32768 to +32767------------------------------------

      Procedure.w xdbFieldValueINT(DBFhandle.l, FieldName.s, FieldNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDVALUEINT_Z", DBFhandle, @FieldName, FieldNumber)
      EndProcedure

    ;-Long: From -2147483648 to +2147483647-----------------------------

      Procedure.l xdbFieldValueLNG(DBFhandle.l, FieldName.s, FieldNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDVALUELNG_Z", DBFhandle, @FieldName, FieldNumber)
      EndProcedure

    ;-Single: 4byte float-----------------------------------------------

      Procedure.f xdbFieldValueSNG(DBFhandle.l, FieldName.s, FieldNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBFIELDVALUESNG_Z", DBFhandle, @FieldName, FieldNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbFlushDatabase(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBFLUSHDATABASE_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbGetRecord(DBFhandle.l, RecordNumber.l)
        CallFunction(xdbhDLL, "XDBGETRECORD_Z", DBFhandle, RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbHtmlStripTag(QueryHandle.l, TrueFalse.l)
        CallFunction(xdbhDLL, "XDBHTMLSTRIPTAG_Z", QueryHandle, TrueFalse)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbIndexHandles(IndexFileName.s, CheetahHandle.l, WindowsHandle.l)
        CallFunction(xdbhDLL, "XDBINDEXHANDLES_Z", @IndexFileName, CheetahHandle, WindowsHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbIsEditLock(DBFhandle.l, RecordNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBISEDITLOCK_Z", DBFhandle, RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbIsEncrypted(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBISENCRYPTED_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbJulianToDate(JulianNumber.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBJULIANTODATE_Z", JulianNumber))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbKeyCount(DBFhandle.l, idxHandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBKEYCOUNT_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbKeyExpression(DBFhandle.l, idxHandle.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBKEYEXPRESSION_Z", DBFhandle, idxHandle))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbKeyLength(DBFhandle.l, idxHandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBKEYLENGTH_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbKeyPosition(idxHandle.l, KeyPosition.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBKEYPOSITION_Z", idxHandle, KeyPosition)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbKeyUnique(DBFhandle.l, idxHandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBKEYUNIQUE_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbLastUpdated(DBFhandle.l, YearNr.l, MonthNr.l, DayNr.l)
        CallFunction(xdbhDLL, "XDBLASTUPDATED_Z", YearNr, MonthNr, DayNr)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbMemoValueAddr(DBFhandle.l, FieldName.s, FieldCode.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBMEMOVALUEADDR_Z", DBFhandle, @FieldName, FieldCode)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbMemoValueLen(DBFhandle.l, FieldName.s, FieldCode.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBMEMOVALUELEN_Z", DBFhandle, @FieldName, FieldCode)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbMKI(IntValue.w)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBMKI_Z", IntValue))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbMKL(LongValue.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBMKL_Z", LongValue))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbMoveFirst(DBFhandle.l, idxHandle.l)
        CallFunction(xdbhDLL, "XDBMOVEFIRST_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbMoveLast(DBFhandle.l, idxHandle.l)
        CallFunction(xdbhDLL, "XDBMOVELAST_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbMoveNext(DBFhandle.l, idxHandle.l)
        CallFunction(xdbhDLL, "XDBMOVENEXT_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbMovePrev(DBFhandle.l, idxHandle.l)
        CallFunction(xdbhDLL, "XDBMOVEPREV_Z", DBFhandle, idxHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbMultiUser(TrueFalse.l, NumRetries.l, WaitTimes.l)
        CallFunction(xdbhDLL, "XDBMULTIUSER_Z", TrueFalse, NumRetries, WaitTimes)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbNameOfDay(DateCheck.s)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBNAMEOFDAY_Z", @DateCheck))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbOpen(FileName.s, EncryptionKey.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBOPEN_Z", @FileName, @EncryptionKey)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbOpenEx(FileName.s, AccessMode.l, ShareMode.l, EncryptionKey.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBOPENEX_Z", @FileName, AccessMode, ShareMode, @EncryptionKey)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbOpenIndex(IndexFilename.s, DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBOPENINDEX_Z", @IndexFilename, DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbPack(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBPACK_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbPutRecord(DBFhandle.l, RecordNumber.l)
        CallFunction(xdbhDLL, "XDBPUTRECORD_Z", DBFhandle, @RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbQueryAVG(QueryHandle.l, FieldName.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBQUERYAVG_Z", QueryHandle, @FieldName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbQueryCondition(QueryHandle.l, JoinPhrases.l, FieldName.s, Equality.l, vParameter1.s, vParameter2.s)
        CallFunction(xdbhDLL, "XDBQUERYCONDITION_Z", QueryHandle, JoinPhrases, @FieldName, Equality, @vParameter1, @vParameter2)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbQueryDistinct(QueryHandle.l, FieldName.s)
        CallFunction(xdbhDLL, "XDBQUERYDISTINCT_Z", QueryHandle, @FieldName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbQueryExecute(QueryHandle.l)
        CallFunction(xdbhDLL, "XDBQUERYEXECUTE_Z", QueryHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbQueryIndex(QueryHandle.l)
        CallFunction(xdbhDLL, "XDBQUERYINDEX_Z", QueryHandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbQueryMAX(QueryHandle.l, FieldName.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBQUERYMAX_Z", QueryHandle, @FieldName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbQueryMIN(QueryHandle.l, FieldName.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBQUERYMIN_Z", QueryHandle, @FieldName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbQuerySort(QueryHandle.l, FieldName.s, SortDirection.l)
        CallFunction(xdbhDLL, "XDBQUERYSORT_Z", QueryHandle, @FieldName, SortDirection)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbQuerySUM(QueryHandle.l, FieldName.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBQUERYSUM_Z", QueryHandle, @FieldName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbRecallRecord(DBFhandle.l, RecordNumber.l)
        CallFunction(xdbhDLL, "XDBRECALLRECORD_Z", DBFhandle, RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbRecordBuffer(DBFhandle.l)
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBRECORDBUFFER_Z", DBFhandle))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbRecordCount(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBRECORDCOUNT_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbRecordNumber(DBFhandle.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBRECORDNUMBER_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbRegisteredTo()
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBREGISTEREDTO_Z"))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbReindex(DBFhandle.l, idxHandle.l, UniqueContinueOrError.l)
        CallFunction(xdbhDLL, "XDBREINDEX_Z", DBFhandle, idxHandle, UniqueContinueOrError)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbReindexAll(DBFhandle.l, UniqueContinueOrError.l)
        CallFunction(xdbhDLL, "XDBREINDEXALL_Z", DBFhandle, UniqueContinueOrError)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbRemoveEditLock(DBFhandle.l, Lock_Num.l)
        CallFunction(xdbhDLL, "XDBREMOVEEDITLOCK_Z", DBFhandle, Lock_Num)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbRemoveExclusiveLock(DBFhandle.l, Lock_Num.l)
        CallFunction(xdbhDLL, "XDBREMOVEEXCLUSIVELOCK_Z", DBFhandle, Lock_Num)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbResetError()
        CallFunction(xdbhDLL, "XDBRESETERROR_Z")
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbSeek(DBFhandle.l, idxHandle.l, KeyToLookFor.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBSEEK_Z", DBFhandle, idxHandle, @KeyToLookFor)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbSeekNext(DBFhandle.l, idxHandle.l, KeyToLookFor.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBSEEKNEXT_Z", DBFhandle, idxHandle, @KeyToLookFor)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbSeekPartial(DBFhandle.l, idxHandle.l, PartialKeyToLookFor.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBSEEKPARTIAL_Z", DBFhandle, idxHandle, @PartialKeyToLookFor)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbSeekPartialNext(DBFhandle.l, idxHandle.l, PartialKeyToLookFor.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBSEEKPARTIALNEXT_Z", DBFhandle, idxHandle, @PartialKeyToLookFor)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbSetAlias(DBFhandle.l, NewAliasName.s)
        CallFunction(xdbhDLL, "XDBSETALIAS_Z", DBFhandle, @NewAliasName)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbSetCallBack(hWnd.l)
        CallFunction(xdbhDLL, "XDBSETCALLBACK_Z", hWnd)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbSetEditLock(DBFhandle.l, RecordNumber.l)
        ProcedureReturn CallFunction(xdbhDLL, "XDBSETEDITLOCK_Z", DBFhandle, RecordNumber)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbSetExclusiveLock(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBSETEXCLUSIVELOCK_Z", DBFhandle)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbSkipDeleted(DBFhandle.l, OnOff.l)
        CallFunction(xdbhDLL, "XDBSKIPDELETED_Z", DBFhandle, OnOff)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbSpeedAppend(DBFhandle.l, OnOff.l)
        CallFunction(xdbhDLL, "XDBSPEEDAPPEND_Z", DBFhandle, OnOff)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbTempFileName()
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBTEMPFILENAME_Z"))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbTodaysDate()
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBTODAYSDATE_Z"))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.l xdbValidDate(DateCheck.s)
        ProcedureReturn CallFunction(xdbhDLL, "XDBVALIDDATE_Z", @DateCheck)
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure.s xdbVersion()
        ProcedureReturn PeekS(CallFunction(xdbhDLL, "XDBVERSION_Z"))
      EndProcedure

    ;-------------------------------------------------------------------

      Procedure xdbZap(DBFhandle.l)
        CallFunction(xdbhDLL, "XDBZAP_Z", DBFhandle)
      EndProcedure

  ;-Procedure xdbUseDLL-------------------------------------------------
  ;-
  ;- Procedure to load CHEETAH2.DLL permanently
  ;-
  ;---------------------------------------------------------------------

    Procedure xdbUseDLL()
      xdbhDLL = OpenLibrary(#PB_ANY, "CHEETAH2.DLL")
    EndProcedure

  ;-Procedure xdbFreeDLL------------------------------------------------
  ;-
  ;- Procedure to unload CHEETAH2.DLL after xdbUseDLL
  ;-
  ;---------------------------------------------------------------------

    Procedure xdbFreeDLL()
      CloseLibrary(xdbhDLL)
    EndProcedure

;-End-------------------------------------------------------------------
Here the changed example with an index:

Code: Select all

;-Begin-----------------------------------------------------------------

  IncludeFile "Cheetah2.pbi"

  ;-Occupy resources----------------------------------------------------

    xdbUseDLL()

  ;-FileName------------------------------------------------------------

    FileName.s = "Example1.dbf"

  ;-Create database-----------------------------------------------------

    xdbCreate(FileName, "ID,N,9,0;NAME,C,50,0;VORNAME,C,50,0")

  ;-Open database-------------------------------------------------------

    hdb.l = xdbOpen(FileName, "")

  ;-Add an index--------------------------------------------------------

    xdbCreateIndex("Name.idx", hdb, "NAME + VORNAME", #XDBTRUE)

  ;-Open the index------------------------------------------------------

    hidx.l = xdbOpenIndex("Name.idx", hdb)

  ;-Add 20 records with a name------------------------------------------

    For i = 1 To 20
      xdbClearBuffer(hdb)
      Loop.s = Str(i)
      xdbAssignField(hdb, "ID", 0, Loop)
      xdbAssignField(hdb, "NAME", 0, "Mustermann")
      xdbAssignField(hdb, "VORNAME", 0, "Max")
      xdbAppendRecord(hdb)
    Next

  ;-Change record 6 to 10 to another name-------------------------------

    For i = 6 To 10
      xdbClearBuffer(hdb)
      xdbGetRecord(hdb, i)
      xdbAssignField(hdb, "NAME", 0, "Musterfrau")
      xdbAssignField(hdb, "VORNAME", 0, "Susan")
      xdbPutRecord(hdb, i)
    Next

  ;-Delete records 4 To 7-----------------------------------------------

    For i = 4 To 7
      xdbDeleteRecord(hdb, i)
    Next
    xdbPack(hdb)

  ;-Read records 1 To 10 And print--------------------------------------

    OpenConsole()

      For i = 1 To 10
        xdbClearBuffer(hdb)
        xdbGetRecord(hdb, i)
        PrintN("ID: " + xdbFieldValue(hdb, "ID", 0))
        PrintN("Name: " + xdbFieldValue(hdb, "NAME", 0))
        PrintN("Vorname: " + xdbFieldValue(hdb, "VORNAME", 0))
      Next

      PrintN("")
      PrintN("Press any key to exit...")
      Input()

    CloseConsole()

  ;-Close index---------------------------------------------------------

    xdbCloseIndex(hdb, hidx)

  ;-Close database------------------------------------------------------

    xdbClose(hdb)

  ;-Free resources------------------------------------------------------

    xdbFreeDLL()

;-End-------------------------------------------------------------------
End
Hope it increase your development rapidly.
Thanks for your hints.
Regards
Stefan

Posted: Sun Oct 31, 2004 5:57 pm
by the.weavster
Thanks Stefan
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited