X
-
"New forum" link to discussion thread in place of link in first post: http://forum.powerbasic.com/showthread.php?t=59295
-
Less complicated
Code:#DIM ALL 'create 2-tables, insert records (with binding) and display a relational recordset #INCLUDE "sqlitening.inc" THREADED ts() AS STRING MACRO b(str)=slBuildBindDat(str,"T") FUNCTION PBMAIN AS LONG LOCAL sRow AS STRING slOpen "junk.db3","C" slexe "Create Table if not exists ClientTable(clientkey integer primary key,lastname text) slexe "Create Table if not exists ItemTable (itemkey integer,item text) slexe "Create index if not exists ItemIdx on ItemTable(itemkey)" slexe "Begin Immediate" slexebind "Insert Into ClientTable values(null,?)", b("Klum") sRow = STR$(slGetInsertID) slexebind "insert into ItemTable values(?,?)", CHR$( b(sRow), b("carrot") ) slexebind "insert into ItemTable values(?,?)", CHR$( b(sRow), b("apple") ) slExe "End" ? Rs("Select ItemTable.rowid,lastname,item From ClientTable,ItemTable Where clientkey = itemkey order by item") END FUNCTION FUNCTION Rs(sql AS STRING) AS STRING slSelAry sql,ts(),"Q9" FUNCTION = JOIN$(ts(),$CRLF) END FUNCTION
Leave a comment:
-
No concatenation building string array
slGetArray - returns result string array and counts
slGetArrayShort - shorter version, use parsecount/ubound
Faster than slSelAry when all columns are not needed.
Routines could be modified to examine/massage data while reading which cannot be done using slSelAry.
Much faster than other versions with big recordsets by using JOIN$ instead of concatenation.
Code:#INCLUDE "sqlitening.inc" 'slget.bas FUNCTION PBMAIN () AS LONG LOCAL sArray(),sql, sdelimiter AS STRING LOCAL result,cols,rows AS LONG slOpen "sample.db3","C" slexe "drop table if exists simple" slexe "create table if not exists simple(c1,c2)" slexe "insert into simple values('A','B')" slexe "insert into simple values('C','D')" sql = "select rowid,* from simple limit 20" sdelimiter = "|" '------------------------------------------------------------------- [B] result = slGetArray(sql, sArray(),sdelimiter,cols,rows)[/B] IF result = 0 THEN ? JOIN$(sArray(),$CR),,USING$("cols=# rows=#,",cols,rows) ELSE ? USING$("SQLitening error #",result),,FUNCNAME$ END IF '---------------------------------------------------------------- '---------------------------------------------------------------------- [B]result = slGetArrayShort(sql, sArray(),sdelimiter) [/B]IF result = 0 THEN cols = PARSECOUNT(sArray(1),sdelimiter) rows = UBOUND(sArray) ? JOIN$(sArray(),$CR),,USING$("cols=# rows=#,",cols,rows) ELSE ? USING$("SQLitening error #",result),,FUNCNAME$ END IF END FUNCTION '---------------------------------------------------------------------- FUNCTION slGetArray(sql AS STRING, _ sRowArray() AS STRING, _ sDelimiter AS STRING, _ cols AS LONG, _ rows AS LONG) AS LONG '0 = success else SQLitening error number 'returns data in sRowArray() and number of cols and rows LOCAL colnum AS LONG IF LEN(sql) THEN 'if someting passed slsel sql,0,"E0" 'execute sql, manually check error IF slgeterrornumber THEN 'if error FUNCTION = slgeterrornumber 'return error EXIT FUNCTION 'exit function END IF ELSE 'nothing passed FUNCTION = -14 'return error EXIT FUNCTION 'exit function END IF cols = slGetColumnCount 'get number of columns IF cols = 0 THEN EXIT FUNCTION 'no columns, exit function REDIM sColumn(1 TO cols) AS STRING 'create column array rows = 0 'init rows counter DO WHILE slgetrow 'while rows in recordset INCR rows ' increment row counter IF rows MOD 1000 = 1 THEN REDIM PRESERVE sRowArray(1 TO rows+1000) FOR colnum = 1 TO cols ' column loop sColumn(colnum) = slf(colnum) ' put column into array NEXT ' get next column sRowArray(rows) = JOIN$(sColumn(),sDelimiter) 'add to row array LOOP 'row loop REDIM PRESERVE sRowArray(1 TO rows) 'actual size END FUNCTION '-------------------------------------------------------------------- FUNCTION slGetArrayShort(sql AS STRING, _ sRowArray() AS STRING, _ sDelimiter AS STRING) AS LONG '0 = success else SQLitening error number LOCAL colnum,cols,rows AS LONG IF LEN(sql) THEN 'if someting passed slsel sql,0,"E0" 'execute sql, manually check error IF slgeterrornumber THEN 'if error FUNCTION = slgeterrornumber 'return error EXIT FUNCTION 'exit function END IF ELSE 'nothing passed FUNCTION = -14 'return error EXIT FUNCTION 'exit function END IF cols = slGetColumnCount 'get number of columns IF cols = 0 THEN EXIT FUNCTION 'no columns, exit function REDIM sColumn(1 TO cols) AS STRING 'create column array rows = 0 'init rows counter DO WHILE slgetrow 'while rows in recordset INCR rows ' increment row counter IF rows MOD 1000 = 1 THEN REDIM PRESERVE sRowArray(1 TO rows+1000) FOR colnum = 1 TO cols ' column loop sColumn(colnum) = slf(colnum) ' put column into array NEXT ' get next column sRowArray(rows) = JOIN$(sColumn(),sDelimiter) 'add to row array LOOP 'row loop REDIM PRESERVE sRowArray(1 TO rows)'actual size END FUNCTION
Last edited by Mike Doty; 24 Jul 2015, 11:39 PM.
Leave a comment:
-
3 methods to fill a grid
By column delimiter of 1-dim array
By row delimiter of 1-dim array
By element(column,row) of 2-dim array
Code:#DIM ALL #INCLUDE "sqlitening.inc" ' FUNCTION PBMAIN () AS LONG DIM sArr () AS STRING, sCol() AS STRING LOCAL sql AS STRING slopen "small.db3","C" slexe "drop table if exists t1" slexe "create table if not exists t1 (" +_ "client integer primary key autoincrement ," +_ "firstname TEXT ," +_ "lastname TEXT)" slexe "insert into t1 values(null,'Heidi','Klume') slexe "insert into t1 values(null,'Gary','Beene') slexe "insert into t1 values(null,'Bob','Zale') sql = "select firstname,lastname from t1 order by lastname" slSelAry sql,sArr(),"Q9" '1-dimensional,9=TAB delimiter ? JOIN$(sArr(),$CR),,"All" 'show what we are working with 1 FillGridByColumn(sArr(),$TAB) 'fill by parsed column 2 FillGridByRow (sArr(),$TAB) 'fill by parsed row slSelAry sql,sArr() '2-dimensional, no delimiter 3 FillGridByElement sArr() 'fill by element(col,row) END FUNCTION ' FUNCTION FillGridByColumn(sArr() AS STRING,sDelimiter AS STRING) AS LONG LOCAL r,c,rows,cols AS LONG DIM sColumn() AS STRING rows = UBOUND(sArr) IF rows > 0 THEN cols = PARSECOUNT(sArr(rows),sDelimiter) REDIM sColumn(1 TO cols) FOR r = LBOUND(sArr) TO rows PARSE sArr(r),sColumn(),sDelimiter FOR c = 1 TO cols MSGBOX sColumn(c),,USING$("col (#_,#)",r,c) '<-- fill NEXT NEXT END IF END FUNCTION ' FUNCTION FillGridByRow(sArr() AS STRING,sDelimiter AS STRING) AS LONG LOCAL r,c,rows,cols AS LONG DIM sColumn() AS STRING rows = UBOUND(sArr) IF rows > 0 THEN cols = PARSECOUNT(sArr(rows),sDelimiter) REDIM sColumn(1 TO cols) FOR r = LBOUND(sArr) TO rows PARSE sArr(r),sColumn(),sDelimiter MSGBOX JOIN$(sColumn(),$TAB),,USING$("row #",r) '<-- fill NEXT END IF END FUNCTION ' FUNCTION FillGridByElement(ColRowArray()AS STRING) AS STRING LOCAL Rows, Cols,r,c AS LONG Rows = UBOUND(ColRowArray(2)) Cols = UBOUND(ColRowArray(1)) IF rows > 0 THEN FOR r = 0 TO Rows FOR c = 1 TO Cols MSGBOX ColRowArray(c,r),,USING$("element (#_,#)",r,c) '<-- fill NEXT NEXT END IF END FUNCTION
Last edited by Mike Doty; 2 Jun 2015, 10:09 AM.
Leave a comment:
-
SQLitening corner
Code:'This demonstrates creating tables with _C, _N , or _CN appended to the column 'name so recordset building routine knows how to handle each column.. ' 'This eliminates IF logic for each column and allows a single routine to build 'a recordset no matter what program created the table. ' 'The column names must end _C, _N or _CN to use compression/encryption. 'Working on ways to do the same thing without changing column names. $SelectStatement = "SELECT F3, F2_N, F4_CN, F1_C, RowID from T1" #INCLUDE "sqlitening.inc" 'SetColumnFlag.bas ' SUB SetColumnFlag(sFlagArray() AS STRING) 'Read column names and place "DU", "D" or "U" into an array 'to Decrypt and or Uncompress each related column. 'If a column name ends _CN decrypt and uncompress. "DU" 'if a column name ends _N decrypt "D" 'if column name ends _C uncompress "U" LOCAL COL,Cols AS LONG, sColumnName AS STRING cols = slGetcolumnCount IF Cols THEN DIM sFlagArray(cols) AS STRING FOR COL = 1 TO cols sColumnName = slGetColumnName(COL) IF INSTR(-1, sColumnName,"_CN") THEN 'if compressed encypt sFlagArray(COL) = "DU" ' decrypt uncompress ELSEIF INSTR(-1,sColumnName,"_N") THEN 'if encrypt sFlagArray(COL) = "D" ' decrypt ELSEIF INSTR(-1,sColumnName,"_C") THEN 'if compressed sFlagArray(COL) = "U" ' uncompress END IF NEXT END IF END SUB ' FUNCTION PBMAIN() AS LONG LOCAL x,rows,COL,cols AS LONG LOCAL sData,sColumnName AS STRING LOCAL sArray() AS STRING, sFlag() AS STRING slOpen "sample.db3","C" slexe "drop table if exists T1" 'delete previous data in table '-------------------------------------------------------------------- slexe "Create Table if not exists T1(F1_C,F2_N,F3,F4_CN) '-------------------------------------------------------------------- slSetProcessMods "K" + STRING$(16,"A") 'encryption key 16,24 or 32 bytes FOR x = 1 TO 3 'insert some records slExeBind "insert into T1 values(?,?,?,?)", _ slBuildBindDat("(col1 compressed)","C") +_ slBuildBindDat("(col2 encrypted)","N") +_ slBuildBindDat("(col3 just text)") +_ slBuildBindDat("(col4 comp&encrypt)","CN") NEXT '-------------------------------------------------------------------- slsel $SelectStatement cols = slGetColumnCount IF cols THEN SetColumnFlag sFlag() rows = 0 sData = "" DO WHILE slgetRow INCR rows FOR COL = 1 TO slGetColumnCount IF LEN(sFlag(COL)) THEN sData += slfx(COL,sFlag(COL)) + "," ELSE Sdata += slf(COL) + "," END IF NEXT ASC(sData,LEN(sData)) = 13 'last , to carriage return LOOP END IF ? sData,,"Rows" + STR$(rows) END FUNCTION
Leave a comment:
-
SQLitening quick starter
Each of these 4 examples produce the same result.
Example 1. Create recordset to string looping through each row and column.
Example 2. Create recordset to array
Example 3. Create recordset to string using compression and encryption.
Example 4. Create recordset to array using compression and encryption.
Comments: http://www.powerbasic.com/support/pb...ad.php?t=59295
Code:#INCLUDE "sqlitening.inc" FUNCTION PBMAIN () AS LONG LOCAL sData AS STRING, sArray() AS STRING LOCAL COL,rows AS LONG '-------------------------------------------------------------------------- 'slConnect "",0 'ip address and port for client/server slOpen "sample.db3","C" 'create if it does not exist slexe "drop table if exists simple" slexe "create table if not exists simple(c1,c2)" slexe "insert into simple values('hello','world!')" '-------------------------------------------------------------------------- '[COLOR=red]Example 1. Build recordset to string [/COLOR]slsel "select * from simple" rows = 0 sData = "" DO WHILE slgetRow INCR rows FOR COL = 1 TO slGetColumnCount sData += slf(COL) + "," NEXT ASC(sData,LEN(sData)) = 13 'last , to carriage return LOOP MSGBOX sData,,"Rows" + STR$(rows) '-------------------------------------------------------------------------- [COLOR=red]'Example 2. Build recordset to array [/COLOR]slSelAry("select * from simple",sArray(),"Q44 c") MSGBOX (JOIN$(sArray(),$CR)),,"Rows" + STR$(UBOUND(sArray)) '-------------------------------------------------------------------------- [B]'BOUND DATA EXAMPLES[/B] 'Insert text Compressed and Encrypted TCN parameters slexe "delete from simple" 'delete previous data in table slSetProcessMods "K" + STRING$(16,"A") 'encryption key 16,24 or 32 bytes slExeBind "insert into simple values(?,?)", _ slBuildBindDat("hello","TCN") + _ slBuildBindDat("world!","TCN") [COLOR=red]'Example 3. Build recordset to string Decrypted and Uncompressed[/COLOR] slsel "select * from simple" rows = 0 sData = "" DO WHILE slgetRow INCR rows FOR COL = 1 TO slGetColumnCount sData += slfx(COL,"DU") + "," 'decrypt uncompress NEXT ASC(sData,LEN(sData)) = 13 'last , to carriage return LOOP MSGBOX sData,,"Rows" + STR$(rows) '-------------------------------------------------------------------------- [COLOR=red]'Example 4. Build recordset to array Decrypted and Uncompressed [/COLOR]slSelAry("select * from simple",sArray(),"D1,2 U1,2 Q44 c") MSGBOX (JOIN$(sArray(),$CR)),,"Rows" + STR$(UBOUND(sArray)) END FUNCTION 'Notes: 'D1,2 = Decrypt columns 1,2 'U1,2 = Uncompress columns 1 and 2 'Q44 = delimit columns with a comma ASCII 44 'c = do not include column headings in recordset
Leave a comment: