Post by meerkat on May 6, 2019 7:47:20 GMT -5
Many times there are several tables in a database. To maintain those tables, you usually have to write a program for each table.
This program works for any table. It has the following features.
- Lists the data a page at at time. YOu can specify the number of Lines Per Page. Go to Previous and Next page, or go directly to any page.
- Click a line on the page and it shows the detail.
- You can Add, Change, or Delete the detail
- Sort on multiple columns. Enter the sequence numbers by the fields you want sorted. A (d) after the seq for descending as in 2d.
- Drill down with multiple wild card searches. Enter * for wild card. *xxx finds everything that ends in xxx. xxx* finds everything that begins with xxx. *xxx* finds things that have xxx in the field somewhere. xxx finds everything that equals xxx
- Export to CSV. It exports according to the sort sequence and drill down
- Import from CSV
This program works for any table. It has the following features.
- Lists the data a page at at time. YOu can specify the number of Lines Per Page. Go to Previous and Next page, or go directly to any page.
- Click a line on the page and it shows the detail.
- You can Add, Change, or Delete the detail
- Sort on multiple columns. Enter the sequence numbers by the fields you want sorted. A (d) after the seq for descending as in 2d.
- Drill down with multiple wild card searches. Enter * for wild card. *xxx finds everything that ends in xxx. xxx* finds everything that begins with xxx. *xxx* finds things that have xxx in the field somewhere. xxx finds everything that equals xxx
- Export to CSV. It exports according to the sort sequence and drill down
- Import from CSV
' ***********************************************************
' file maintenance
' ***********************************************************
bf$ = "<SPAN STYLE='font-family:Arial; font-weight:700; font-size:12pt'>"
' Set your color scheme here
clrHdr$ = "wheat" ' Header
clrBkg$ = "#F9E79F" ' Bachground
clr0bg$ = "#FCF3CF" ' Even line color
clr1bg$ = "#FEF9E7" ' Odd Line color
clrTbl$ = "brown" ' Table border color
' ----------------------------------
' select a db and get the table
' ----------------------------------
[load]
cls
upload "Select Database"; db$
if db$ = "" then end
open db$ for input as #1
sz = lof(#1)
a$ = "?"
if sz > 12 then line input #1, a$
close #1
a$ = left$(a$,13)
if lower$(a$) <> "sqlite format" then
print "Database:";db$;" is not a SQLite file"
end
end if
' ----------------- connect to requested db ----------------
sqliteconnect #sql, db$ ' Connect to the DB
sql$ = "SELECT name FROM sqlite_master WHERE type='table'"
ON ERROR goto [sqlErr]
#sql execute(sql$)
rows = #sql ROWCOUNT() 'Get the number of tables in the db
if rows < 1 then
print "There are no tables in ";db$
end
end if
print "There are ";rows;" tables in ";db$
button #go, "GO", [go]
html " "
button #ex, "EXIT", [exit]
html "<BR><SELECT name='tbl' size=";rows;">"
for i = 1 to rows
#row = #sql #nextrow()
tbl$ = #row name$()
html "<option value='";tbl$;"'>";tbl$;"</option>"
next i
html "</select><BR>"
wait
' --------------------------------
' Table selected
' ready to rock and roll
' --------------------------------
[go]
tblName$ = #request get$("tbl")
if tblName$ = "" then
print "No table selected"
wait
end if
sql$ = "PRAGMA table_info(";tblName$;")" ' returns cid|name|type|notnull|dflt_value|pk
#sql execute(sql$)
numFlds = #sql ROWCOUNT() 'Get the number of fields in the db
colNames$ = ""
fldNames$ = ""
sep$ = "SELECT max(length("
dim fldName$(numFlds)
dim fldType$(numFlds)
dim fldSize$(numFlds)
dim fldSize(numFlds)
dim fldDecm$(numFlds)
for i = 1 to numFlds
result$ = #sql nextrow$(" |")
fldName$(i) = word$(result$,2," |")
fldNames$ = fldNames$ + "," + fldName$(i)
colNames$ = colNames$ +sep$ + fldName$(i) + "))"
sep$ = ",max(length("
a$ = word$(result$,3," |") + "( )"
fldType$(i) = word$(a$,1,"(")
a$ = word$(a$,2,"(")
a$ = word$(a$,1,")")
if instr(a$,",") then ' see if it has decimals
fldSize$(i) = word$(a$,1,",")
fldDecm$(i) = word$(a$,2,",")
else
fldSize$(i) = a$
end if
fldType$(i) = upper$(fldType$(i))
fldTypes$ = fldTypes$ + cma$ + fldType$(i)
if fldType$(i) = "TEXT" then fldSize$(i) = "40"
if fldType$(i) = "DATE" then fldSize$(i) = "10"
if trim$(fldSize$(i)) = "" then fldSize$(i) = "10"
if val(fldSize$(i)) < 4 then fldSize$(i) = "4"
if val(fldSize$(i)) > 30 then fldSize$(i) = "30"
fldSize(i) = val(fldSize$(i))
next i
sql$ = colNames$ + " FROM ";tblName$
#sql execute(sql$)
a$ = #sql nextrow$(",")
dim colSize(numFlds)
for i = 1 to numFlds
cs = val(word$(a$,i,","))
cs = max(2,cs) ' must be at least 2 wide for hdg
colSize(i) = min(20,cs) ' can't be over 20
next i
numRecords = 0
' =================================================
' List
' =================================================
[list]
' ------------------------------------------------
' how many records
' ------------------------------------------------
cls
if numRecords = 0 then
sql$ = "SELECT count(*) as numRecords FROM ";tblName$ + where$ + groupBy$
#sql execute(sql$)
#row = #sql #nextrow()
numRecords = #row numRecords()
end if
gosub [hdng] ' display headin and message area
' -------------------------------------------------------------
' Record Heading
' -------------------------------------------------------------
html bf$;"<TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0 WIDTH=100%>"
html "<TR><TD></TD><TD></TD></TR><TR><TD valign=top>"
' -----------------------------
' detail screen with input
' -----------------------------
html "<TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0 bordercolor=";clrTbl$;" bgcolor=";clr1bg$;">"
html "<TR><TD align=center colspan=2>"
html "<A title='Add a Record'>"
button #add, "ADD", [add]
html "</A><A title='Change a Record'>"
button #chg, "CHG", [chg]
html "</A><A title='Delete a Record'>"
button #del, "DEL", [del]
html "</A><A title='Clear detail record input area'>"
button #clr, "CLR", [clr]
html "</A>"
html "<BR>"
html "<A title='Select and execute requested sort'>"
button #srt, "Sort", [sort]
html "</A><A title='Select and execute requested Groups'>"
button #grp, "Grup", [grup]
html "</A><A title='Select and execute requested Search'>"
button #sch, "SRCH", [src]
html "</A><A title='Multiple Linear Regression of multiple selected points'>"
button #mlr, "MLR", [mlr]
html "</A><A title='Linear regression of X and Y points'>"
button #lnr, "LenR", [lenr]
html "</A><A title='Curvilinear Interpolation of X and Y points'>"
button #cin, "Cint", [cint]
html "</A>"
html "</TD></TR>"
for i = 1 to numFlds
html "<TR>"
html "<TD bgcolor=";clrHdr$;" align=right>";fldName$(i);"</TD><TD>"
if fldType$ = "TEXT" then
html "<textarea name='";fldName$;"' id='";fldName$;"' rows=4 cols=35></textarea>"
else
html "<input type='text' name='";fldName$(i);"' id='";fldName$(i);"' value='' size=";fldSize$(i);"/>"
end if
html "</TD></TR>"
next i
html "</TABLE>"
html "</TD><TD valign=top>"
' --------------------------------
' list table data
' --------------------------------
html "<TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0 bordercolor=";clrTbl$;" width=100%>"
html "<TR bgcolor=";clrBkg$;" align=center valign=bottom>"
html "<TD>*</TD>"
for i = 1 to numFlds
colName$ = left$(fldName$(i),colSize(i))
if len(fldName$(i)) > colSize(i) then colName$ = colName$ + "<BR>" + mid$(fldName$(i),colSize(i)+ 1,colSize(i))
html "<TD>";colName$;"</TD>"
next i
html "</TR>"
if sumAvg$ <> "" then
a$ = sumAvg$
else
a$ = fldNames$
end if
sql$ = "SELECT ";tblName$;".rowid as rowid";a$;"
FROM ";tblName$ + where$ + groupBy$ + orderBy$ + limit$
dispLine = 0
#sql execute(sql$)
WHILE #sql hasanswer()
a$ = #sql nextrow$(" |")
dispLine = dispLine + 1
if dispLine AND 1 then
html "<TR BGCOLOR=";clr0bg$;">"
else
html "<TR BGCOLOR=";clr1bg$;">"
end if
html "<TD align=center>"
rowid$ = word$(a$,1,"|")
html "<A title='View Record detail'>"
button #vue, "", [shoDtl]
#vue setkey(rowid$)
html "</A></TD>"
for i = 1 to numFlds
fs = fldSize(i)
ft$ = fldType$(i)
val$ = word$(a$,i+1,"|")
val$ = left$(val$,20)
alin$ = ""
if instr("INTEGER DECIMAL FLOAT SMALLINT",ft$) then alin$ = "align=right"
if fs < 5 then alin$ = "align=center"
html "<TD ";alin$;">";val$;"</TD>"
next i
html "</TR>"
WEND
html "</TABLE>"
html "</TD></TR><TR></TABLE>"
wait
' ----------------------------------------------
' clear detail from screen
' -----------------------------------
[clr]
h$ = "<script>"
for i = 1 to numFlds
h$ = h$ + "document.getElementById('";fldName$(i);"').value = '';";chr$(13)
next i
html h$;"</script>"
wait
' ------------------------------------
' show selected record detail
' ------------------------------------
[shoDtl]
thisRowid$ = EventKey$
sql$ = "SELECT * FROM ";tblName$;" WHERE ";tblName$;".rowid = '";thisRowid$;"'"
#sql execute(sql$)
h$ = "<script>"
a$ = #sql nextrow$(" |")
for i = 1 to numFlds
val$ = word$(a$,i,"|")
h$ = h$ + "document.getElementById('";fldName$(i);"').value = '";val$;"';";chr$(13)
next i
html h$;"</script>"
wait
[del] ' Delete selected record
sql$ = "DELETE FROM ";tblName$;" WHERE rowid = '";thisRowid$;"'"
#sql execute(sql$)
numRecords = 0
goto [list]
' ---------------- add ---------------------------------
[add] ' Add a new record to the file
vals$ = ""
sep$ = "'"
for i = 1 to numFlds
vals$ = vals$ + sep$ + dblQuote$(#request get$(fldName$(i)))
sep$ = "','"
next i
vals$ = vals$ + "'"
sql$ = "INSERT INTO ";tblName$;" VALUES(";vals$;")"
ON ERROR GOTO [addErr]
#sql execute(sql$)
numRecords = 0
goto [list]
[addErr]
errMsg$ = "** ERROR ** Duplicate key. Please change the key values"
html "<script> document.getElementById('errMsg').innerHTML = '";errMsg$;"';</script>"
errMsg$ = ""
wait
' --------------------------------------------------
[chg] ' Change selected record
sep$ = ""
sql$ = ""
for i = 1 to numFlds
sql$ = sql$ + sep$ + fldName$(i) + " = '" + dblQuote$(#request get$(fldName$(i))) + "'"
sep$ = ",";chr$(13)
next i
sql$ = "UPDATE ";tblName$;" SET " ; sql$ ; chr$(13);" WHERE rowid = ";thisRowid$
ON ERROR goto [chgErr]
#sql execute(sql$)
goto [list]
[chgErr]
print sql$
errMsg$ = "** ERROR ** Cannot change.. Make sure you have correct key values"
html "<script> document.getElementById('errMsg').innerHTML = '";errMsg$;"';</script>"
errMsg$ = ""
wait
' ----------------------------
' sort
' ----------------------------
[sort]
dim srt$(numFlds)
orderBy$ = ""
for i = 1 to numFlds
a$ = #request get$(fldName$(i))
a = val(a$)
srt$(a) = srt$(a) + "," + fldName$(i)
if lower$(right$(a$,1)) = "d" then srt$(a) = srt$(a) + " desc "
next i
for i = 1 to numFlds
if srt$(i) <> "" then orderBy$ = orderBy$ + srt$(i)
next i
orderBy$ = " ORDER BY ";mid$(orderBy$,2)
goto [list]
' ----------------------------
' sort
' ----------------------------
[sort]
dim srt$(numFlds)
selFlds$ = ""
orderBy$ = ""
groupBy$ = ""
sumAvg$ = ""
for i = 1 to numFlds
a$ = lower$(#request get$(fldName$(i)))
a = val(a$)
if group$ = "g" then
if instr(a$,"a") + instr(a$,"s") = 0 then sumAvg$ = sumAvg$ + "," + fldName$(i)
if instr(a$,"a") then sumAvg$ = sumAvg$ + "," + "avg(";fldName$(i);") as ";fldName$(i)
if instr(a$,"s") then sumAvg$ = sumAvg$ + "," + "sum(";fldName$(i);") as ";fldName$(i)
end if
srt$(a) = srt$(a) + "," + fldName$(i)
if lower$(right$(a$,1)) = "d" and group$ <> "g" then srt$(a) = srt$(a) + " desc "
next i
for i = 1 to numFlds
if srt$(i) <> "" then selFlds$ = selFlds$ + srt$(i)
next i
if selFlds$ = "" then sumAvg$ = ""
if selFlds$ <> "" then
if group$ = "g" then
groupBy$ = " GROUP BY ";mid$(selFlds$,2)
else
orderBy$ = " ORDER BY ";mid$(selFlds$,2)
end if
end if
goto [list]
dim srt$(numFlds)
orderBy$ = ""
for i = 1 to numFlds
a$ = #request get$(fldName$(i))
a = val(a$)
srt$(a) = srt$(a) + "," + fldName$(i)
if lower$(right$(a$,1)) = "d" then srt$(a) = srt$(a) + " desc "
next i
for i = 1 to numFlds
if srt$(i) <> "" then orderBy$ = orderBy$ + srt$(i)
next i
orderBy$ = " ORDER BY ";mid$(orderBy$,2)
goto [list]
' -------------------------------------------
' Multiple Linear Regression
' -------------------------------------------
[mlr]
v = 0
dim srt$(numFlds)
flds$ = ""
for i = 1 to numFlds
a$ = lower$(#request get$(fldName$(i)))
a = val(a$)
if a <> 0 then
if srt$(a) <> "" then
print "Sequence ";a;" already used"
wait
end if
srt$(a) = fldName$(i)
v = v + 1
end if
next i
for i = 1 to numFlds
if srt$(i) <> "" then
flds$ = flds$ + "," + srt$(i)
if i = v then
x$ = " D"
else
x$ = "Ind"
end if
print x$;"ependent Variable ";srt$(i)
end if
next i
v = v -1
if v < 2 then
print "Must have at least 2 independent variables"
wait
end if
sql$ = "SELECT ";mid$(flds$,2);" FROM ";tblName$ + where$
#sql execute(sql$)
rows = #sql ROWCOUNT() 'Get the number of rows
n = rows
30 print "Number of points:";n
dim x(n + 2)
dim s(n + 1)
dim t(n + 1)
dim a(n + 1, n + 2)
print "Number of known variables:";v
if v > n then
print "Number of variables cannot exceed the number of known points"
goto 30
end if
x(1) = 1
for i = 1 to n
result$ = #sql nextrow$(" |")
'print i;" ";
for j = 1 to v
x(j+1) = val(word$(result$,j,"|"))
'print j;" ";x(j +1);" ";
next j
x(v+2) = val(word$(result$,v+1,"|"))
'print x(v+2)
' Populate a matrix to be used in curve fitting
for k = 1 to v + 1
for l = 1 to v + 2
a(k,l) = a(k,l) + x(k) * x(l)
s(k) = a(k,v + 2)
next l
next k
s(v + 2) = s(v + 2) + x(v + 2) ^ 2
next i
' ----------------------------------------------
' fit curve by solving
' the system of linear equations in matrix a()
' ----------------------------------------------
for i = 2 to v + 1
t(i) = a(1,i)
next i
for i = 1 to v + 1
j = i
[a300]
if a(j,i) <> 0 then goto [a340]
j = j + 1
if j <= v + 1 then goto [a300]
print "No unique solution"
input "Continue ";x$
goto [list]
[a340]
for k = 1 to v + 2
b = a(i,k)
a(i,k) = a(j,k)
a(j,k) = b
next k
z = 1 / a(i,i)
for k = 1 to v + 2
a(i,k) = z * a(i,k)
next k
for j = 1 to v + 1
if j <> i then
z = 0 - a(j,i)
for k = 1 to v + 2
a(j,k) = a(j,k) + z * a(i,k)
next k
end if
next j
next i
print "Equation coefficients"
print " Constant = ";a(1,v + 2)
for i = 2 to v + 1
print "Variable(";i - 1;") ";word$(flds$,i,",");" = ";a(i,v + 2)
next i
p = 0
for i = 2 to v + 1
p = p + a(i,v + 2) * (s(i) - t(i) * s(1) / n)
next i
r = s(v + 2) - s(1) ^ 2 / n
z = r - p
l = n - v - 1
print
i = p / r
i = abs(i)
print "Coefficent of determination (r^2) = ";i
print "coefficient of multiple correlation = ";sqr(i)
on error goto [mlrErr]
print "standard error of extimate = ";sqr(abs(2 / l))
' Estimate depent variable from entered independent variables
[inpLoop]
print "Interpolation (0 to end)"
p = a(i,v + 2)
for j = 1 to v
print "value of variable ";j;" ";word$(flds$,j+1,",")
input x
if x = 0 then goto [list]
p = p + a(j + 1,v + 2) * x
next j
print "Dependent variable "; word$(flds$,v +2,",");" = ";p
print
goto [inpLoop]
' error message division by zero
[mlrErr]
print chr$(7);" Invalid data - division by zero"
input "Continue ";x$
goto [list]
' ------------------------------------
' get exactly 2 user input
' points for analysis
' ------------------------------------
[get2pt]
dim srt$(numFlds)
flds$ = ""
n = 0
for i = 1 to numFlds
a$ = lower$(#request get$(fldName$(i)))
a = val(a$)
if a > 0 then
srt$(a) = fldName$(i)
n = n + 1
a$ = "Field ";fldName$(i);" Selected for "
if n = 1 then
print a$;"X"
else
print a$;"Y"
end if
end if
next i
if n <> 2 then
print "Need exactly 2 points for X and Y in Linear Regression"
RETURN
end if
for i = 1 to numFlds
if srt$(i) <> "" then
flds$ = flds$ + "," + srt$(i)
end if
next i
RETURN
' ------------------------------
' linear regression
' ------------------------------
[lenr]
print "Linear Regression"
gosub [get2pt]
if n <> 2 then
input "Continue:";a$
goto [list]
end if
j = 0
k = 0
l = 0
m = 0
r2 = 0
' ------ sql select coordinate points
sql$ = "SELECT ";mid$(flds$,2);" FROM ";tblName$ + where$
#sql execute(sql$)
rows = #sql ROWCOUNT() 'Get the number of rows
n = rows
print "Number of points:";n
for i = 1 to n
result$ = #sql nextrow$(" |")
x = val(word$(result$,1,"|"))
y = val(word$(result$,2,"|"))
j = j + x
k = k + y
l = l + x ^ 2
m = m + y ^ 2
r2 = r2 + x * y
next i
' --- compute curve coefficient
b = (n * r2 - k * j) / (n * l - j ^2)
a = (k - b * j) / n
print "f(x) = ";a;" + (";b;" * x)"
' --- compute regression analysis
j = b * (r2 - j * k / n)
m = m - k ^ 2 / n
k = m - j
on error goto [lpErr]
r2 = j / m
print "Coefficient of Determination (r^2) = ";r2
print "Coefficient of Correlation = ";sqr(r2)
on error goto [lpPoints]
print "Standard error of estimate = ";sqr(k / (n-2))
print
print "Interpolation (enter 0 to end)"
[lpLoop]
input "Enter value of x";x
if x = 0 then goto [list]
print "Estimate for y = ";a + b * x
print
goto [lpLoop]
[lpPoints]
print "Need more than 2 points to calculate standard error of estimate"
wait
' --- division errors
[lpErr]
print "Coefficient of determination and coefficient of correlation"
print "Cannot be determined"
wait
' --------------------------------------
'-=-=-=-=-=' Curvilinear Interpolation
' --------------------------------------
[cint]
print "Curvilinear Interpolation"
gosub [get2pt]
if n <> 2 then
input "Continue:";a$
goto [list]
end if
sql$ = "SELECT ";mid$(flds$,2);" FROM ";tblName$ + where$
#sql execute(sql$)
rows = #sql ROWCOUNT() 'Get the number of rows
n = rows
on error goto [cintErr]
print "Number of samples ";n
dim x(n)
dim y(n)
for i = 1 to n
result$ = #sql nextrow$(" |")
x(i) = val(word$(result$,1,"|"))
y(i) = val(word$(result$,2,"|"))
next i
[cintLoop]
input "Intepolate x = ";a
if a = 0 then goto [list]
b = 0
for j = 1 to n
t = 1
for i = 1 to n
if x(j) <> x(i) then t = t * (a - x(i)) / (x(j) - x(i))
next i
b = b + t * y(j)
next j
print "Result y = ";b
goto [cintLoop]
[cintErr]
print "** Value too large for curvilinear Interpolation calculation"
goto [cintLoop]
' ----------------------------
' Group by
' ----------------------------
[grup]
group$ = "g" ' group by switch
numRecords = 0
goto [sort]
' ---------------------------------------------
' User Search screen
' Change srchFields$ for allowed search fields
' ---------------------------------------------
[src]
where$ = ""
an$ = ""
for i = 1 to numFlds
a$ = trim$(#request get$(fldName$(i)))
if a$ <> "" then
nt$ = ""
not$ = ""
if left$(a$,1) = "!" then
a$ = mid$(a$,2)
nt$ = "!"
not$ = " NOT "
end if
if left$(a$,1) = "*" or right$(a$,1) = "*" then ' LIKE condition
if left$(a$,1) = "*" then a$ = "%" + mid$(a$,2)
if right$(a$,1) = "*" then a$ = left$(a$,len(a$)-1) + "%"
where$ = where$ + an$ + fldName$(i) + not$;" LIKE ('";a$;"')"
an$ = " AND "
else
cond$ = left$(a$,1)
a$ = mid$(a$,2)
if instr("=><",cond$) = 0 then
print "Search condition must have a condition of :*x ends x,x* begins x,*x* has x,= equal,< less than,> greater than."
print " And may be preceded with ! for Not condition"
input "Continue";y$
wait
end if
where$ = where$ + an$ + fldName$(i);" ";nt$;cond$;" '";a$;"'"
end if
end if
next i
if where$ <> "" then where$ = " WHERE " + where$
numRecords = 0
goto [list]
' ----------------------------
' They want Lines per page
' ----------------------------
[doLpp]
if lpp = 0 then lpp = 20
lpp = min(10,lpp)
goto [list]
' ----------------------------
' They want next page
' ----------------------------
[doNext]
lastPageNum = val(EventKey$)
pageNum = val(#pageNum contents$())
if lastPageNum = pageNum then pageNum = pageNum + 1
goto [list]
' ----------------------------
' They want prev page
' ----------------------------
[doPrev]
lastPageNum = val(EventKey$)
pageNum = val(#pageNum contents$())
if lastPageNum = pageNum then pageNum = pageNum - 1
if pageNum < 1 then pageNum = 1
goto [list]
' ============================================
' List Heading
' ============================================
[hdng]
' ---------------------------------------
' Did they change the lines per page lpp
' ---------------------------------------
x = #lpp ISNULL()
if x = 0 then lpp = val(#lpp contents$())
pageNum = max(1,pageNum) ' make user it has a page number
if lpp < 1 then lpp = 30 ' lines per page must be specified
lpp = max(5,lpp) ' make sure it has a least 5 lines per page
lpp = min(100,lpp) ' don not allow over 100 lines per page
totPages = int(numRecords / lpp)
if lpp * totPages <> numRecords then totPages = totPages + 1
pageNum = min(totPages,pageNum)
pageNum = max(1,pageNum)
limitBeg = (pageNum * lpp) - lpp 'limit begin value
dispLine = 0
limit$ = " LIMIT " ; limitBeg ; "," ; lpp
html bf$;"<TABLE BORDER=1 CELLPADDING=0 CELLSPACING=0 WIDTH=100% BGCOLOR=";clrHdr$;">"
html "<TR>"
html "<TD ALIGN=center><A title='Load new Database'>"
button #lod, "Load", [load]
html "</A></TD>"
html "<TD ALIGN=center><A title='Import from Spreadsheet'>"
button #csvi, "CSVin", [csvi]
html "</A></TD>"
html "<TD ALIGN=center><A title='Export to Spreadsheet'>"
button #csvo, "CSVout", [csvo]
html "</A></TD>"
html "</TD><TD ALIGN=center><A title='Exit the program'>"
button #exit, "Exit",[doExit]
html "</A></TD><TD>Records:";numRecords
html "</TD><TD>Pages:";totPages
html "</TD><TD ALIGN=right><A title='Go to previous page'>"
button #prev, "Prev",[doPrev]
#prev setkey(pageNum)
html "</A></TD><TD width=2%>"
TEXTBOX #pageNum, pageNum,2
html "</TD><TD><A title='Go to the next page'>"
button #next, "Next",[doNext]
#next setkey(pageNum)
html "</A><TD ALIGN=right><A title='Lines Per Page'>"
button #lpp, "Lpp",[doLpp]
html "</A></TD><TD align=left>"
TEXTBOX #lpp, lpp,2
html "</TD><TD>";orderBy$;groupBy$
if sumAvg$ <> "" then html "<BR>";sumAvg$
html "</TD><TD>";where$;"</TD></TR></TABLE>"
html "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 ><TR><TD BGCOLOR=pink name='errMsg' id='errMsg'></TD></TR></TABLE>"
RETURN
' -------------------------------------------
' CSV
' -------------------------------------------
[csvo] ' CSV output
outf$ = DefaultDir$;"\public\";tblName$;".csv"
msg$ = "output to ";DefaultDir$;">public>";tblName$
html "<script> document.getElementById('errMsg').innerHTML = '";msg$;"';</script>"
print outf$
open outf$ for output as #1
sql$ = "SELECT * FROM ";tblName$;" ";where$;" ";orderBy$
#sql execute(sql$)
rows = #sql ROWCOUNT() 'Get the number of rows
for i = 1 to rows
a$ = #sql nextrow$(chr$(251))
a$ = strRep$(a$,chr$(34),"'") ' make dbl quotes single quotes
a$ = strRep$(a$,chr$(251),chr$(34);",";chr$(34)) ' standard CSV seperator
print #1,chr$(34);a$;chr$(34)
next i
close #1
wait
[csvi]
upload "Select CSV file"; csv$
if csv$ = "" then wait
open csv$ for input as #1
on error goto [csvErr]
while EOF(#1) = 0
line input #1, a$
a$ = dblQuote$(a$)
a$ = strRep$(a$,chr$(34),"'")
a$ = dblQuote$(a$)
sql$ = "INSERT INTO ";tblName$;" VALUES(";a$;")"
#sql execute(sql$)
wend
wait
[sqlErr]
print "** ERROR ** Something wrong with SQL command"
print sql$
wait
[csvErr]
errMsg$ = "** ERROR ** Either the fields do not match the tale or there are duplicate keys"
html "<script> document.getElementById('errMsg').innerHTML = '";errMsg$;"';</script>"
errMsg$ = ""
wait
' -----------------------------------------
' Get outta here
' -----------------------------------------
[doExit]
cls
print "Good Bye!"
end
' --------------------------------
' string replace rep str with
' --------------------------------
FUNCTION strRep$(str$,rep$,with$)
ln = len(rep$)
ln1 = ln - 1
i = 1
while i <= len(str$)
if mid$(str$,i,ln) = rep$ then
strRep$ = strRep$ + with$
i = i + ln1
else
strRep$ = strRep$ + mid$(str$,i,1)
end if
i = i + 1
WEND
END FUNCTION
' -----------------------------------------
' 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