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