Post by mackrackit on Jun 7, 2008 3:32:08 GMT -5
About three weeks ago I started with my first data base. Thanks to the demos from Mike and Alice, the help I received here and a lot of reading I was able to make it work.
Then I got to thinking that I will not want to write code every time I wanted a different data base. So I put one together that will create a single table data base and save it in the RB root directory. This same program will open any data base containing a single table that is in the RB root directory.
Three different searches and the ability to add columns and rows.
If anyone has the time to look it over I would like you to critique it. I am sure there are things I could do to make it better.
Thank you.
Then I got to thinking that I will not want to write code every time I wanted a different data base. So I put one together that will create a single table data base and save it in the RB root directory. This same program will open any data base containing a single table that is in the RB root directory.
Three different searches and the ability to add columns and rows.
If anyone has the time to look it over I would like you to critique it. I am sure there are things I could do to make it better.
Thank you.
'##########################
'Test Data Base
titlebar "Test Data Base"
'##########################
global database$ 'Name of Data Base
global firstC$ 'Name of First Column
global secondC$ 'Name of Second Column
global Tname$ 'Name of Table
'###############################
call setCSS
'###############################
[mLog]
cls
Html "<body style='background-color: #999999;'>"
passwordbox #apw, ""
print " Enter username to enter"
print " "
print "Type ' username ' "
link #mEnter,"Click to Enter",[mLogIn]
#mEnter CSSCLass("linkButton")
[mLogIn]
atpass$ = #apw contents$()
if atpass$ = "username" then [dbSet]
wait
'###############################
[dbSet]
cls
Html "<body style='background-color: #999999;'>"
print "Enter Name of Data Base to work on,"
print "or the name of a NEW Data Base."
input "Example: xyz.db "; database$
'Check for Data Base file
files #a, database$
exists = #a hasAnswer()
if not(exists) then
cls
Html "<body style='background-color: #999999;'>"
print "Table name can not have spaces."
print " "
input "Enter the Name of Table to be created";TnameR$
input "Enter the Name of the first column to be created";firstCR$
input "Enter the Name of the second column to be created";secondCR$
input "Enter a value for the first entry in first row.";firstRR$
Tname$ = spQuote$(TnameR$)
firstC$ = clrQuote$(firstCR$)
secondC$ = clrQuote$(secondCR$)
firstR$ = clrQuote$(firstRR$)
frq$ = "insert into ";Tname$;"([";firstC$;"]) values ('"+dblQuote$(firstR$)+"')"
gnq$ = "create table ";Tname$;"([";firstC$;"] char(50),[";secondC$;"] char(50))"
sqliteconnect #dBase, database$
query$ = gnq$
#dBase execute(query$)
#dBase disconnect()
sqliteconnect #dBase, database$
query$ = frq$
#dBase execute(query$)
#dBase disconnect()
end if
'#########
cls
Html "<body style='background-color: #999999;'>"
'If data base exist,Get name of table
sqliteconnect #dBase,database$
query$ = "select name from sqlite_master where type='table'"
#dBase execute(query$)
Tname$ = #dBase nextrow$(",")
#dBase disconnect()
print " Data Base Name:"
print database$
print " "
print " Table Name:"
print Tname$
print " "
'If data base exist, read first column name into firstC$
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
firstC$ = trim$(word$(cnames$,1,","))
print " Column Names:"
print cnames$
#dBase disconnect()
'print firstC$
print " "
print " "
link #continue,"Click Continue",[start]
#continue CSSCLass("linkButton")
link #sover,"Start Over",[dbSet]
#sover CSSCLass("linkButton")
wait
'#########################
[start]
cls
Html "<body style='background-color: #999999;'>"
print
passwordbox #apw, ""
print " Enter password for client or administrator."
print " "
print "Type ' client ' or ' admin '"
link #client,"Click to Logon",[LogIn]
#client CSSCLass("linkButton")
wait
'########################################
[LogIn]
atpass$ = #apw contents$()
if atpass$ = "admin" then [admin]
if atpass$ = "client" then [client]
wait
'#######################################
[client]
cls
Html "<body style='background-color: #999999;'>"
print " "
print "CLIENT"
print ""
print ""
print ""
link #search,"SEARCH",[search]
#search CSSCLass("linkButton")
print "Search by column header"
print " "
link #search2,"SEARCH 2",[search2]
#search2 CSSCLass("linkButton")
print "Search by text and column header"
print " "
link #search3,"SEARCH 3",[search3]
#search3 CSSCLass("linkButton")
print "Search by wildcard text and column header"
print " "
link #logOut,"Log Out",[start]
#logOut CSSCLass("linkButton")
link #sover,"Start Over",[dbSet]
#sover CSSCLass("linkButton")
wait
'#######################################
'#######################################
[search3]
dim arrayR$(100)
dim arrayC$(100)
cls
Html "<body style='background-color: #999999;'>"
print " "
'#Column Header Array
Cindex=1
index=0
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
WHILE word$(cnames$,Cindex,",") <> ""
firstname$ = trim$(word$(cnames$,Cindex,","))
if arrayC$(index) = "" then arrayC$(index) = firstname$
index = index +1
Cindex = Cindex + 1
wend
#dBase disconnect()
print " "
print "Column Headers"
listbox #CAV,arrayC$(),1
print " "
link #sel2, "Get Selection",[selectS3]
#sel2 CSSCLass("linkButton")
wait
[selectS3]
cls
Html "<body style='background-color: #999999;'>"
VFR$=#CAV selection$()
C$ = trim$(#CAV selection$())
print "You selected: ";C$
input "Enter text to search for.";txtSR$
txtS$ = dblQuote$(txtSR$)
query$ = "select * from ";Tname$;" where [";C$;"] like '%"+txtS$+"%'"
Div FontBlack
html "<div align=""center""><br />"
sqliteconnect #dBase, database$
#dBase execute(query$)
if #dBase hasanswer()then
cssClass "table", "{ width: 95%; text-align:left;border-style:solid;border-width:1px;border-color:#000000;}"
cssClass "tr", "{ background: #FFFACD; padding: 3px }"
cssClass "td", "{width: 300px;
white-space: pre-wrap; /* css-3 */
white-space: -moz-pre-wrap; /* Mozilla, since 1999 */
white-space: -pre-wrap; /* Opera 4-6 */
white-space: -o-pre-wrap; /* Opera 7 */
word-wrap: break-word; /* Internet Explorer 5.5+ */
}"
render #dBase
html "</div>"
else
print "No Data"
print "Log in as administrator to add data."
end if
#dBase disconnect()
END DIV
print " "
link #done,"[Done]",[client]
#done CSSCLass("linkButton")
wait
'#######################################
[search2]
dim arrayR$(100)
dim arrayC$(100)
cls
Html "<body style='background-color: #999999;'>"
print " "
'#Column Header Array
Cindex=1
index=0
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
WHILE word$(cnames$,Cindex,",") <> ""
firstname$ = trim$(word$(cnames$,Cindex,","))
if arrayC$(index) = "" then arrayC$(index) = firstname$
index = index +1
Cindex = Cindex + 1
wend
#dBase disconnect()
print " "
print "Column Headers"
listbox #CAV,arrayC$(),1
print " "
link #sel2, "Get Selection",[selectS2]
#sel2 CSSCLass("linkButton")
wait
[selectS2]
cls
Html "<body style='background-color: #999999;'>"
VFR$=#CAV selection$()
C$ = trim$(#CAV selection$())
print "You selected: ";C$
input "Enter text to search for.";txtSR$
txtSX$ = dblQuote$(txtSR$)
txtS$ = " "+txtSX$+" "
query$ = "select * from ";Tname$;" where [";C$;"] like '%"+txtS$+"%'"
Div FontBlack
html "<div align=""center""><br />"
sqliteconnect #dBase, database$
#dBase execute(query$)
if #dBase hasanswer()then
cssClass "table", "{ width: 95%; text-align:left;border-style:solid;border-width:1px;border-color:#000000;}"
cssClass "tr", "{ background: #FFFACD; padding: 3px }"
cssClass "td", "{width: 300px;
white-space: pre-wrap; /* css-3 */
white-space: -moz-pre-wrap; /* Mozilla, since 1999 */
white-space: -pre-wrap; /* Opera 4-6 */
white-space: -o-pre-wrap; /* Opera 7 */
word-wrap: break-word; /* Internet Explorer 5.5+ */
}"
render #dBase
html "</div>"
else
print "No Data"
print "Log in as administrator to add data."
end if
#dBase disconnect()
END DIV
print " "
link #done,"[Done]",[client]
#done CSSCLass("linkButton")
wait
'#######################################
[search] 'Two Column
dim arrayR$(100)
dim arrayC$(100)
cls
Html "<body style='background-color: #999999;'>"
print " "
'#Column Header Array
Cindex=1
index=0
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
WHILE word$(cnames$,Cindex,",") <> ""
firstname$ = trim$(word$(cnames$,Cindex,","))
if arrayC$(index) = "" then arrayC$(index) = firstname$
index = index +1
Cindex = Cindex + 1
wend
#dBase disconnect()
print " "
'#First Column Array
indexR = 0
sqliteconnect #dBase,database$
query$ = "select [";firstC$;"] from ";Tname$
#dBase execute(query$)
if #dBase hasanswer()then
for x = 1 to #dBase rowcount()
cnamesR$ = #dBase nextrow$(",")
if arrayR$(indexR) = "" then arrayR$(indexR) = cnamesR$
indexR = indexR + 1
next x
end if
#dBase disconnect()
print " "
print "Column Headers"
listbox #CAV,arrayC$(),1
print " "
print " "
print " "
print
link #sel, "Get Selection",[selectS]
#sel CSSCLass("linkButton")
wait
[selectS]
cls
Html "<body style='background-color: #999999;'>"
VFR$=#CAV selection$()
R$ = trim$(#CAV selection$())
gnq$="select [";firstC$;"], [";R$;"] from ";Tname$
print "You selected ";R$
Div FontBlack
html "<div align=""center""><br />"
sqliteconnect #dBase, database$
query$ = gnq$
#dBase execute(query$)
if #dBase hasanswer()then
cssClass "table", "{ width: 95%; text-align:left;border-style:solid;border-width:1px;border-color:#000000;}"
cssClass "tr", "{ background: #FFFACD; padding: 3px }"
cssClass "td", "{width: 300px;
white-space: pre-wrap; /* css-3 */
white-space: -moz-pre-wrap; /* Mozilla, since 1999 */
white-space: -pre-wrap; /* Opera 4-6 */
white-space: -o-pre-wrap; /* Opera 7 */
word-wrap: break-word; /* Internet Explorer 5.5+ */
}"
render #dBase
html "</div>"
else
print "No Data"
print "Log in as administrator to add data."
end if
#dBase disconnect()
END DIV
print " "
link #done,"[Done]",[client]
#done CSSCLass("linkButton")
wait
'#######################################
'#######################################
'#######################################
'ADMIN SECTION
'#######################################
[admin]
cls
Html "<body style='background-color: #999999;'>"
print " "
print "ADMIN"
print ""
print ""
' link #readC,"[Read Columns]",[columnHeaders]
link #addC,"Add Column",[addColumn]
' link #readAll,"[Read All]",[readAll]
link #addp,"Add Row",[addToRowTypes]
link #readFromTable,"Read From Table",[readFromTable]
link #firstColumn,"First Column Entries",[firstColumn]
link #addGD,"Add Data",[generalData]
#addC CSSCLass("linkButton")
#addp CSSCLass("linkButton")
#readFromTable CSSCLass("linkButton")
#firstColumn CSSCLass("linkButton")
#addGD CSSCLass("linkButton")
print ""
print ""
link #logOut,"Log Out",[start]
#logOut CSSCLass("linkButton")
link #sover,"Start Over",[dbSet]
#sover CSSCLass("linkButton")
wait
'#####################################
[generalData]
dim arrayR$(100)
dim arrayC$(100)
cls
Html "<body style='background-color: #999999;'>"
print " "
'#Column Header Array
Cindex=1
index=0
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
WHILE word$(cnames$,Cindex,",") <> ""
firstname$ = trim$(word$(cnames$,Cindex,","))
if arrayC$(index) = "" then arrayC$(index) = firstname$
index = index +1
Cindex = Cindex + 1
wend
#dBase disconnect()
print " "
'#First Column Array
indexR = 0
sqliteconnect #dBase,database$
query$ = "select [";firstC$;"] from ";Tname$
#dBase execute(query$)
if #dBase hasanswer()then
for x = 1 to #dBase rowcount()
cnamesR$ = #dBase nextrow$(",")
if arrayR$(indexR) = "" then arrayR$(indexR) = cnamesR$
indexR = indexR + 1
next x
end if
#dBase disconnect()
print " "
print "Column Hheaders"
listbox #CAV,arrayC$(),1
print " "
print " "
print "First Column Values"
listbox #FCAV,arrayR$(),1
VFC$=#FCAV selection$()
print VFC$
print " "
print
link #sel, "Get Selection",[select]
#sel CSSCLass("linkButton")
wait
[select]
cls
Html "<body style='background-color: #999999;'>"
VFC$=#FCAV selection$()
VFR$=#CAV selection$()
print
'print "You selected ";VFC$
print "You selected ";VFR$
print " "
print " "
Div FontBlack
html "<div align=""center""><br />"
sqliteconnect #dBase, database$
query$ = "select * from ";Tname$;" where [";firstC$;"]='"+dblQuote$(VFC$)+"'"
#dBase execute(query$)
cssClass "table", "{ width: 600px; text-align:left;border-style:solid;border-width:1px;border-color:#000000;}"
cssClass "tr", "{ background: #FFFACD; padding: 3px }"
cssClass "td", "{width:45%;}"
render #dBase
html "</div>"
#dBase disconnect()
END DIV
print " "
'#SETUP FOR CHANGES
key$=VFC$
print " "
print "For ";VFC$ 'COLUMN#1 VALUE
print "Enter NEW value for ";VFR$ 'VALUE IN ROW UNDER COLUMN
print " "
textbox #NVbox,""
print " "
print " "
link #conf,"[Accept]",[acceptChange]
link #can,"[Cancel]",[admin]
wait
[acceptChange]
NV$=#NVbox contents$()
print NV$
action$="update ";Tname$;" set '";VFR$;"'=('"+dblQuote$(NV$)+"') where [";firstC$;"]='";key$;"'"
sqliteconnect #dBase,database$
#dBase execute(action$)
#dBase disconnect()
goto [admin]
wait
'#####################################
[columnHeaders]
cls
Html "<body style='background-color: #999999;'>"
print " "
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
print cnames$
#dBase disconnect()
print " "
link #done,"[Done]",[admin]
#done CSSCLass("linkButton")
wait
'#####################################
[firstColumn]
cls
Html "<body style='background-color: #999999;'>"
print " "
sqliteconnect #dBase,database$
query$ = "select [";firstC$;"] from ";Tname$
#dBase execute(query$)
if #dBase hasanswer()then
for x = 1 to #dBase rowcount()
print #dBase nextrow$(",")
next x
end if
#dBase disconnect()
print " "
link #done,"[Done]",[admin]
#done CSSCLass("linkButton")
wait
'#####################################
[addColumn]
cls
Html "<body style='background-color: #999999;'>"
print " "
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
cnames$ = #dBase columnnames$()
print "Current Columns"
print cnames$
#dBase disconnect()
print " "
link #done,"[Cancel]",[admin]
print " "
input "Enter new column name: ";cnR$
cn$ = clrQuote$(cnR$)
input "Add new column (Y/N): ";c$
if upper$(c$)="Y" then
action$="alter table ";Tname$;" add '"+cn$+"' char(50)"
sqliteconnect #dBase,database$
#dBase execute(action$)
#dBase disconnect()
end if
link #done,"[Done]",[admin]
#done CSSCLass("linkButton")
Html "</body>"
wait
'######################################
[addToRowTypes]
cls
Html "<body style='background-color: #999999;'>"
print " "
print "First column entries in data base."
print " "
sqliteconnect #dBase,database$
query$ = "select [";firstC$;"] from ";Tname$
#dBase execute(query$)
if #dBase hasanswer()then
for x = 1 to #dBase rowcount()
print #dBase nextrow$(",")
next x
end if
#dBase disconnect()
print " "
html "<TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0>"
html "<TR><TD COLSPAN=2 BGCOLOR=#FFCC99 ALIGN=CENTER>Row Name</TD></TR>"
html "<TR><TD BGCOLOR=#FFCC99 ALIGN=RIGHT>Type Name</TD><TD>"
textbox #p, p$
'html "</TD></TR><TR><TD BGCOLOR=#FFCC99 ALIGN=RIGHT>Description</TD><TD>"
'textbox #d, d$
'html "</TD></TR><TR><TD BGCOLOR=#FFCC99 ALIGN=RIGHT>Amount</TD><TD>"
'textbox #a, a$
'html "</TD></TR><TR><TD BGCOLOR=#FFCC99 ALIGN=RIGHT>Cost</TD><TD>"
'textbox #c, c$
html "</TD></TR><TR><TD COLSPAN=2 BGCOLOR=#FFCC99 ALIGN=CENTER>"
link #add, "Add", [doAdd]
html " "
link #cnc, "Cancel", [admin]
html "</TD></TR>"
html "</TABLE>"
print " "
wait
[doAdd]
pR$ = trim$(#p contents$())
p$ = clrQuote$(pR$)
'd$ = trim$(#d contents$())
'a$ = trim$(#a contents$())
'c$ = trim$(#c contents$())
input "Add new entry? (Y/N): ";f$
if upper$(f$)="Y" then
query$ = "insert into ";Tname$;"([";firstC$;"]) values ('"+dblQuote$(p$)+"')"
sqliteconnect #dBase,database$
#dBase execute(query$)
#dBase disconnect()
end if
goto [admin]
'#######################################
[readFromTable]
cls
Html "<body style='background-color: #999999;'>"
Div FontBlack
html "<div align=""center""><br />"
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$;" order by [";firstC$;"] asc;"
#dBase execute(query$)
cssClass "table", "{ width: 95%; text-align:left;border-style:solid;border-width:1px;border-color:#000000;}"
cssClass "tr", "{ background: #FFFACD; padding: 5px }"
cssClass "td", "{width:10%;}"
render #dBase
html "</div>"
#dBase disconnect()
link #done,"[Done]",[admin]
#done CSSCLass("linkButton")
END DIV
wait
'#######################################
[readAll]
cls
Html "<body style='background-color: #999999;'>"
print " "
sqliteconnect #dBase,database$
query$ = "select * from ";Tname$
#dBase execute(query$)
if #dBase hasanswer()then
for x = 1 to #dBase rowcount()
print #dBase nextrow$(",")
next x
end if
#dBase disconnect()
link #done,"[Done]",[admin]
#done CSSCLass("linkButton")
wait
'#######################################
sub setCSS
CSSID #Section1, "{Color: #FF00FF;
Font-Size: 16pt;
}"
CSSID #FontLime, "{Color: Lime;
Font-Size: 12pt;
}"
CSSID #FontBlack, "{Color: Black;
Font-Size: 10pt;
}"
CSSID #bground, "{background: GRAY;Height: 1000px}" ';RGB(60, 60, 60);Text-Align: Left
cssclass "a.calcButton", "{ text-decoration: none; font-size: 12pt; width: 100px; height: 50px; display: block; float: left; background: #FFF; margin-right: 5px; text-align: center }"
CSSCLass "a.fancyButton","{
Text-Decoration: None;
Font-Size: 12pt;
Font-Weight: Bold;
Width: 140px;
Height: 30px;
Display: Block;
Background: #C0C0C0;
Color: #003300;
Border-Width: Thick;
Border-Style: Outset;
Border-Color: #AAAAAA;
}"
CSSClass "a.linkButton", "{
Width: 140px;
Height: 30px;
Text-Align: Center;
Border-Width: Medium;
Border-Style: Outset;
Text-Decoration: None;
Background: #33ff33;
Display: Block;
Color: #003300;
}"
end sub
'#########################
' -----------------------------------------
' Convert single quotes to double quotes
' -----------------------------------------
FUNCTION dblQuote$(str$)
i = 1
qq$ = ""
while (word$(str$,i,"'")) <> ""
dblQuote$ = dblQuote$;qq$;word$(str$,i,"'")
qq$ = "''"
i = i + 1
WEND
END FUNCTION
' -----------------------------------------
' Convert single quotes to SPACE
' -----------------------------------------
FUNCTION clrQuote$(str$)
i = 1
qq$ = ""
while (word$(str$,i,"'")) <> ""
clrQuote$ = clrQuote$;qq$;word$(str$,i,"'")
qq$ = " "
i = i + 1
WEND
END FUNCTION
' -----------------------------------------
' Convert SPACE quotes to "_"
' -----------------------------------------
FUNCTION spQuote$(str$)
i = 1
qq$ = ""
while (word$(str$,i," ")) <> ""
spQuote$ = spQuote$;qq$;word$(str$,i," ")
qq$ = "_"
i = i + 1
WEND
END FUNCTION
