Need Help with Basic Please?

From	Cyber Spaceman <code7526@gmail.com>
Newsgroups	comp.lang.basic.misc
Subject	Need Help with Basic Please?
Date	2012-07-28 04:08 -0700
Organization	http://groups.google.com
Message-ID	<5605b324-83f7-4f20-98f5-ad1d93e8664e@googlegroups.com> (permalink)

Show all headers | View raw

Hi All

I am new to programming. I found this basic code for a database on the internet. How do you take code for a database in your just basic v1.01 compiler and make it work as a real database on your computer where you can add data and delete data from it? When the database code runs inside my compiler it doesn't allow me to add data or delete data.

Any help would be much appreciated.

Regards Cyber Spaceman 



[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 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",   [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.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
 
[add]
    extension$ = "add"
    gosub [CheckButton]
    wait
 
[edit]
    extension$ = "edit"
    gosub [CheckButton]
    wait
 
[delete]
    extension$ = "delete"
    gosub [CheckButton]
    wait
 
[DisplayItem]
    'get index of selected item
    #main.itemlist "selectionindex? SelectedItem"
 
    #main.NameDisp word$(items$(SelectedItem), 1, chr$(0))
    #main.NumberDisp word$(items$(SelectedItem), 2, chr$(0))
    #main.PrizeDisp word$(items$(SelectedItem), 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
 
[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 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 DialogCaption$; " - "; SelectedItem for dialog_modal as #item
    print #item, "font ms_sans_serif 10"
    print #item, "trapclose [quit.item]"
 
    if SelectedItem <> MaxItems then
        #item.Name word$(items$(SelectedItem), 1, chr$(0))
        #item.Number word$(items$(SelectedItem), 2, chr$(0))
        #item.Prize word$(items$(SelectedItem), 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$(SelectedItem) = trim$(Name$); chr$(0); Number; chr$(0); Prize
 
    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)+_
        "Number ... "+word$(items$(SelectedItem), 2, chr$(0))+chr$(13)+_
        "Prize .... "+word$(items$(SelectedItem), 3, 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,_
        40 as ItemName$,_
        10 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); ItemNumber; chr$(0); ItemPrize
    next
    return
 
[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
    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

Back to comp.lang.basic.misc | Previous | Next — Next in thread | Find similar

Thread

Need Help with Basic Please? Cyber Spaceman <code7526@gmail.com> - 2012-07-28 04:08 -0700
  Re: Need Help with Basic Please? Helmut_Meukel <Helmut_Meukel@bn-hof.invalid> - 2012-07-28 13:56 +0200
    Re: Need Help with Basic Please? "Auric__" <not.my.real@email.address> - 2012-07-28 21:31 +0000
      Re: Need Help with Basic Please? aury <aurelw.wiz@gmail.com> - 2012-08-07 09:00 -0700
        Re: Need Help with Basic Please? "news@rtrussell.co.uk" <news@rtrussell.co.uk> - 2012-08-07 14:35 -0700
  Re: Need Help with Basic Please? "news@rtrussell.co.uk" <news@rtrussell.co.uk> - 2012-07-28 09:26 -0700

csiph-web