Board Logo
« Simple Database Framework »

Welcome Guest. Please Login or Register.
Jan 18th, 2018, 3:55pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 sticky  Author  Topic: Simple Database Framework  (Read 3956 times)
Stefan Pendl
Administrator
ImageImageImageImageImage


member is offline

Avatar

Let's talk JB ...


Homepage PM

Gender: Male
Posts: 3712
xx Simple Database Framework
« Thread started on: Jun 20th, 2007, 04:25am »

Find a simple database framework at http://justbasic.wikispaces.com/Simple_Database_Framework
User IP Logged

Stefan - Homepage

Remember to read the forum rules board wink

Just BASIC 1.01, Windows 10 Professional x64, Intel Core i7-4710MQ 2.5GHz, 16GB RAM
Stefan Pendl
Administrator
ImageImageImageImageImage


member is offline

Avatar

Let's talk JB ...


Homepage PM

Gender: Male
Posts: 3712
xx Re: Simple Database Framework
« Reply #1 on: Jun 21st, 2007, 01:07am »

Added version that uses GOSUB's instead of SUB's to show the differences.
User IP Logged

Stefan - Homepage

Remember to read the forum rules board wink

Just BASIC 1.01, Windows 10 Professional x64, Intel Core i7-4710MQ 2.5GHz, 16GB RAM
Chris
Full Member
ImageImageImageImage


member is offline

Avatar

I don't care what you do, but I don't wanna find out!

YIM YIM AIM
Homepage PM

Gender: Male
Posts: 453
xx Re: Simple Database Framework
« Reply #2 on: Jul 1st, 2007, 7:08pm »

