### 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