LB5 SQLite maintenance code generator

[meerkat]

When I write a system using a database, I always need some way to maintain the tables. And I always want something to list, drill down, sort, add, change, and delete. So I keep writing the same routine over and over for each table. Even a small database with only about 10 or 15 tables requires a program for just about every table.

So.. the answer was to write a single program that creates the maintenance.

The following program generates LB5 code to maintain SQLite tables.

The program requests a database and selected table. It generates the LB5 code.

The program list the data in a grid. Click a line on the grid and it gives you the detail.
You can add, change, or delete the entry.
You can clear the detail and create your own addition.
You can use the detail to create drill downs. Drill downs allow wild card searches. For example if you enter "CA" in the state, and "*berg" in the last name, and "d*" in the first name the system will find all records that have a state equal to "CA" and a last name that ends with "berg" and a first name that begins with "d*".
You can sort on multiple columns. Enter the sequence of the sort for each field. If you enter "1" in the last name, and "2" in the first name and "3d" in the state, the system will sort by last name, first name, and descending state.

This is fresh off the press so there may be errors. Let me know:


' -------------------------------------------------

' Supply database and table name

' -------------------------------------------------

[getDb]

filedialog "Find a Database File", "*.db", db$

if db$ = "" then

notice "No file selected. Thank you and have a great day!"

end

end if



' --------------------------------

' see if the file is sqlite format

' --------------------------------

open db$ for input as #1

