Here is a working example with english comments and varnames.
Note: you need to get the Base100lib userlibrary from the purearea.net site and put it in your userlibraries.
Code: Select all
#ListBox = 0
Procedure.s GetPath()
datei$ = Space(255)
GetCurrentDirectory_(255,@datei$)
ProcedureReturn Trim(datei$) + "\"
EndProcedure
Procedure Text(x.w,y.w,t$)
Locate(x,y)
DrawText(t$)
EndProcedure
;Procedure.s edbGetH(p1.s)
; p2 = edbGetIndexLen(p1)
; *smem = AllocateMemory(p2) ;GlobalAlloc_(0, p2)
; res = edbGet(p1,*smem)
; Value.s = PeekS(*smem)
; FreeMemory(*smem) ;GlobalFree_(*smem)
; ProcedureReturn Value.s
;EndProcedure
Procedure.s FieldData(fieldnum)
p2 = edbGetIndexLenIDX(fieldnum)
*smem = AllocateMemory(p2)
res = edbGetIDX(fieldnum,*smem)
Value.s = PeekS(*smem)
FreeMemory(*smem)
ProcedureReturn Value.s
EndProcedure
Procedure.s FieldName(fieldnum)
p1.s = "$dbFName," + Str(fieldnum)
*smem = AllocateMemory(8) ;GlobalAlloc_(0, 8)
res = edbGetInfo(p1,*smem)
Value.s = PeekS(*smem)
FreeMemory(*smem) ;GlobalFree_(*smem)
ProcedureReturn Value.s
EndProcedure
WindowID = OpenWindow(0, 700, 10, 320, 400, #PB_Window_SystemMenu,"Test")
StartDrawing(WindowOutput())
CreateGadgetList(WindowID()) ;list box vorbereitung
ListViewGadget(#ListBox, 10, 70, 300, 300) ;listbox erstellen
;Create Database
user$ = ""
pass$ = ""
filepath$ = getpath() + "mytest.edb"
;Create using definition file
;mytest.txt is plain text file that defines fields
;Paste the following three lines without the semicolon into a .txt file
;Folder;C;127;0
;Filename;C;127;0
;Ext;C;4;0
;filedefpath$ = getpath() + "mytest.txt"
;err = edbCreate(filedefpath$,filepath$,user$,pass$)
;Or create by dynamically adding fields
err = edbCreateNulldb(filepath$, user$, pass$)
err = edbOpen( 1, filepath$, user$, pass$)
err = edbCreateAddField("Folder,C,127,0") ;Maximum Charfield size=127
err = edbCreateAddField("Filename,C,127,0");Maximum Charfield size=127
err = edbCreateAddField("Ext,C,4,0")
err = edbClose(1)
;Now add some records
RecordsToAdd = 20000
MessageRequester("","Start Adding " + Str(RecordsToAdd) + " records.")
err = edbOpen(1, filepath$, user$, pass$)
For nIdx = 1 To RecordsToAdd
err = edbAppend()
err = edbPutIDX(1,"folderdata") ;Field Number , Field Data
err = edbPutIDX(2,"namedata" + Str(nidx))
err = edbPutIDX(3,"ext")
err = edbWriteRecord(0)
Next nIdx
err = edbClose(1)
MessageRequester("","Done Adding " + Str(RecordsToAdd) + " records.")
;Now Examine the data
;Setup search criteria
searchfor$ = "namedata9" ;search value
searchfields$ = "Filename" ;Fields to search nullstring = all fields
searchtype.b = 1 ;Search type 1-contained within 2-from left only 3-exact match 4-exact match + case sensitive
startrec.l = 1 ;start search at record 1
numrecs.l = 0 ;number of records to scan 0 = all records
recordsfound.w = 0
MaxMatchesToRetrieve = 150
HideGadget(#ListBox,1) ;hide it
AddGadgetItem(#ListBox, 0, "Search for: '" + searchfor$ + "' in fields " + searchfields$ )
recordcount = edbOpen(1, filepath$, user$, pass$)
Repeat
recordpointer.l = edbSearch(searchfor$, searchfields$, searchtype, startrec, numrecs)
If recordpointer > 0
startrec = recordpointer + 1
err.l = edbReadRecord(recordpointer)
If err = -7
fld1$ = "* no read access *"
Else
fld1$ = FieldData(1)
fld2$ = FieldData(2)
fld3$ = FieldData(3)
EndIf
recordsfound + 1
fld0$ = "Pos: " + Str(recordpointer) + " "
fld0$ = Mid(fld0$,1,10)
fldall$ = fld0$ + " " + RTrim(fld1$) + " - " + RTrim(fld2$) + " - " + fld3$
AddGadgetItem(#ListBox, recordsfound, fldall$)
EndIf
Until recordpointer <= 0 Or recordsfound > MaxMatchesToRetrieve
err = edbClose(1)
HideGadget(#ListBox,0) ;show it
DrawText("Records in DB: " + Str(recordcount))
DrawText(" Records found: " + Str(recordsfound))
Text(1,20,"Fields in DB: ")
info$ = Fieldname(1) + "-"
Text(100,20,info$)
info$ = Fieldname(2) + "-"
Text(165,20,info$)
info$ = Fieldname(3)
Text(240,20,info$)
StopDrawing()
Repeat
eventID.l = WaitWindowEvent()
Until EventID = #PB_EventCloseWindow