Simple Database Framework

[Rod]

It feels like the right time to bump Stefan Pendl's database code. It does not bother with RAF it has a very neat trick of using chr$(10) to show only the leading name in the listbox. So if you have a need for a simple name and address list this is a good start.


[init]
   'define global variables
   global MaxItems

   'predefine item array
   dim items$(1), search$(1)

   'get database contents
   call OpenDB
   call ReadDB
   call CloseDB

[MainGUI]
   'Form created with the help of Freeform 3 v01-28-07
   'Generated on Jun 19, 2007 at 22:50:13

   nomainwin
   WindowWidth = 440
   WindowHeight = 230
   UpperLeftX=int((DisplayWidth-WindowWidth)/2)
   UpperLeftY=int((DisplayHeight-WindowHeight)/2)

   listbox #main.itemlist, items$(, [DisplayItem],    5,   5, 175, 185
   statictext #main.NumberTxt,  "Item Number:", 200,   7,  80,  25
   statictext #main.NumberDisp, "",             300,   7,  95,  25
   statictext #main.NameTxt,    "Item Name:",   200,  32,  80,  25
   statictext #main.NameDisp,   "",             300,  32,  95,  25
   statictext #main.PrizeTxt,   "Item Prize:",  200,  57,  80,  25
   statictext #main.PrizeDisp,  "",             300,  57,  95,  25
   button #main.add,   "Add Item",   CheckButton, UL, 200, 112,  63,  25
   button #main.edit,  "Edit Item",  CheckButton, UL, 275, 112,  63,  25
   button #main.delete,"Delete Item",CheckButton, UL, 350, 112,  75,  25
   button #main.search,"Search",     [search],    UL, 200, 162,  63,  25
   button #main.exit,  "EXIT",       [quit.main], UL, 350, 162,  39,  25

   open "Simple Database Framework" for window as #main
   print #main, "font ms_sans_serif 10"
   print #main, "trapclose [quit.main]"
   #main.itemlist "singleclickselect"
   wait

[DisplayItem]
   'get index of selected item
   #main.itemlist "selectionindex? index"

   #main.NameDisp word$(items$(index), 1, chr$(0))
   #main.NumberDisp word$(items$(index), 2, chr$(0))
   #main.PrizeDisp word$(items$(index), 3, chr$(0))
   wait

[search]
   'search in the database
   WindowWidth = 430
   WindowHeight = 190

   'position of dialogs are relative to previous open window
   UpperLeftX=1
   UpperLeftY=1

   textbox    #search.String,   5,   5, 175,  25
   button     #search.default,    "Search", [doSearch],  UL, 200,   5,  75,  25
   listbox    #search.itemlist,   search$(,[doDisplay],   5,  35, 175, 120
   statictext #search.NumberTxt,  "Item Number:", 200,  35,  80,  25
   statictext #search.NumberDisp, "",             300,  35,  95,  25
   statictext #search.NameTxt,    "Item Name:",   200,  60,  80,  25
   statictext #search.NameDisp,   "",             300,  60,  95,  25
   statictext #search.PrizeTxt,   "Item Prize:",  200,  85,  80,  25
   statictext #search.PrizeDisp,  "",             300,  85,  95,  25
   button     #search.cancel,     "Close",[quit.search],  UL, 300, 127,  63,  25

   'modal windows block access to the previous window
   open "Search Database for Name" for dialog_modal as #search
   print #search, "font ms_sans_serif 10"
   print #search, "trapclose [quit.search]"
   #search.itemlist "singleclickselect"
   wait

[doSearch]
   redim search$(MaxItems)
   foundItem = 0

   ' search by name = field 1
   FieldNumber = 1

   #search.String "!contents? SearchString$"

   for Count = 1 to MaxItems
       'ignore case using LOWER$()
       if instr(lower$(word$(items$(Count), FieldNumber, chr$(0))), lower$(SearchString$)) > 0 then
           foundItem = foundItem + 1
           search$(foundItem) = items$(Count)
       end if
   next

   #search.itemlist "reload"
   #search.itemlist "selectindex 0"
   wait

[doDisplay]
   'get index of selected item
   #search.itemlist "selectionindex? index"

   #search.NameDisp word$(search$(index), 1, chr$(0))
   #search.NumberDisp word$(search$(index), 2, chr$(0))
   #search.PrizeDisp word$(search$(index), 3, chr$(0))
   wait

[quit.search]
   close #search
   wait

[quit.main]
   close #main
   END

sub CheckButton handle$
   'get extension of button
   extension$ = word$(handle$, 2, ".")

   'get index of selected item
   #main.itemlist "selectionindex? index"

   'select action based on pushed button
   select case extension$
       case "add"
       call DisplayDialog "Add Item", MaxItems

       case "edit"
       if index > 0 then call DisplayDialog "Edit Item", index

       case "delete"
       if index > 0 then call DeleteItem index
   end select

   'refresh listbox contents
   #main.itemlist "reload"

   'cancel selection to allow reselection of currently selected item
   #main.itemlist "selectindex 0"