A question : I changed the code alittle , so how would i add like a search part?
Code:
[init]
    'predefine item array
    dim items$(1)

    'get database contents
    gosub [OpenDB]
    gosub [ReadDB]
    gosub [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 Name:", 200,   7,  80,  25
    statictext #main.NumberDisp, "",             300,   7,  95,  25
    statictext #main.NameTxt,    "Item location:",   200,  32,  85,  25
    statictext #main.NameDisp,   "",             300,  32,  95,  25
    button #main.add,   "Add Item",   [add],       UL, 200, 112,  63,  25
    button #main.edit,  "Edit Item",  [edit],      UL, 275, 112,  63,  25
    button #main.delete,"Delete Item",[delete],    UL, 350, 112,  75,  25
    button #main.exit,  "EXIT",       [quit.main], UL, 290, 162,  39,  25

    open "DVD Data Base!" for window as #main
    print #main, "font ms_sans_serif 10"
    print #main, "trapclose [quit.main]"
    #main.itemlist "singleclickselect"
    wait

[add]
    extension$ = "add"
    gosub [CheckButton]
    wait

[edit]
    extension$ = "edit"
    gosub [CheckButton]
    wait

[delete]
    extension$ = "delete"
    gosub [CheckButton]
    #main.NameDisp,   ""
    #main.NumberDisp, ""
    wait

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

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

[quit.main]
    close #main
    END

[CheckButton]
    'select action based on pushed button
    select case extension$
        case "add"
        SelectedItem = MaxItems
        DialogCaption$ = "Add Item"
        gosub [DisplayDialog]

        case "edit"
        DialogCaption$ = "Edit Item"
        if SelectedItem > 0 then gosub [DisplayDialog]

        case "delete"
        if SelectedItem > 0 then gosub [DeleteItem]
    end select

    'refresh listbox contents
    #main.itemlist "reload"

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

[DisplayDialog]
    '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 is relative to previous open window
    UpperLeftX=1
    UpperLeftY=1

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

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

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

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

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

    gosub [ApplyItemData]
   ' wait

[quit.item]
    'exit dialog
    close #item
    return

[ApplyItemData]
    gosub [BackupDB]
    gosub [OpenDB]
    gosub [WriteDB]
    gosub [ReadDB]
    gosub [CloseDB]
    return

[DeleteItem]
    confirm "Delete Item ... "+str$(SelectedItem)+chr$(13)+_
        "Name ... "+word$(items$(SelectedItem), 1, chr$(0))+chr$(13)+_
        "Location ..... "+word$(items$(SelectedItem), 2, chr$(0));answer


    if answer then
        items$(SelectedItem) = ""

        gosub [BackupDB]
        gosub [OpenDB]
        gosub [WriteDB]
        gosub [ReadDB]
        gosub [CloseDB]
    end if
    return

[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,_
        10 as ItemName$,_
        40 as ItemNumber$,_
        10 as ItemPrize,_
        90 as Reserve$
    return

[CloseDB]
    close #db
    return

[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);trim$(ItemNumber$); chr$(0);  ItemPrize
    next
    return

[WriteDB]
    Record = 1

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

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

[BackupDB]
    if FileExists("database.bak") then kill "database.bak"

    name "database.dat" as "database.bak"
    return

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

 
User IP Logged

You know 4/3 of the people in the world don't know their fractions. smiley
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Simple Database Framework
« Reply #3 on: Jul 2nd, 2007, 05:25am »

This might need some debugging but the basic strategy is to open the database, suck it all in as one string then use instr to seek out the keyword. You will need to allow for multiple finds so you probably need another array to store the found records to let the user choose which is the one he wanted. Think you have the name and number records mixed up.


Code:
open "database.dat" for input as #1
txt$=input$(#1,lof(#1))
located=1
while located>0
    located=instr(txt$,"word to find",located)
    if located>0 then
        record=int(located/150)
        print mid$(txt$,record*150,150)
        located=located+1
        end if
wend

 
« Last Edit: Jul 2nd, 2007, 05:27am by Rod » User IP Logged

Chris
Full Member
ImageImageImageImage


member is offline

Avatar

I don't care what you do, but I don't wanna find out!

YIM YIM AIM
Homepage PM

Gender: Male
Posts: 453
xx Re: Simple Database Framework
« Reply #4 on: Jul 2nd, 2007, 11:01am »

Thanks rod, I got it to work.
User IP Logged

You know 4/3 of the people in the world don't know their fractions. smiley
Chris
Full Member
ImageImageImageImage


member is offline

Avatar

I don't care what you do, but I don't wanna find out!

YIM YIM AIM
Homepage PM

Gender: Male
Posts: 453
xx Re: Simple Database Framework
« Reply #5 on: Jul 6th, 2007, 6:02pm »

Last question - I have the search part in it, but I want the location in the search results. Like, yes you have this and it's in some location.Right now I can find it but I want to know where it is, or whatever is entered in the location place.
Code:
[init]
    'predefine item array
    dim items$(1)

    'get database contents
    gosub [OpenDB]
    gosub [ReadDB]
    gosub [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 Name:", 185,   7,  85,  30
    statictext #main.NumberDisp, "",             260,   7,  180,  25
    statictext #main.NameTxt,    "Item location:",   185,  40,  85,  25
    statictext #main.NameDisp,   "",             270,  40,  100,  25
    button #main.add,   "Add Item",   [add],       UL, 200, 112,  63,  25
    button #main.search,   "Search Item",   [search],       UL, 200, 75,  80,  25
    button #main.edit,  "Edit Item",  [edit],      UL, 275, 112,  63,  25
    button #main.delete,"Delete Item",[delete],    UL, 350, 112,  75,  25
    button #main.exit,  "EXIT",       [quit.main], UL, 290, 162,  39,  25

    open "DVD Data Base!" for window as #main
    print #main, "font ms_sans_serif 10"
    print #main, "trapclose [quit.main]"
    #main.itemlist "singleclickselect"
    wait

[add]
    extension$ = "add"
    gosub [CheckButton]
    wait

[edit]
    extension$ = "edit"
    gosub [CheckButton]
    wait

[delete]
    extension$ = "delete"
    gosub [CheckButton]
    #main.NameDisp,   ""
    #main.NumberDisp, ""
    wait
[search]
 WindowWidth = 275
    WindowHeight = 130

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

    statictext #item.NumberTxt, "Item Name:",  10,   7,  80,  25
    textbox #item.name, 105,   7, 150,  25
    button #item.cancel,  "Close",[q], UL,  95, 70,  63,  25
    button #item.default, "Ok",[se],     UL, 180, 70,  75,  25

    'modal windows block access to the previous window
    open "Search" for dialog_modal as #item
    print #item, "font ms_sans_serif 10"
    print #item, "trapclose [q]"
wait
[se]
 #item.name,"!contents? name$"
open "database.dat" for input as #1
txt$=input$(#1,lof(#1))
found = 0
located=1
close #1
while located>0
    located=instr(txt$,name$,located)
    if located>0 then
        notice "Yes, You have this movie! It's in "'I can't get to display the location
        located=located+1
        found = found + 1
        end if
wend
 if found = 0 then
notice "No, you do not have this movie!"
end if
[q]
close #item
wait
[DisplayItem]
    'get index of selected item
    #main.itemlist "selectionindex? SelectedItem"

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

[quit.main]
    close #main
    END

[CheckButton]
    'select action based on pushed button
    select case extension$
        case "add"
        SelectedItem = MaxItems
        DialogCaption$ = "Add Item"
        gosub [DisplayDialog]

        case "edit"
        DialogCaption$ = "Edit Item"
        if SelectedItem > 0 then gosub [DisplayDialog]

        case "delete"
        if SelectedItem > 0 then gosub [DeleteItem]
    end select

    'refresh listbox contents
    #main.itemlist "reload"

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

[DisplayDialog]
    '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 is relative to previous open window
    UpperLeftX=1
    UpperLeftY=1

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

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

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

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

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

    gosub [ApplyItemData]
   ' wait

[quit.item]
    'exit dialog
    close #item
    return

[ApplyItemData]
    gosub [BackupDB]
    gosub [OpenDB]
    gosub [WriteDB]
    gosub [ReadDB]
    gosub [CloseDB]
    return

[DeleteItem]
    confirm "Delete Item ... "+str$(SelectedItem)+chr$(13)+_
        "Name ... "+word$(items$(SelectedItem), 1, chr$(0))+chr$(13)+_
        "Location ..... "+word$(items$(SelectedItem), 2, chr$(0));answer


    if answer then
        items$(SelectedItem) = ""

        gosub [BackupDB]
        gosub [OpenDB]
        gosub [WriteDB]
        gosub [ReadDB]
        gosub [CloseDB]
    end if
    return

[OpenDB]
    'open database and define record length
    open "database.dat" for random as #db len=170

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

[CloseDB]
    close #db
    return

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

    '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);trim$(ItemNumber$); chr$(0);  ItemPrize
    next
    return

[WriteDB]
    Record = 1

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

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

[BackupDB]
    if FileExists("database.bak") then kill "database.bak"

    name "database.dat" as "database.bak"
    return

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


 
« Last Edit: Jul 9th, 2007, 3:08pm by Chris » User IP Logged

You know 4/3 of the people in the world don't know their fractions. smiley
Stefan Pendl
Administrator
ImageImageImageImageImage


member is offline

Avatar

Let's talk JB ...


Homepage PM

Gender: Male
Posts: 3712
xx Re: Simple Database Framework
« Reply #6 on: Jul 7th, 2007, 11:30am »

Updated the demo's at the Wiki site to include a search feature.
User IP Logged

Stefan - Homepage

Remember to read the forum rules board wink

Just BASIC 1.01, Windows 10 Professional x64, Intel Core i7-4710MQ 2.5GHz, 16GB RAM
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Simple Database Framework
« Reply #7 on: Jul 7th, 2007, 3:56pm »

Chris you kinda missed the nuances of the record size code I had in the example I gave. Recode with Stefans new search example which is more integrated with the original database example.

Stefans code searches for keywords in the "name" field. My code was searching for the keyword in any part of the record. Provided the record size matched the file. I was anticipating a more complex record structure like movie title, actor list, story line, etc etc. When you get to that stage you might need a search that spans multiple fields.
User IP Logged

stumpy
Full Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 148
xx Re: Simple Database Framework
« Reply #8 on: Aug 20th, 2017, 10:04am »

Hi Chris this seems to work ok to search for user defined phrase or number, typed into a textbox "#main.searchtext", and obtained by the program with "print #main.searchtext, "!contents? search$"; e.g. to search in a list of up to 99 cocks and one for 99 hens.

Additionally required are:

A text box "#main.searchtext" (for user to type something to seach for)
Strings of text for the cocks and hens in string arrays "cock$(n)" and "hen$(n)"
cindex (= total number of items currently in array cock$(n)
hindex (= total number of items currently in array hen$(n)

Code:
'SIMPLE case-insensitve SEARCH in cock and hen arrays

'additionally required are: text box "#main.searchtex" (for user to type in something to seach for), items in string arrays "cock$(n)" and "hen$(n)",
' and cindex (= number of items in cock$), and hindex (= number of items in hen$)

'........

[search]
found$ = ""
print #main.searchtext, "!contents? search$";
t$ = search$
tlen = len(t$)

if tlen < 2 then
 Notice "Cancelled - Only one character, or nothing, was entered!"
 goto [outsearch]
 wait
end if


for n = 1 to cindex
 for x = 1 to len(trim$(cock$(n)))
   test$ = lower$(cock$(n))
   test2$ = mid$(test$, x, tlen)

    if (test2$) = lower$(search$) then   'rem...."lower$(x$)" makes it case-insensitive
      found$= found$ + search$
      notice "Found" + chr$(13) + search$ + " was found in the list of Cocks at number " + str$(n) + " :-"+ chr$(13) + chr$(13) + cock$(n)
    end if
  next x
next n

for n = 1 to hindex
 for x = 1 to len(trim$(hen$(n)))
   test$ = lower$(hen$(n))
   test2$ = mid$(test$, x, tlen)

    if (test2$) = lower$(search$) then 
      found$= found$ + search$
      notice "Found" + chr$(13) + search$ + " was found in the list of Hens at number " + str$(n) + " :-"+ chr$(13) + chr$(13) + hen$(n)
    end if
  next x
next n

if found$ = "" then
 notice "No match was found!"
 goto [outsearch]
end if

notice "That's all"

[outsearch]
print #main.searchtext,""
wait
 

« Last Edit: Aug 20th, 2017, 10:11am by stumpy » User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls