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 [Nr0 
      
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[Micheler]
   
db_assignField [Andreas]
   
db_putRecord 1
   
db_checkError

   
show db_recordCount

   
db_getRecord 1
   
show db_fieldValue [Vorname0
   
show word "0x IntForm db_fieldValueInt [Nr0 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