DB maintenance program for any table

new BookmarkLockedFalling
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

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
sample

' ***********************************************************
' 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
Last Edit: May 14, 2019 12:38:56 GMT -5 by meerkat
metro
Full Member
***

metro Avatar

Posts: 207

Post by metro on May 6, 2019 18:06:55 GMT -5

Thanks for sharing Dan.

Do you use any particular program for designing your databases?
Do you use ERD's at all.
If ya have time can you outline(briefly) your design process.
I'm looking to create a system for recording my stock market trades
and am currently using a spreadsheet. That limits my ability to query the data.

I am in the process of designing on paper at the moment and after a quick google have found some interesting
software to assist with design, just wondered what you use.

Thanks in advance

Laurie
Intel Core2 QUAD CPU @2.54 x 4 Mint Linux 19.3 Mate
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 6, 2019 20:20:54 GMT -5

I really don't use anything unless it's a huge DB. If you just remember "Referential Integrity", you will have most of what you want. For example you could have a stocks table with stockType. Rather than entering anything in the stockType, you may want a stockType file that you can "reference" and join and create drop downs. For a lot of small reference files I use a table called 'xlate' (translate table) that will handle most of the references. It's basically defined as
fieldName vchar(16), ' the reference name
val vchar(2), ' the value
descr vchar(22), ' description
short vchar(10), ' short description - when you need space
def char(1), ' optional [Y]es if default
seq int(3) ' optional if you need to sequence it for drop downs etc
So to join stocks.stockType you use a join:
(LEFT) JOIN xlate as st ON st.fieldName = 'stockType' AND st.val = stocks.stockType
For larger reference files you may want to have separate files.
Such as user file for login and keeping track of who made the entries.
Or maybe company file if you need their information

For the most part I just scratch it out on paper with some notes. Like you, I tried all those DB layout programs without much luck.

I also made some modifications to the above program if you wanna download it again..

Good luck ... Dan
Last Edit: May 7, 2019 19:32:55 GMT -5 by meerkat
metro
Full Member
***

metro Avatar

Posts: 207

Post by metro on May 7, 2019 5:39:41 GMT -5

Thanks Dan,
I've had a tad too much shiraz tonight to outline what it is I need to solve. (ie get my head around)

I have one or two questions regarding using a header Table and a line items table
dealing with debits and credits.

This is causing me some grief trying to work out the best way to handle the outstanding balance
and maybe I need a Master Table to keep the Balance there.

I'll layout what I believe I need in a day or two and ask you a couple of questions if you don't mind.

I do like using LB and only really stopped using RB because of HTTPGET$ not working with https, also the drama trying to get
it working on a 64bit Linux system. I was hoping Carl maybe able to fix httpget$ as I have now setup a 32bit Linux system to run RB.

In frustration I took a look at Python,PHP,Ruby(rails),Java Script and Rebol and have decided to stick with the two Basics I am used to.
Although Rebol is appealing, despite the learning curve.

I will download the code and give a run again.

Thanks for sticking around here.

All the best

Laurie

Intel Core2 QUAD CPU @2.54 x 4 Mint Linux 19.3 Mate
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 7, 2019 8:32:25 GMT -5

Just lay it out using good old common sense. And try to keep it simple (kiss). That always works for me. And with my common sense - how does it ever work?
You'd be surprised at what SQL can handle once you learn some of the stuff they don't tell you about. I bet there is a way to do whatever you want with a simple layout.

I'd be glad to have a look at what you come up with, and show you the SQL to get what you want. I might want to do a stock thing myself.

There may be some javascript somewhere that can read https files.. I'll look around.

Ya.. The frustration with no updates, especially when we know there are problems. Like the 'd' after some numeric values.
And - ok Ya! the DB locks. The DB locking did me in. I knew there would be locks on LB5. At least now there is proof of the lock problem.

For real applications, where I need a working DB interface, I use REBOL. But I've always liked Basic no matter what flavor. If Fuchsia OS becomes a reality, and it looks like it will, then RFO Basic looks really good. It has everything, I like anyway, but it only works on Android now. Fuchsia is posed to handle Windows, linux, and android.. Will be interesting - we will see?

Have a gday.. dan
Last Edit: May 7, 2019 19:31:18 GMT -5 by meerkat
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 9, 2019 9:31:13 GMT -5

I changed the above program listing.

I added the ability to do sums and averages.
I had to add a [grup] button so the program would know what to summarize and average on.
If you use group, you only get one line per group.
Works kinda like the [Sort] button.
- you enter the fields you want to group by in order of your group.
- Enter a "s" in the fields you want sums.
- Enter a "a" in the fields you want averages.
- then click [grup]
For example if you had a item file with
- itemNum
- itemType
- onHand
- onOrder
- price
And you wanted the average price, sum of on hand, and on order for each item type, you enter;
itemType 1
onHand = s
onOrder = s
price = a

Have fun... Dan
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 9, 2019 9:39:23 GMT -5

This is causing me some grief trying to work out the best way to handle the outstanding balance
and maybe I need a Master Table to keep the Balance there.


Laurie,
Not sure exactly what you want.
I assume you have amount owed, and amount paid.
If so all you have to do is select sum(amtOwed - amtPaid) as remaining

HTH
Dan
metro
Full Member
***

metro Avatar

Posts: 207

Post by metro on May 9, 2019 11:24:13 GMT -5

Thanks Dan,
I've been a bit busy the last couple of days.
I've been so successful on the stock market this year I've decided to
To become a Real-estate agent so am doing the course.
I'm gunner specialise in selling blocks of flats to retiree's seems they're
Pretty easy targets.
I maybe the oldest person to ever sit the exam.

I'll try and flesh out my db design this weekend.
Thanks for the interest.





Last Edit: May 9, 2019 11:33:26 GMT -5 by metro
Intel Core2 QUAD CPU @2.54 x 4 Mint Linux 19.3 Mate
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 11, 2019 20:57:02 GMT -5

MLR.. Multiple Linear Regression
Currently you can load and export CSV.
I changed the above db maintenance program to also do MLR.
Enter a sequence number in the fields you want included. The last sequence in the Dependent variable.
You must select at least 3 or more items.
For example if you had a file of people with:
personId
age
height
weight
...
And you entered 1 for age, 2 for height and 3 for weight and click [MLR], it will determine if there is any correlation between age, height and weight.
It produces a formula that you can use to enter age and height and it will give you the predicted weight.

I've only tested it on a few files - but so far so good..

Good luck..
Dan

meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 13, 2019 8:35:09 GMT -5

Linear Regression..
Added Linear Regression to the above program. Select 2 points for x and y.
The program fits a straight line for the given coordinates using the method of least squares. The equation of the line, coefficient of determination, coefficient of correlation, and standard error of estimate are printed. Once the line has been fitted, you may predict values of y for a given value of x.

I tested it using various coordinates from different tables and it seems to work.
If there are problems, let me know..

Dan
meerkat
Senior Member
****

meerkat Avatar

Posts: 250

Post by meerkat on May 14, 2019 8:56:27 GMT -5

Added another analysis tool to do Curvilinear Interpolation. This may not be able to handle large tables, or tables with large numbers.

Search has new options.
You can now search with a comparison sign. The comparison can be *x ends in x,x* begins with x,*x* contains x, = equal, > greater than, < less than.
You can enter the NOT ! befor the comparison as !=, !*
Examples.
!*abc* not contain 'abc'
!abc* not end with 'abc'
!= not equal
!< not less than
Last Edit: May 14, 2019 12:40:14 GMT -5 by meerkat