aUCBLogo Demos and Tests / dlcheetah

to dlcheetah
   ; Example for usage of the free cheetah2.dll database DLL
   init
   ::xdb_name="cheetah2.dll
   ;'define the names of the database & index
   ::DBFname="Cheetah.dbf
   ::IDXname="Cheetah.idx
;   eraseFile DBFname

   ::xdb=DynamicLibrary xdb_name
   (pr "xdb_name xdb_name)
   (pr "DBFname DBFname)
   (pr "IDXname IDXname)

   if not fileP DBFname
   [   db_create
   ]
   db_opendbf :dbfname
   db_checkError
;   db_defineFields

;   db_createindex
;   db_openindex

   db_clearBuffer
   repeat 10 [db_addRecord]

   db_getRecord 1
   db_assignFieldInt [Nr] 0
      Int 1+2*16+3*16^2+4*16^3+5*16^4+6*16^5+7*16^6+1*16^7
   db_assignField [Name] 0 [Micheler]
   db_assignField " 3 [Andreas]
   db_putRecord 1
   db_checkError

   show db_recordCount

   db_getRecord 1
   show db_fieldValue [Vorname] 0
   show word "0x IntForm db_fieldValueInt [Nr] 0 8 16

   db_close
   db_checkError
end

to init
;   TextScreen
;   clearText
end

to defpath
   ; make "xdbAppPath "
   ; ChDir :xdbAppPath
end

to db_error
   output DLCall xdb [XDBERROR] (list "Int)
end

to db_resetError
   DLCall xdb [XDBRESETERROR] (list "Void)
end

to db_checkError
   if db_error != 0
   [   show db_error
      db_resetError
   ]
end

to db_opendbf :dbfname
;'open the database (database must be open prior to creating index)
;  dbHandle = xdbOpen&(DBFname$)
;make "dbHandle dllcall (list "l
;   "xdbOpen&
;   "l :DBFname$)
   ::dbHandle=DLCall xdb [XDBOPEN_Z] (list "Int
      "dbFile "Word DBFname
      "EncryptionKey "Word " )
end

to db_create
   ::dbHandle=DLCall xdb [XDBCREATE_Z] (list "Int
      "dbFile "Word DBFname
      "AllFields "Word [
         Nr,W,0,0;
         Name,C,30,0;
         Vorname,C,29,0])
end

to db_defineFields
   db_addField [Nr,W,0,0]
   db_addField [Name,C,30,0]
   db_addField [Vorname,C,29,0]
   db_createFields
end

to db_addfield fieldInfoString
   DLCall xdb [XDBADDFIELD_Z] (list "Void
      "FieldArray "Word fieldInfoString)
end

to db_createFields
   DLCall xdb [XDBCREATEFIELDS_Z] (list "Void
      "mFileName "Word DBFname)
end

to db_openindex
;'open the index
;  idxHandle& = xdbOpenIndex&(IDXname$, dbHandle)
comment
[   make "idxHandle& dllcall (list "l "xdbOpenIndex&
      "l :dbHandle
      "l :IDXname "l)
]
idxHandle=DLCall xdb [XDBOPENINDEX_Z] (list "Int
   "iFilename "Word :IDXname
   "dbHandle "Int :dbHandle)
end

to db_createindex
;'create the index (database must be open)
;  IndexExpr$ = "UPPER(CUSTID)"   'index is not case sensitive
;  Duplicates& = %XDBTRUE         'allow duplicate customer ID's

;  Call xdbCreateIndex(IDXname$, dbHandle, IndexExpr$, Duplicates&)
   status=DLCall xdb [XDBCREATEINDEX_Z] (list "Int
      "iFilename "Word IDXname
      "dbHandle "Int dbHandle
      "IndexExpression "Word [UPPER(CUSTID)]
      "Duplicates "Int 1)

;  If xdbError Then
;     MsgBox "Error: " & Str$(xdbError&) & " creating index.",,Title$
;     Call xdbResetError
;     Exit Function
;  End If
end

to db_clearBuffer
   DLCall xdb [XDBCLEARBUFFER] (list "Void
      "dbHandle "Int dbHandle)
end

to db_addRecord
   DLCall xdb [XDBADDRECORD] (list "Void
      "dbHandle "Int dbHandle)
end

to db_recordCount
   output DLCall xdb [XDBRECORDCOUNT] (list "Int
      "dbHandle "Int dbHandle)
end

to db_putRecord nr
   DLCall xdb [XDBPUTRECORD] (list "Void
      "dbHandle "Int dbHandle
      "recordNr "IntPtr nr)
end

to db_getRecord nr
   DLCall xdb [XDBGETRECORD] (list "Void
      "dbHandle "Int dbHandle
      "recordNr "Int nr)
end

to db_assignField fieldName fieldNumber fieldString
   DLCALL xdb [XDBASSIGNFIELD_Z] (list "Void
      "dbHandle "Int dbHandle
      "fieldName "Word fieldName
      "fieldNumber "Int fieldNumber
      "fieldString "Word fieldString)
end

to db_assignFieldInt fieldName fieldNumber fieldInt
   DLCALL xdb [XDBASSIGNFIELDLNG_Z] (list "Void
      "dbHandle "Int dbHandle
      "fieldName "Word fieldName
      "fieldNumber "Int fieldNumber
      "fieldInt "IntPtr fieldInt)
end

to db_fieldValue fieldName fieldNumber
   output DLCALL xdb [XDBFIELDVALUE_Z] (list "Word
      "dbHandle "Int dbHandle
      "fieldName "Word fieldName
      "fieldNumber "Int fieldNumber)
end

to db_fieldValueInt fieldName fieldNumber
   output DLCALL xdb [XDBFIELDVALUELNG_Z] (list "Int
      "dbHandle "Int dbHandle
      "fieldName "Word fieldName
      "fieldNumber "Int fieldNumber)
end

to db_close
   DLCall xdb [XDBCLOSE] (list "Void
      "dbHandle "Int dbHandle)
end