lof = min(lof(#1),15)

a$    = lower$(input$(#1,lof))

close #1

if left$(a$,13) <> "sqlite format" then ' check file format

notice db$;" ** Not SQLite file format **";a$

end

end if



' ----------------------------------------

' get tabel names from DB for selection

' ----------------------------------------

sqliteconnect    #sql,  db$  ' Connect to the DB

sql$ = "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name"

#sql execute(sql$)

rows = #sql ROWCOUNT() 'Get the number of rows

dim tblList$(rows)

for i = 1 to rows

#row = #sql #nextrow()

tblList$(i) = #row name$()

next i

listbox #tbl.list, tblList$(), [tblSel], 5, 35, 200, 50+rows*8

button  #tbl.ex "Exit",     [tblEx], UR, 15, 5

WindowWidth = 270 : WindowHeight = 100 + rows*12

open "Select a Table" for window as #tbl

wait



[tblSel]

tblName$ = #tbl.list selection$() ' what was selected



[tblEx]

close #tbl

if tblName$ = "" then

#sql disconnect()

end

end if



' -----------------------------------------

' names and number of columns

' -----------------------------------------

sql$ = "SELECT * FROM ";tblName$;" LIMIT 1"

#sql execute(sql$)

colNames$ = #sql columnnames$()

colLen = 0

j = 0

for numFlds = 1 to len(colNames$)

j = instr(colNames$,",",j+1)

if j = 0 then exit for

colLen = max(colLen,len(word$(colNames$,numFlds,",")))

next numFlds



' -------------------------------------------

' names types and sizes of fields in a table

' -------------------------------------------

maxSize = 0

maxFld = 0

sql$ = "PRAGMA table_info("+tblName$+")" ' returns cid|name|type|notnull|dflt_value|pk

#sql execute(sql$)

rows = #sql ROWCOUNT() 'Get the number of rows

numFlds = rows

dim fldName$(numFlds)

dim fldType$(numFlds)

dim fldSize$(numFlds)

dim fldDecm$(numFlds)

colNames$ = ""

fldTypes$ = ""

cma$ = ""

for i = 1 to numFlds

result$ = #sql nextrow$(" |")

fldName$(i) = word$(result$,2," |")

ln = len(fldName$(i))

maxSize = max(maxSize,ln)

colNames$ = colNames$ + cma$ + fldName$(i)

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"

cma$ = ","

maxFld = max(maxFld,val(fldSize$(i)))

print i,fldName$(i),fldType$(i),fldSize$(i),maxFld

next i



' --------------------------------------------------------

' get max widths of data on file for each column

' and force it between 2 and 12 characters

' --------------------------------------------------------

x$ = strRep$(colNames$,",",")),max(length(")

sql$ = "SELECT max(length("+x$+")) FROM ";tblName$

#sql execute(sql$)

rows = #sql ROWCOUNT() 'Get the number of rows

if rows < 1 then ' if no data, use the size of the fields instead of data size

result$ = ""

for i = 1 to numFlds

result$ = result$ + "," + fldSize$(i)

next i

result$ = mid$(result$,2) ' get rid of comma

else

result$ = #sql nextrow$(",")

end if

dim colWid(numFlds)

colWid$ = ""

cma$ = ""

totWid = 0

for i = 1 to numFlds

colWid(i) = min(12,max(2,val(word$(result$,i,",")))) ' force width between 2 and 12

colWid$ = colWid$ + cma$ + str$(colWid(i)* 10) ' adjust for pixels

totWid = totWid + colWid(i) * 10

cma$ = ","

next i



open "c:\LB5\";tblName$;".bas" for output as #f



print #f, "numFlds = ";numFlds;" ' number of columns"

print #f, "tblName$ = """;tblName$;""""

print #f, "dim  gridData$(numFlds + 1,lpp)"

print #f, "dim srt$(numFlds) ' sort selections"

print #f, "fldNames$ = """;colNames$;""""

print #f, "fldtypes$ = """;fldTypes$;""""

print #f, "WindowWidth = 1400"

print #f, "WindowHeight = 800"

print #f, "UpperLeftX = (DisplayWidth-WindowWidth) / 2"

print #f, "UpperLeftY = (DisplayHeight-WindowHeight) / 2"

print #f, "' col row wid hig"

print #f, "button     #w.BTadd, ""Add"", [add], UL,   100,010,040,020"

print #f, "button     #w.BTchg, ""Chg"", [chg], UL,   142,010,040,020"

print #f, "button     #w.BTdel, ""Del"", [del], UL,   184,010,040,020"

print #f, "button     #w.BTclr, ""Clr"", [clr], UL,   226,010,040,020"

print #f, "button     #w.BTsch, ""Srch"", [srch], UL,   268,010,040,020"

print #f, "button     #w.BText, ""Exit"", [exit], UL,   310,010,040,020"

col$ = right$("000";str$(maxSize * 10 + 10),3)

print #f, "button     #w.BTsrt, ""Sort"", [sort], UL,   ";col$;",040,040,020"



gridCol = maxFld * 10 + maxSize * 10 + 40

print #f, "statictext #w.gdHdr, ""Database:";db$;""", ";gridCol + 150;",002,";max(totWid,800);",20"



print #f, "button     #w.BTpre, ""Prev"", [pre], UL, ";gridCol;",020,040,020"

print #f, "textbox    #w.pge, ";gridCol + 40;",016,040,020"

print #f, "button     #w.BTnxt, ""Next"", [nxt], UL, ";gridCol + 80;",020,040,020"

print #f, "statictext #w.STrec, ""Records: 0"", ";gridCol + 200;",020,300,020"

print #f, "statictext #w.STtbl, ""Table:";tblName$;""", ";gridCol + 500;",020,200,020"



x$ =      "grid       #w.grid, gridData$(),   [gridData], ";gridCol;",040,";totWid;",520"

print #f, x$



' --------------------------------------

' set up fields with caption

' --------------------------------------

row = 60

n = 0

col$ = right$("000";str$(maxSize * 10 + 40),3)

for i = 1 to numFlds



row$ = right$("000";str$(row),3)

wid$ = right$("000";maxSize * 10,3)

print #f, "statictext #w.ST";fldName$(i);", """;align$(fldName$(i),maxSize,"r");""", 010,";row$;",";wid$;",020"



wid$ = right$("000";val(fldSize$(i)) * 10,3)



if fldType$(i) = "TEXT" then

x$ = "texteditor #w.TB";fldName$(i);", ";col$;",";row$;",";wid$;",080"

row = row + 80

else

x$ = "textbox    #w.TB";fldName$(i);", ";col$;",";row$;",";wid$;",020"

row = row + 20

end if



print #f, x$



next i



' -------------------------------------

' display the sort order selections

' -------------------------------------

print #f, "' ----------- Sort Selection area -------------"

row = 60

col$ = right$("000";str$(maxSize * 10 + 10),3)

wid$ = "030"

for i = 1 to numFlds

row$ = right$("000";str$(row),3)

x$ = "textbox    #w.SRT";fldName$(i);", ";col$;",";row$;",";wid$;",020"

print #f, x$

if fldType$(i) = "TEXT" then

row = row + 80

else

row = row + 20

end if

next i



' -------------------------------------------------

' open the window with grid

' and set up font

' -------------------------------------------------

x$ = "open ";chr$(34);tblName$;chr$(34);" for window as #w"

print #f, x$



cw$ = "70,"

cn$ = ""

cma$ = ""

sep$ = chr$(34);"rowid";chr$(34);",";chr$(34)

for i = 1 to numFlds

fn$ = left$(fldName$(i),colWid(i))

cn$ = cn$ + sep$ + align$(fn$,colWid(i),"c")

cw$ = cw$ + cma$ + str$(colWid(i) * 10)

sep$ = chr$(34);",";chr$(34)

cma$ = ","

next i



x$ = "#w.grid columnnames(";cn$;chr$(34);")"

print x$

print #f, x$

x$ = "#w.grid columnwidths(";cw$;")"

print x$

print #f, x$



x$ = "print #w, ""font Courier New 10 bold"""

print #f, x$

print #f, ""

print #f, "' ----- set some start stuff and get number of records -----------"

print #f, "pageNum = 0 ' start with page one"

print #f, "lpp = 30 ' num of lines per page"

print #f, "sqliteconnect    #sql, """;db$;"""  ' Connect to the DB"

print #f, "gosub [numRecs]"

print #f, "goto [nxt]"



print #f, ""

print #f, "' -------------------------"

print #f, "' delete record "

print #f, "' -------------------------"

print #f, "[del]"

print #f, "confirm ""Are you sure you want to delete rowid:""+rowid$; answer$"

print #f, "if answer$ = ""no"" then wait "

print #f, "sql$ = ""DELETE FROM ";tblName$;" WHERE rowid = "";rowid$"

print #f, "#sql execute(sql$)"

print #f, "ap = 0"

print #f, "goto [pageIt]"



print #f, ""

print #f, "' -------------------------"

print #f, "' add record "

print #f, "' -------------------------"

print #f, "[add]"

print #f, "gosub [getData]"

print #f, "ff$ = """""

print #f, "vv$ = """""

print #f, "cma$ = """""

print #f, "sep$ = """""

print #f, "for i = 1 to numFlds"

print #f, " f$ = word$(flds$,i,chr$(251))"

print #f, " v$ = word$(vals$,i,chr$(251))"

print #f, " if v$ = chr$(251) then v$ = """" "

print #f, "ff$ = ff$ + cma$ + f$ "

print #f, "vv$ = vv$ + sep$ + v$ "

print #f, "cma$ = "","" "

print #f, "sep$ = ""','"" "

print #f, "next i"

print #f, "sql$ = ""INSERT INTO ";tblName$;" ("";ff$;"") VALUES ('"";vv$;""')"" "

print #f, "on error goto [gotError]"

print #f, "#sql execute(sql$)"

print #f, "gosub [numRecs]"

print #f, "ap = 0"

print #f, "goto [pageIt]"



print #f, ""

print #f, "' -------------------------"

print #f, "' Error Handler "

print #f, "' -------------------------"

print #f, "[gotError]"

print #f, "notice ""Error:"" + chr$(13) + Err$ + chr$(13) + ""Error number is "";Err"

print #f, "wait"



print #f, ""

print #f, "' -------------------------"

print #f, "' change record "

print #f, "' -------------------------"

print #f, "[chg]"

print #f, "gosub [getData]"

print #f, "sql$ = """""

print #f, "cma$ = """""

print #f, "for i = 1 to numFlds"

print #f, " f$ = word$(flds$,i,chr$(251))"

print #f, " v$ = word$(vals$,i,chr$(251))"

print #f, " if v$ = chr$(251) then v$ = """" "

print #f, " sql$ = sql$ + cma$ + f$;"" = '"";v$;""'"""

print #f, " cma$ = "","";chr$(13)"

print #f, "next i"

print #f, "sql$ = ""UPDATE "";tblName$;"" SET "" + sql$ + "" WHERE rowid = "";rowid$"

'print #f, "print sql$"

print #f, "#sql execute(sql$)"

print #f, "ap = 0"

print #f, "goto [pageIt]"





print #f, "' --------------------------------------"

print #f, "' get outta here "

print #f, "' --------------------------------------"

print #f, "[exit]"

print #f, "#sql disconnect()"

print #f, "end"



print #f, "' --------------------------------------"

print #f, "' get screen data "

print #f, "' --------------------------------------"

print #f, "[getData]"

print #f, "flds$ = """""

print #f, "vals$ = """""

print #f, "sep$ = """""

print #f, "for i = 1 to numFlds"

print #f, " a$ = word$(fldNames$,i,"","")"

print #f, " x$ = eval$(""#w.TB"";a$;"" contents$()"")"

print #f, " x$ = eval$(""#w.TB"";a$;"" contents$()"")"

print #f, " x$ = dblQuote$(strip$(x$))"

'print #f, " if trim$(x$) <> """" then "

print #f, " flds$ = flds$ + sep$ + a$"

print #f, " vals$ = vals$ + sep$ + x$"

print #f, " sep$ = chr$(251)"

'print #f, " end if"

print #f, "next i"

print #f, "vals$ = vals$ + sep$"

'print #f, "print ""flds:"";flds$"

'print #f, "print ""vals:"";vals$"

print #f, "RETURN"



print #f, "' --------------------------------------------------"

print #f, "' Get rowid from grid for detail record display"

print #f, "' --------------------------------------------------"

print #f, "[gridData]"

print #f, "xy$ = #w.grid cellxy$()"

print #f, "if val(word$(xy$,1,"" "")) <> 0 then "

print #f, " val$ = #w.grid value$() 'contents of cell clicked"

print #f, "else "

print #f, " xy$ = ""1 1"""

print #f, "end if"

print #f, "r = val(word$(xy$,2))"

print #f, "#w.grid selectxy(1,r) 'col 1 is rowid"

print #f, "rowid$ = #w.grid value$() 'rowid of row clicked"

print #f, "sql$ = ""SELECT * FROM ";tblName$;" WHERE rowid = "";rowid$"

print #f, "#sql execute(sql$)"

print #f, "rows = #sql ROWCOUNT() 'Get the number of rows"

print #f, "if rows < 1 then "

print #f, " notice ""Record not on file"""

print #f, " wait"

print #f, "end if"

print #f, "#row = #sql #nextrow()"

print #f, "'-----------------------"

print #f, "' show record detail"

print #f, "'-----------------------"

for i = 1 to numFlds

print #f, "print #w.TB";fldName$(i);", #row ";fldName$(i);"$()"

next i

print #f, "wait"



' -------------------------------------------------

' drill down and  search

' -------------------------------------------------

print #f, ""

print #f, "' --------------------------------------"

print #f, "' Drill down search "

print #f, "' --------------------------------------"

print #f, "[srch]"

print #f, "gosub [getData]"

print #f, "search$ = """""

print #f, "aand$ = """""

print #f, "for i = 1 to numFlds"

print #f, " fld$ = trim$(word$(flds$,i,chr$(251)))"

print #f, " val$ = trim$(word$(vals$,i,chr$(251)))"

print #f, " if val$ <> chr$(251) then "

print #f, " if  left$(val$,1) = ""*"" then val$ = ""%"" + mid$(val$,2) "

print #f, " if right$(val$,1) = ""*"" then val$ = left$(val$,len(val$) -1) + ""%"" "

print #f, " if left$(val$,1) = ""%"" or right$(val$,1) = ""%"" then "

print #f, " search$ = search$ + aand$ + fld$ + "" like '"" + val$ + ""'"" "

print #f, " else"

print #f, " search$ = search$ + aand$ + fld$ + "" = '"" + val$ + ""'"" "

print #f, " end if"

print #f, " aand$ = "" AND """

print #f, " end if "

print #f, "next i"

print #f, "if search$ <> """" then search$ = "" WHERE "" + search$ "

'print #f, "print search$"

print #f, "gosub [numRecs]"

print #f, "pageNum = 0"

print #f, "goto [nxt]"

'print #f, "wait"



' -------------------------------------------------

' set up clear data subroutine

' -------------------------------------------------

print #f, ""

print #f, "' --------------------------------------"

print #f, "' clear screen data "

print #f, "' --------------------------------------"

print #f, "[clr]"

print #f, "gosub [clrData]"

print #f, "rowid$ = """""

print #f, "wait"

print #f, "[clrData]"



for i = 1 to numFlds

if upper$(fldType$(i)) = "TEXT" then

print #f, "print #w.TB";fldName$(i);", ""!cls"" "

else

print #f, "print #w.TB";fldName$(i);", ";chr$(34);chr$(34)

end if

next i

print #f, "RETURN"



print #f, "' ---------------------------------------"

print #f, "' Get sort order"

print #f, "' ---------------------------------------"

print #f, "[sort]"

print #f, "gosub [sortOrd]"

print #f, "ap = 0"

print #f, "goto [pageIt]"

'print #f, "wait"



print #f, "[sortOrd]"

print #f, "orderBy$ = """""

print #f, "j = 0"

print #f, "for i = 1 to numFlds"

print #f, " a$ = word$(fldNames$,i,"","")"

print #f, " x$ = eval$(""#w.SRT"";a$;"" contents$()"")"

print #f, " if x$ <> """" then "

print #f, " j = j + 1"

print #f, " srt$(j) = x$;""  "";chr$(251);a$"

print #f, " end if"

print #f, "next i"

print #f, "if j = 0 then RETURN ' selected nothing to sort"

print #f, "sort srt$(), 1, j   ' get the sort order"

print #f, "cma$ = "" ORDER BY """

print #f, "for i = 1 to j"

print #f, " seq$ = word$(srt$(i),1,chr$(251))"

print #f, " orderBy$ = orderBy$;cma$;tblName$;""."";word$(srt$(i),2,chr$(251))"

print #f, " if instr(seq$,""d"") then orderBy$ = orderBy$ ; "" desc"""

print #f, " cma$ = "","""

print #f, "next i"

'print #f, "print orderBy$"

print #f, "RETURN"





print #f, "' -----------------------------------------------"

print #f, "' How many total records based on your search? "

print #f, "' -----------------------------------------------"

print #f, "[numRecs]"

print #f, "sql$ = ""SELECT count(*) as numRecords FROM ";tblName$;"""; search$"

print #f, "#sql execute(sql$)"

print #f, "#row = #sql #nextrow()"

print #f, "numRecords = #row numRecords()"

print #f, "numPages = numRecords / lpp"

print #f, "numPages = int(numPages + .9)"

print #f, "print #w.STrec, ""Records:"";numRecords;"" Pages:"";numPages"

print #f, "RETURN"



print #f, "' ---------------------------------"

print #f, "' Previous Next or User Page Number"

print #f, "' ----------------------------------"

print #f, "[pre]"

print #f, "ap = -1"

print #f, "goto [pageIt]"

print #f, ""

print #f, "[nxt]"

print #f, "ap = 1"

print #f, ""

print #f, "[pageIt]"

print #f, "prePage = pageNum"

print #f, "pageNum = pageNum + ap"

print #f, "if numRecords < 1 then "

print #f, "    notice ""There are no records to list"" "

print #f, "    wait"

print #f, "end if"

print #f, "totPages = int((numRecords / lpp) + .9)"

print #f, "#w.pge ""!contents? goPageNum$"""

print #f, "if goPageNum$ <> """" then "

print #f, " goPageNum = int(val(goPageNum$))"

print #f, " if goPageNum <> prePage then "

print #f, " if goPageNum > totPages or goPageNum < 1 then "

print #f, " notice ""Page must be between 1 and "";totPages"

print #f, " wait"

print #f, " end if"

print #f, " pageNum = goPageNum"

print #f, " end if"

print #f, "end if"

print #f, "pageNum  = max(1,pageNum) ' make suer it has a page number"

print #f, "if lpp < 1 then lpp = 30 ' lines per page must be specified"

print #f, "lpp = max(5,lpp)     ' make sure it has a least 5 lines per page"

print #f, "lpp = min(60,lpp)     ' don not allow over 60 lines per page"

print #f, ""

print #f, "if lpp * totPages <> numRecords then totPages = totPages + 1"

print #f, "pageNum = min(totPages,pageNum)"

print #f, "pageNum = max(1,pageNum)"

print #f, "limitBeg = (pageNum * lpp) - lpp  'limit begin value"

print #f, "limit$ = "" LIMIT "" ; limitBeg ; "","" ; lpp"

print #f, "goto [nextPage]"



print #f, "' ---------------------------------------"

print #f, "' show a page of table data"

print #f, "' ---------------------------------------"

print #f, "[nextPage]"

print #f, "print #w.pge, pageNum"

print #f, "dim  gridData$(numFlds + 1,lpp)"

print #f, "sql$ = ""SELECT rowid,* FROM ";tblName$;""" ;search$; orderBy$; limit$"

print #f, "#sql execute(sql$)"

print #f, "rows = #sql ROWCOUNT() 'Get the number of rows"

print #f, "for i = 1 to rows"

print #f, " result$ = #sql nextrow$("" "";chr$(251))"

print #f, " for j = 1 to numFlds + 1"

print #f, " x$ = left$(trim$(word$(result$,j,chr$(251))),12)"

print #f, " gridData$(j - 1,i -1) = x$"

print #f, " next j"

print #f, "next i"

print #f, "#w.grid reload()"

print #f, "wait"





print #f, "' -----------------------------------------"

print #f, "' strip junk"

print #f, "' -----------------------------------------"

print #f, "FUNCTION strip$(str$)"

print #f, "strip$ = """""

print #f, "for i = 1 to len(str$)"

print #f, " a$ = MID$(str$,i,1)"

print #f, " a = ASC(a$)"

print #f, " if a > 31 then "

print #f, " if a <  127 then"

print #f, " if a$ <> chr$(39) then "

print #f, " if a$ <> chr$(34) then "

print #f, " strip$ = strip$ + a$"

print #f, " end if"

print #f, " end if"

print #f, " end if"

print #f, " end if"

print #f, "next i"

print #f, "END FUNCTION"



print #f, "' -----------------------------------------"

print #f, "' Convert single quotes to double quotes"

print #f, "' -----------------------------------------"

print #f, "FUNCTION dblQuote$(str$)"

print #f, "i    = 1"

print #f, "qq$  = """" "

print #f, "while (word$(str$,i,""'"")) <> """""

print #f, " dblQuote$   = dblQuote$;qq$;word$(str$,i,""'"")"

print #f, " qq$ = ""''"""

print #f, " i   = i + 1"

print #f, "WEND"

print #f, "END FUNCTION"



close #f

print "----------------- program gen complete ---------"

wait



' ---------------------------------------

' 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



' -------------------------------------

' Align fld$ to left right or center

'  of a given width

' -------------------------------------

function align$(fld$,width,lrc$)

s    =  width - len(fld$)

fld$ = left$(fld$,width)

if s < 1 then

align$ = fld$

else

b$ = space$(width)

if lrc$ = "l" then align$ = fld$;left$(b$,s)

if lrc$ = "r" then align$ = left$(b$,s);fld$

if lrc$ = "c" then align$ = left$(b$,int(s / 2));fld$;left$(b$,int(s / 2) + (s and 1))

end if

end function




[metro]

you went MIA for a while Dan.
I've sent you a PM regarding your last post.

I wish I could test this SQlite Manager but my lb5-349(Linux) wont read files it's obviously

something I'm doing coz no one else has commented.

libertybasiccom.proboards.com/thread/602/lb5-349-test-lof

[meerkat]

It should generate a program that looks something like this. I generated this for a person table.
As you can see it's sorting on lastName,firstName,personNum
I entered page 222 and clicked [Next] to go directly to that page.
I clicked on person number 1290 to see the detail.
You make changes and click [chg] to change the data. Or delete it.
If you change the person number you can add a new person.
You can clear [Clr] the detail to enter a completely new entry..

I'm working on a new Form manager, so forget the one you are using.

[tenochtitlanuk]

This looks very interesting.
I've always meant to get to grips with databases, but chickened out and used a spreadsheet or LB for a flat-form database.
Now I've got to 'get relational'.

I found an example db file on the internet, and the code works as expected- but I had to add a line stating the file length since lof() fails for me in Linux.

Keep us posted!

[meerkat]

Now I've got to 'get relational'.

Life is a lot easier with relational. Even simple things like arrays are sometimes easier with a memory db. Especially if you are adding, changing, ordering, and deleting stuff. Since DB's always keep order with the B-Tree, you never worry about sorting, - it's always in order.

Maybe someone should post some introduction to SQL, with maybe some tricks and tips to help people get started. Basically there are only a few things you need to know like how to insert, change, delete, project, and join.

BTW Does anyone know how to include code and keep it from double spacing??

Good luck.. Have a great day..
Dan

[meerkat]

Thought I'd toss in another example. This is a example of a drill down.
Again it's sorted on lastName,firstName,personNum. if you enter a "d" after the sort number as "2d" it would be descending.

It drills down on all persons with
- last name that ends in "ng"
- first name that begins with "j"
- and has a person number with the number "3" in it somewhere.

[metro]

May 3, 2019 4:00:39 GMT -5 meerkat said:

Now I've got to 'get relational'.

Life is a lot easier with relational. Even simple things like arrays are sometimes easier with a memory db. Especially if you are adding, changing, ordering, and deleting stuff. Since DB's always keep order with the B-Tree, you never worry about sorting, - it's always in order.

Maybe someone should post some introduction to SQL, with maybe some tricks and tips to help people get started. Basically there are only a few things you need to know like how to insert, change, delete, project, and join.

BTW Does anyone know how to include code and keep it from double spacing??

Good luck.. Have a great day..
Dan

You have my vote Dan, all of my DB's are just flat files really.

A few tips on building relationships between tables and how transactions are processed would be great, if y'all  have the time.

I did like your explanation of roll backs in your post in (holy smoke) 2011

runbasic.proboards.com/thread/1545/begin-transaction-commit

[Rod]

BTW Does anyone know how to include code and keep it from double spacing??

There are two kinds of reply/message box on this forum. If you are posting a "Quick Reply" you wont see any options and any code inserted should not be double spaced. If you are adding to a thread there will be two options at the foot of the message box "Preview" and "BBCode" If you are posting code click the "BBCode" link. If you post simply in "Preview" the code gets double spaced.

[metro]

May 3, 2019 3:45:56 GMT -5 tenochtitlanuk said:

- but I had to add a line stating the file length since lof() fails for me in Linux.

Be nice if our creator had time to fix this for lb5-350 alpha

[Alyce Watson]

May 3, 2019 6:09:37 GMT -5 Rod said:

Rod, do you fail to see the options toolbar in the quick reply pane? I  installed an add-on shortly after we moved to this forum and it shows for me.

[Rod]

In quick reply the toolbar is at the top with the usual icons. The tabs that show bottom left are what is missing. But it should not matter since quick reply handles the code correctly.

If you are responding to a thread or editing a reply you get two tabs bottom left, Preview and BBCode. Only BBCode handles the code tags correctly. If there was a way to make BBCode the default instead of Preview that might help but its no hardship really.



This is code pasted between code tags in quick reply. 

'open a window and graphicbox
   WindowWidth = 200
   WindowHeight = 200
   open "Ajusting..." for graphics_nf_nsb as #1
   #1, "home ; down ; posxy w h"
   w=200-2*w : h = 200-2*h
   close #1


[meerkat]

I decided to write the same LB form generator in RB just to see the differences.

There are major differences.
RB I do not have to generate a maintenance program for each database and table. One program is good for all db's and tables.
RB's program is available to anyone on the web you give access to.
Basically, RB lets you lay out your screens in a relative way. LB requires hard entries for each field.  RB gets and puts data to the screen using variables. These variables change for each DB and table. 
Instead of a grid, RB uses tables <table>. Tables allow just about any layout or input you may need.
The RB program itself took hours instead of days.

RB form.




' ***********************************************************

' 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

' ----------------------------------

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'"

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

html "<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>"

button #go, "GO",    [go]

html " "

button #ex, "EXIT",  [exit]

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$ = ""

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," |")

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



' =================================================

' person List

' =================================================

[list]

' ------------------------------------------------

' how many records

' ------------------------------------------------

cls

if numRecords = 0 then

sql$ = "SELECT count(*) as numRecords FROM ";tblName$ + where$

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

button #srt, "Sort", [sort]

button #add, "ADD",  [add]

button #chg, "CHG",  [chg]

button #del, "DEL",  [del]

button #clr, "CLR",  [clr]

button #src, "SRCH", [src]

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



sql$ = "SELECT ";tblName$;".rowid as rowid,";tblName$;".*

FROM ";tblName$ + where$ + 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>"

rowid$ = word$(a$,1,"|")

button #vue, "", [shoDtl]

#vue setkey(rowid$)

html "</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]



' ---------------------------------------------

' User Search screen

'  Change srchFields$ for allowed search fields

' ---------------------------------------------

[src]

where$ = ""

an$ = ""

for i = 1 to numFlds

a$ = #request get$(fldName$(i))

if a$ <> "" then

if left$(a$,1)  = "*" then a$ = "%" + mid$(a$,2)

if right$(a$,1) = "*" then a$ = left$(a$,len(a$)-1) + "%"

if instr(a$,"%") > 0 then

where$ = where$ + an$ + fldName$(i) + " LIKE ('";a$;"')"

else

where$ = where$ + an$ + fldName$(i) + " = '";a$;"'"

end if

an$ = " AND "

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='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>"

button #exit, "Exit",[doExit]

html "</TD><TD>Records:";numRecords

html "</TD><TD>Pages:";totPages

html "</TD><TD ALIGN=right>"

button #prev, "Prev",[doPrev]

#prev setkey(pageNum)

html "</TD><TD width=2%>"

TEXTBOX #pageNum, pageNum,2

html "</TD><TD>"

button #next, "Next",[doNext]

#next setkey(pageNum)

html "<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$;"</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



[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

[Carl Gundel]

May 5, 2019 19:46:56 GMT -5 meerkat said:

I decided to write the same LB form generator in RB just to see the differences.

There are major differences.
RB I do not have to generate a maintenance program for each database and table. One program is good for all db's and tables.
RB's program is available to anyone on the web you give access to.
Basically, RB lets you lay out your screens in a relative way. LB requires hard entries for each field.  RB gets and puts data to the screen using variables. These variables change for each DB and table. 
Instead of a grid, RB uses tables <table>. Tables allow just about any layout or input you may need.
The RB program itself took hours instead of days.

RB form.




' ***********************************************************
' file maintenance
' ***********************************************************

bf$ = "<SPAN STYLE='font-family:Arial; font-weight:700; font-size:12pt'>"

' Set your color scheme here
clrHdr$ = "wheat"  '
clrBkg$ = "#F9E79F"  '

clr0bg$ = "#FCF3CF"  ' Even line color
clr1bg$ = "#FEF9E7"  ' Odd Line color
clrTbl$ = "brown"    ' Table line color

' ----------------------------------
' select a db and get the table
' ----------------------------------
upload "Select Database"; db$
if db$ = "" then end
open db$ for input as #1
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'"
#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$
html "<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>"
button #go, "GO",    [go]
html "  "
button #ex, "EXIT",  [exit]
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$ = ""
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," |")
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

' =================================================
' person List
' =================================================
[list]
' ------------------------------------------------
' how many records
' ------------------------------------------------
cls
if numRecords    = 0 then
sql$ = "SELECT count(*) as numRecords FROM ";tblName$ + where$
#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 bgcolor=";clr1bg$;">"
html "<TR><TD></TD><TD>"
button #srt, "Sort", [sort]
'html "<TD>"
button #add, "ADD",  [add]
button #chg, "CHG",  [chg]
button #del, "DEL",  [del]
button #clr, "CLR",  [clr]
button #src, "SRCH", [src]
html "</TD></TR>"
for i = 1 to numFlds
html "<TR>"
html "<TD bgcolor=";clrHdr$;" align=right>";fldName$(i);"</TD><TD>"
html "<input type='text' name='s";fldName$(i);"' id='s";fldName$(i);"' value='' size=1/>"
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>"

sql$ = "SELECT ";tblName$;".rowid as rowid,";tblName$;".*
FROM ";tblName$ + where$ + 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>"
rowid$ = word$(a$,1,"|")
button #vue, "", [shoDtl]
#vue setkey(rowid$)
html "</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"
'errMsg$= msg$ + "<BR>";sql$
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$)
'print sql$
'input xxx
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
sn$ = "s"+fldName$(i)
a$ = #request get$(sn$)
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]

' ---------------------------------------------
' User Search screen
'  Change srchFields$ for allowed search fields
' ---------------------------------------------
[src]
where$ = ""
an$ = ""
for i = 1 to numFlds
a$ = #request get$(fldName$(i))
if a$ <> "" then
if left$(a$,1)  = "*" then a$ = "%" + mid$(a$,2)
if right$(a$,1) = "*" then a$ = left$(a$,len(a$)-1) + "%"
if instr(a$,"%") > 0 then
where$ = where$ + an$ + fldName$(i) + " LIKE ('";a$;"')"
else
where$ = where$ + an$ + fldName$(i) + " = '";a$;"'"
end if
an$ = " AND "
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='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>"
button #exit, "Exit",[doExit]
#exit setid("exitMe")
#exit cssclass("extBtn")

html "</TD><TD>Records:";numRecords
html "</TD><TD>Pages:";totPages
html "</TD><TD ALIGN=right>"
button #prev, "Prev",[doPrev]
#prev setkey(pageNum)
html "</TD><TD width=2%>"
TEXTBOX #pageNum, pageNum,2
html "</TD><TD>"
button #next, "Next",[doNext]
#next setkey(pageNum)
html "<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$;"</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

[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
Nice.  Web browsers do make it easier to do certain kinds of layout.

[Carl Gundel]

May 3, 2019 6:27:38 GMT -5 metro said:

May 3, 2019 3:45:56 GMT -5 tenochtitlanuk said:

- but I had to add a line stating the file length since lof() fails for me in Linux.

Be nice if our creator had time to fix this for lb5-350 alpha

Done.  

[tenochtitlanuk]

Thanks!