end sub

sub DisplayDialog Caption$, ItemNumber
   'Form created with the help of Freeform 3 v01-28-07
   'Generated on Jun 19, 2007 at 22:59:56

   WindowWidth = 275
   WindowHeight = 195

   'position of dialogs are relative to previous open window
   UpperLeftX=1
   UpperLeftY=1

   statictext #item.NumberTxt, "Item Number:",  10,   7,  80,  25
   statictext #item.NameTxt,   "Item Name:",    10,  42,  80,  25
   statictext #item.PrizeTxt,  "Item Prize:",   10,  77,  80,  25
   textbox #item.Number, 105,   7, 150,  25
   textbox #item.Name,   105,  42, 150,  25
   textbox #item.Prize,  105,  77, 150,  25
   button #item.cancel,  "Close",[quit.item], UL,  95, 127,  63,  25
   button #item.default, "Apply",[apply],     UL, 180, 127,  75,  25

   'modal windows block access to the previous window
   open Caption$; " - "; ItemNumber for dialog_modal as #item
   print #item, "font ms_sans_serif 10"
   print #item, "trapclose [quit.item]"

   if ItemNumber <> MaxItems then
       #item.Name word$(items$(ItemNumber), 1, chr$(0))
       #item.Number word$(items$(ItemNumber), 2, chr$(0))
       #item.Prize word$(items$(ItemNumber), 3, chr$(0))
   end if
   #item.Number "!setfocus"
   wait


[apply]
   ' apply changes
   #item.Number "!contents? Temp1$"
   #item.Name "!contents? Name$"
   #item.Prize "!contents? Temp2$"

   ' Make sure info in boxes is the proper type of data (number/string)
   if Temp1$ = str$(val(Temp1$)) then
       Number = val(Temp1$)
   else
       ' Item entered in the Number box is not a number !
       notice "Item Number must be numeric only."
       wait
   end if
   if Temp2$ = str$(val(Temp2$)) then
       Prize = val(Temp2$)
   else
       ' Item entered in the Prize box is not a number !
       notice "Item Prize must be numeric only."
       wait
   end if

   'fill the array element with the data
   'separate fields by CHR$(0) to display only the first field in the listbox
   items$(ItemNumber) = trim$(Name$); chr$(0); Number; chr$(0); Prize

   call ApplyItemData
   wait

[quit.item]
   'exit dialog
   close #item
end sub

sub ApplyItemData
   call BackupDB
   call OpenDB
   call WriteDB
   call ReadDB
   call CloseDB
end sub

sub DeleteItem ItemIndex
   confirm "Delete Item ... "+str$(ItemIndex)+chr$(13)+_
       "Name ..... "+word$(items$(ItemIndex), 1, chr$(0))+chr$(13)+_
       "Number ... "+word$(items$(ItemIndex), 2, chr$(0))+chr$(13)+_
       "Prize .... "+word$(items$(ItemIndex), 3, chr$(0)); answer

   if answer then
       items$(ItemIndex) = ""

       call BackupDB
       call OpenDB
       call WriteDB
       call ReadDB
       call CloseDB
   end if
end sub

sub OpenDB
   'open database and define record length
   open "database.dat" for random as #db len=150

   'set the fields, include some extra space for future use
   field #db,_
       40 as ItemName$,_
       10 as ItemNumber,_
       10 as ItemPrize,_
       90 as Reserve$
end sub

sub CloseDB
   close #db
end sub

sub ReadDB
   'get the number of records in the database
   '= length of database file divided by the record length
   TotalRecords = lof(#db)/150

   'check if the database is corrupted
   if TotalRecords <> int(TotalRecords) then
       notice "Database corrupted"; chr$(13); "Please check its contents!"
       TotalRecords = int(TotalRecords + .5)
   end if

   'dimension array to enable adding one record
   MaxItems = TotalRecords + 1
   redim items$(MaxItems)

   for Record = 1 to TotalRecords
       get #db, Record

       'fill the array with the data
       'separate fields by CHR$(0) to display only the first field in the listbox
       items$(Record) = trim$(ItemName$); chr$(0); ItemNumber; chr$(0); ItemPrize
   next
end sub

sub WriteDB
   Record = 1

   for Count = 1 to MaxItems
       if items$(Count) <> "" then
           ItemName$ = word$(items$(Count), 1, chr$(0))
           ItemNumber = val(word$(items$(Count), 2, chr$(0)))
           ItemPrize = val(word$(items$(Count), 3, chr$(0)))

           put #db, Record
           Record = Record + 1
       end if
   next
end sub

sub BackupDB
   if FileExists("database.bak") then kill "database.bak"

   name "database.dat" as "database.bak"
end sub

function FileExists(FilePath$)
   ' returns zero if file does not exist
   ' returns one if file exists
   dim FileExistsInfo$(1,1)

   files "", FilePath$, FileExistsInfo$(

   FileExists = val(FileExistsInfo$(0,0))
end function