SQLitening Support Forum

[source]
#INCLUDE "sqlitening.inc"
'Requires Windows 10 Pro

FUNCTION PBMAIN () AS LONG 'NetSend.bas

 LOCAL sUsers,sFile,sData,sMsg AS STRING

 sFile  = "test123.dat"             'must be in FACT or error -9
 sData  = "some data"               'second parameter of slPut

 sUsers = "127.0.0.1"               'receivers of shell(msg.exe)
 slPutFile sFile,sData,"E0"         'slPut using SQLitening
 sMsg   =  sFile + $CR + slGetError 'message for receivers

 NetSendMessage sUsers,sMsg,0       '0=don't timeout on receiver screens

END FUNCTION

SUB NetSendMessage(sComputers AS STRING,BYVAL sMsg AS STRING, SecondsOnScreen AS LONG)
 LOCAL sShell AS STRING
 IF INSTR("-/",LEFT$(TRIM$(sMsg),1)) THEN
  sMsg = WRAP$(sMsg,"[","]") 'TRIM of sMsg started  "-" or "/" or is empty
 END IF

 'Messages are independent of programs
 'They are placed in a queue and only 1 is displayed on receiving computer
 'If Time: (SecondsOnScreen=0) received must click to clear the message off the screen
 'Sending message to all sessions using the "*" may be needed so it automatically insert
 'If first character of message is "/" or "-"  or "" the message wouldn't send, now wrapped within $DQ

 LOCAL x,pid AS LONG
 FOR x = 1 TO PARSECOUNT(sComputers) 'ComputerName, IPAddress, ...
  'put into a string for your testing
  sShell = "msg.exe /server:"+ TRIM$(PARSE$(sComputers,x)) + " * /time:" + FORMAT$(SecondsOnScreen) + " " + sMsg
  'MSGBOX sShell
  pid = SHELL(sShell,0)
 NEXT
END SUB
#IF 0
SEND a message TO a user.

MSG {username | sessionname | sessionid | @filename | *}
    [/SERVER:servername] [/TIME:seconds] [/V] [/W] [message]

  username            Identifies the specified username.
  sessionname         The NAME OF the session.
  sessionid           The ID OF the session.
  @filename           Identifies a file containing a list OF usernames,
                      sessionnames, AND sessionids TO SEND the message to.
  *                   SEND message TO ALL sessions ON specified server.
  /SERVER:servername  SERVER TO contact (DEFAULT IS current).
  /TIME:seconds       Time delay TO wait FOR receiver TO acknowledge msg.
  /V                  DISPLAY information about actions being performed.
  /W                  Wait FOR response FROM USER, useful WITH /V.
  message             Message TO send.  IF NONE specified, prompts FOR it
                      OR reads FROM stdin.
#ENDIF

1. If $Viewfile has a length the output goes to a text file and is displayed using default text viewer.
2. If $Viewfile is remarked, the output goes to the command line environment.
3. All select statements must be terminated with a semi-colon.
4. Backup, clone, import, export, view sql, ...
5. Many commands can be sent at once by separating each semi-colon terminated command with a $CRLF

Example:
sdatabase= "sample.db3"
sheller "select * from parts;" + $CRLF

'SQLite3Sheller -  script processor  6/24/19
'All select statements must be terminated with a semi-colon.
'Many uses; including backup, clone, import, export, view sql, ...

DECLARE FUNCTION ShellExecute LIB "Shell32.dll" ALIAS "ShellExecuteA" ( _
    BYVAL hwnd AS DWORD, lpOperation AS ASCIIZ, lpFile AS ASCIIZ, _
    lpParameters AS ASCIIZ, lpDirectory AS ASCIIZ, BYVAL nShowCmd AS LONG) _
    AS DWORD

$CommandFile="cj.cmd" 'file read by SQLite3.exe
$BatchFile  ="cj.bat" 'file shelled to
'$ViewFile  ="cj.txt" '<---  remark to use cmd.exe or unremark to view .txt file
'=====================================================================================
FUNCTION PBMAIN () AS LONG 'sqlite commands .modes ascii column html insert line list tabs tcl
 LOCAL s,sdatabase AS STRING
 sdatabase= "sample.db3"
 #IF %DEF($ViewFile)
  s=CHR$(".output ",$ViewFile,$CRLF)
 #ENDIF
 s+= CHR$("select '10 records of '||count(*)||' records (.mode tab)' from parts;",$CRLF)
 s+= CHR$(".mode tabs",$CRLF)
 s+= CHR$("select rowid,redref,substr(product,1,40) from parts limit 10;",$CRLF)
 s+= CHR$("select '';",$CRLF)
 s+= CHR$("select '10 records of '||count(*)||' records (.mode csv)' from parts;",$CRLF)
 s+= CHR$(".mode csv",$CRLF)
 s+= CHR$("select rowid,redref,substr(product,1,40) from parts limit 10;",$CRLF)
 sheller sdatabase,s
 #IF %DEF($ViewFile)
  DisplayTextFile $ViewFile
 #ENDIF
END FUNCTION
'=====================================================================================
FUNCTION sheller(sDataBase AS STRING,sCommands AS STRING) AS LONG
 LOCAL stemp AS STRING, h AS LONG
 h = FREEFILE
 OPEN $CommandFile FOR OUTPUT AS #h
 IF ERR THEN ? "Unable to open " + $CommandFile,%MB_SYSTEMMODAL,"Error":EXIT FUNCTION
 PRINT #h,sCommands;
 CLOSE #h
 h = FREEFILE
 OPEN $BatchFile FOR OUTPUT AS #h
 IF ERR THEN ? "Unable to open " + $BatchFile,%MB_SYSTEMMODAL,"Error":EXIT FUNCTION
 stemp = "sqlite3.exe " + sdatabase + " < " + $CommandFile
 PRINT #h,"@cls"
 PRINT #h,"@echo off"
 PRINT #h,stemp
 #IF NOT %DEF($ViewFile) 'viewfile not wanted
  PRINT #h,"pause"      'pause batch file so we can see results
 #ENDIF
 CLOSE #h
 #IF %DEF($ViewFile)
  h = SHELL($BatchFile,0)
 #ELSE
  h = SHELL($BatchFile)
 #ENDIF
END FUNCTION
'=====================================================================================
FUNCTION DisplayTextFile(sFileName AS STRING) AS LONG
 LOCAL zFileName AS ASCIIZ * 257
 zFileName = sFileName
 ShellExecute (0, "OPEN", zFileName, BYVAL 0, CURDIR$, %SW_SHOWNORMAL)
END FUNCTION

Shows how easy it is to display 2-dimensional recordsets in MLG
MLG_PUT hGrid,rownum,colnum,sRecordSet(colnum,rownum),0

Pressing Enter key (at anytime) or clicking Run executes the SQL and fills grid.

Added statusbar 6/22/19  1:39AM CST

Suggestions welcome

MLG can be purchased from Gary Beene gbeene@airmail.net

#PBFORMS CREATED V2.01
'------------------------------------------------------------------------------
#COMPILE EXE    'slMlg.bas
#DIM ALL
GLOBAL ghDlg AS DWORD

#PBFORMS BEGIN INCLUDES
#INCLUDE ONCE "WIN32API.INC"
#PBFORMS END INCLUDES
#INCLUDE ONCE "mlg.inc"
#INCLUDE ONCE "sqlitening.inc"
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDC_GRID      =  100
%GridLabel      = 1010
%TEXT_DATABASE  = 1011
%TEXT_SQL      = 1012
%LBL_DATABASE  = 1013
%LBL_SQL        = 1014
%BTN_RUN        = 1015
%LBL_LABEL1    = 1016
%IDC_STATUSBAR1 = 1017
#PBFORMS END CONSTANTS
#PBFORMS DECLARATIONS
FUNCTION PBMAIN()
  ShowDIALOG1 0
END FUNCTION

SUB Resize
 LOCAL DialogWidth,DialogHeight AS LONG
 LOCAL GridWidth  ,GridHeight  AS LONG
 DIALOG  GET SIZE  ghDlg TO DialogWidth,DialogHeight            'dialog width,height
 CONTROL GET SIZE ghDlg,%IDC_GRID TO GridWidth  ,GridHeight    'grid  width,height
 CONTROL SET SIZE ghDlg,%IDC_GRID,  DialogWidth-14,GridHeight  'set grid width
 CONTROL REDRAW  ghDlg,%IDC_GRID
END SUB

CALLBACK FUNCTION ShowDIALOG1Proc()
 LOCAL DialogWidth,DialogHeight AS LONG
 LOCAL gridwidth,gridheight AS LONG
 LOCAL SelStart,SelEnd AS LONG

  SELECT CASE AS LONG CB.MSG
    CASE %WM_EXITSIZEMOVE
    Resize

    CASE %WM_INITDIALOG
    ghDlg = CB.HNDL
    DIALOG  GET SIZE  ghDlg TO DialogWidth,DialogHeight            'dialog width,height
    CONTROL GET SIZE ghDlg,%GridLabel TO GridWidth ,GridHeight    'label size
    CONTROL SET SIZE ghDlg,%GridLabel,  DialogWidth-14,Gridheight  'set grid width

    CASE %WM_NCACTIVATE
      STATIC hWndSaveFocus AS DWORD
      IF ISFALSE CB.WPARAM THEN
        hWndSaveFocus = GetFocus()
      ELSEIF hWndSaveFocus THEN
        SetFocus(hWndSaveFocus)
        hWndSaveFocus = 0
      END IF

    CASE %WM_COMMAND
      SELECT CASE AS LONG CB.CTL
        CASE %IDC_STATUSBAR1
        CASE %TEXT_DATABASE
        CASE %TEXT_SQL
          IF CB.CTLMSG = %EN_SETFOCUS THEN 'SQL input control got focus
            CONTROL SEND CB.HNDL, %TEXT_SQL,%EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd)
            CONTROL SEND CB.HNDL, %TEXT_SQl,%EM_SETSEL,SelEnd,SelEnd
          END IF

        CASE %BTN_RUN
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            GridFromSQL
            CONTROL SET FOCUS CB.HNDL,%TEXT_SQl
            CONTROL SEND CB.HNDL, %TEXT_SQL,%EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd)
            CONTROL SEND CB.HNDL, %TEXT_SQl,%EM_SETSEL,SelEnd,SelEnd
          END IF
        CASE %IDC_GRID
      END SELECT
  END SELECT
END FUNCTION

FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
  LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
  LOCAL hDlg  AS DWORD

  DIALOG NEW hParent, "", 286, 170, 768, 359, %WS_POPUP OR %WS_BORDER OR _
    %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
    %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_VISIBLE OR %DS_3DLOOK OR _
    %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR, TO hDlg
  CONTROL ADD TEXTBOX,  hDlg, %TEXT_DATABASE, "", 43, 297, 99, 13
  CONTROL ADD TEXTBOX,  hDlg, %TEXT_SQL, "select * from parts limit 5", 42, _
    313, 441, 13
  CONTROL ADD LABEL,    hDlg, %GridLabel, "%GridLabel - Grid will display " + _
    "here", 0, 0, 752, 260
  CONTROL SET COLOR      hDlg, %GridLabel, %WHITE, %BLUE
  CONTROL ADD LABEL,    hDlg, %LBL_DATABASE, "Database", 5, 297, 32, 11
  CONTROL ADD LABEL,    hDlg, %LBL_SQL, "SQL", 5, 315, 23, 10
  CONTROL ADD BUTTON,    hDlg, %BTN_RUN, "Run", 5, 329, 23, 10
  CONTROL ADD LABEL,    hDlg, %LBL_LABEL1, "Press Enter or click Run", 5, _
    277, 324, 10
  CONTROL ADD STATUSBAR, hDlg, %IDC_STATUSBAR1, "Rows 0    Columns 0", 0, 0, _
    0, 0
#PBFORMS END DIALOG
  DIALOG SET TEXT hdlg,EXE.NAME$
  LOCAL Msg AS TagMsg
  LOCAL flag AS LONG  'prevent grid displaying twice when we set focus
  DIALOG SHOW MODELESS hDlg, CALL ShowDIALOG1Proc TO lRslt

  DO WHILE GetMessage(Msg, %NULL, 0, 0)
  IF IsDialogMessage(hDlg, Msg) = %FALSE THEN
    TranslateMessage Msg
    DispatchMessage  Msg
  END IF

  IF msg.wparam = 13 THEN                      'enter pressed in any control
    'DIALOG SET TEXT ghDlg,USING$("ID #  Counter #",GetDlgCtrlID(GetFocus),gCounter)
    IF GetDlgCtrlID(GetFocus) = %TEXT_SQL THEN 'in %TEXT_SQL control?
      IF flag = 0 THEN GridFromSQL              'execute sql and MLG
      flag = flag XOR 1                        'toggle flag
      LOCAL selStart,SelEnd AS LONG
      CONTROL SEND hDlg, %TEXT_SQL,%EM_GETSEL, VARPTR(SelStart), VARPTR(SelEnd)
      CONTROL SEND hdlg, %TEXT_SQl,%EM_SETSEL,SelEnd,SelEnd
    END IF
    CONTROL SET FOCUS hDlg,%TEXT_SQL          'always focus to sql input
  END IF

  LOOP WHILE ISWIN(hDlg)

  FUNCTION = lRslt
END FUNCTION

FUNCTION GridFromSQL AS LONG
 LOCAL rownum,colnum,rows,cols AS LONG
 LOCAL x AS LONG,y AS LONG,gridwidth,gridheight,hGrid AS LONG
 LOCAL s AS STRING
 LOCAL sDatabase AS STRING
 LOCAL sql AS STRING
 LOCAL sRecordSet() AS STRING
 CONTROL GET TEXT ghDlg,%TEXT_DATABASE TO sDatabase
 CONTROL GET TEXT ghDlg,%TEXT_SQL  TO sql

 IF LEN(TRIM$(sDataBase)) = 0 THEN
  sDatabase = "sample.db3"
  sql = "select manuf,redref,product,language,cpu_os,media,type,pgroup,printf('%.2f',price*.01) as PRICE from parts limit 5"
  CONTROL SET TEXT ghDlg,%TEXT_Database,"sample.db3"
  CONTROL SET TEXT ghDlg,%TEXT_SQL,sql
  DIALOG REDRAW ghDlg
 END IF

 slOpen sDatabase,"C E0"  'E0 we will handle open database error
 IF slGetErrorNumber THEN
  ? "Database name: " +  WRAP$(sdataBase,$DQ,$DQ) + $CR + slGetError,%MB_SYSTEMMODAL,"SQL Open"
  EXIT FUNCTION
 END IF

 slSelAry sql,sRecordSet(),"E0"  'E0 we will handle SQL error
 IF slGetErrorNumber THEN
  ? CHR$(slGetError,$CR,"Database name: ",WRAP$(sdataBase,$DQ,$DQ),$CR,$CR,sql),%MB_SYSTEMMODAL,"SQL Error"
  EXIT FUNCTION
 END IF

 rows = UBOUND(sRecordset,2)
 cols = UBOUND(sRecordset,1)
 s = USING$("r#/c#",Rows,cols) 'rows and columns
 CONTROL GET LOC ghdlg,%GridLabel TO x,y
 CONTROL GET SIZE ghdlg,%GridLabel TO gridwidth,gridheight
 CONTROL SHOW STATE ghDlg, %GridLabel, %SW_HIDE 'must hide grid position label
 CONTROL KILL ghDlg,%IDC_GRID                  'start a fresh grid
 CONTROL ADD "MYLITTLEGRID", ghDlg, %IDC_GRID, s, x, y, gridwidth,gridheight, %MLG_STYLE
 CONTROL HANDLE ghDlg, %IDC_GRID TO hGrid
 FOR rownum = 0 TO rows
  FOR colnum = 1 TO cols
  MLG_PUT hGrid,rownum,colnum,sRecordSet(colnum,rownum),0
  NEXT
 NEXT
 slClose
 CONTROL SET TEXT ghDlg,%IDC_STATUSBAR1,USING$("Rows #,    Columns #",rows,cols)
 Resize
END FUNCTION

#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN AS LONG

 LOCAL sql,sArray() AS STRING

 slopen "junk.db3","C"

 slexe "drop table if exists t1"
 slexe "create table if not exists t1(c1 integer)"

 slexe "insert into t1 values(-1000),(-10),(-9),(-1),(0),(1),(9),(10),(100),(1000)"

 sql = "select rowid,"  +_
       " case" +_
       " when c1 > 0 then       ltrim(printf('%.2f',c1*.01),'0')"  +_ 
       " when c1 < 0 then '-'|| ltrim(printf('%.2f',c1*.01),'-0')" +_ 
       " else '.00'" +_
       " end  AS TheValues"+_
       " from t1"

 slSelAry sql,sArray(),"Q9"
 ? JOIN$(sArray(),$CR),,"No leading zero"

END FUNCTION
  

https://www.sqlite.org/lang_vacuum.html#vacuuminto

Not sure how I missed slSelBind.
slSelBind was added a long time ago and can prevent SQLite injection
https://sqlitening.planetsquires.com/index.php?topic=3378.0;wap2

Quote
Added the slSelBind function in order to avoid SQL injection and to improve Unicode processing.

Example extracting encrypted text (3-ways)

slexe  "create table if not exists t1(MyKey UNIQUE,MyData)"
slSetProcessMods "K" + SPACE$(32)
slSelBind "select MyData from t1 where MyKey = ?",slBuildBindDat(sKey,"T")
DO WHILE slGetRow
  ? slConvertDat(slf(1),"D")
  ? slfx(1,"D")
  ? slfnx("MyData","D")
LOOP

'Encapsulated 3 functions to include logging
'slSel    ----> slSe
'slExe    ----> slEx
'slSelAry ----> slSelAr

'slInsert added for simple text inserting

#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG 'BindAndLog.Bas  9/12/18 CJ
LOCAL sTemp() AS STRING
REDIM sCol(1 TO 2) AS STRING 'columns in table
KILL   "junk.db3":ERRCLEAR
slOpen "junk.db3","C"
slexe  "create table if not exists trantable(statements)"
slex   "create table if not exists t1(c1,c2)"

'slInsert - insert data without quoting strings
sCol(1)="c1 binding"
sCol(2)="c2 binding"
slInsert "t1",sCol() 'tablename$,datacols$()

slex     "insert into t1 values('c1 no bind','c2 no bind')"
slse     "select sqlite_version()",0,"E0":slGetRow':? slf(1),,"SQLite Version"
slex     "drop table if exists FimTable1234"

slSelAr "select rowid,* from t1",sTemp(),"Q9"
? "T1 Table" + $CR + JOIN$(sTemp(),$CR) + $CR + $CR + "Log" + $CR +_
Viewer("select rowid,* from trantable" ,"Q9"),,"Both tables"

END FUNCTION
'-------------------------------------------------------------------------------------
FUNCTION slInsert(sTable AS STRING,sCol() AS STRING) AS STRING
LOCAL x AS LONG, sInsert,sBind,sQuestionMarks,sLog AS STRING
FOR x = 1 TO UBOUND(sCol)
  sBind+=slBuildBindDat(sCol(x),"T")
NEXT
sQuestionMarks = LEFT$("(" + REPEAT$(UBOUND(sCol),"?,"),-1) + ")"  '(?,?,?)
slexeBind "Insert into " + sTable + " values " + sQuestionMarks,sBind
IF slGetChangeCount = 0 THEN ? "Insert error",%MB_SYSTEMMODAL,"slInsert"
sLog = LEFT$(DATE$,5) + " " + TIME$ + " " + "Insert into " + sTable + " values (" + JOIN$(sCol(),",") + ")"
slexebind "insert into trantable values(?)",slBuildBindDat(sLog,"T")
END FUNCTION
'-------------------------------------------------------------------------------------
FUNCTION Viewer(sql AS STRING,sModChars AS STRING) AS STRING
LOCAL sArray() AS STRING
FUNCTION = slSelAr(sql,sArray(),sModChars)
END FUNCTION
'-------------------------------------------------------------------------------------
'(BYREF rsStatement AS STRING, BYREF wsaColsAndRows() AS STRING, OPTIONAL BYVAL rsModChars AS STRING) AS LONG
FUNCTION slSelAr(rsStatement AS STRING, wsaColsAndRows() AS STRING,OPT rsModChars AS STRING) AS STRING
LOCAL rsModChars2 AS STRING
LOCAL sLog AS STRING
LOCAL wsaColsAndRows() AS STRING
IF ISFALSE(ISMISSING(rsModChars)) THEN rsModChars2 = rsModChars
slSelAry rsStatement,wsaColsAndRows(),rsModChars2
FUNCTION = JOIN$(wsaColsAndRows(),$CR)
sLog = LEFT$(DATE$,5) + " " + TIME$ + " " + rsStatement
slexebind "insert into trantable values(?)",slBuildBindDat(sLog,"T")
END FUNCTION
'-------------------------------------------------------------------------------------
'BYREF rsStatement AS STRING, OPTIONAL BYVAL rsModChars AS STRING) AS LONG
FUNCTION slex(sql AS STRING,OPT rsModChars AS STRING) AS LONG
LOCAL rsModChars2 AS STRING
LOCAL sLog AS STRING
IF ISFALSE(ISMISSING(rsModChars)) THEN rsModChars2 = rsModChars
slexe sql,rsModChars2
sLog = LEFT$(DATE$,5) + " " + TIME$ + " " + sql
slexebind "insert into trantable values(?)",slBuildBindDat(sLog,"T")
END FUNCTION
'-------------------------------------------------------------------------------------
'(BYREF rsStatement AS STRING, OPTIONAL BYVAL rlSetNumber AS LONG, OPTIONAL BYVAL rsModChars AS STRING) AS LONG
FUNCTION slse(rsStatement AS STRING,OPT rlSetNumber AS LONG,rsModChars AS STRING) AS LONG
LOCAL rlSetNumber2 AS LONG
LOCAL sLog,rsModChars2  AS STRING
IF ISFALSE(ISMISSING(rlSetNumber)) THEN rlSetNumber2= rlSetNumber
IF ISFALSE(ISMISSING(rsModChars))  THEN rsModChars2 = rsModChars
slSel rsStatement ,rlSetNumber2,rsModChars2
sLog = LEFT$(DATE$,5) + " " + TIME$ + " " + rsStatement
slexebind "insert into trantable values(?)",slBuildBindDat(sLog,"T")
END FUNCTION



Didn't like previous version.
This version captures errors in log and doesn't need any other functions

#INCLUDE "sqlitening.inc"
$E1 = "...................................................." + $CR
$E2 = "...................................................." + $CR

FUNCTION PBMAIN () AS LONG  'errorlog.bas 9/13/18 CJ

LOCAL sql AS STRING
slSetProcessMods "E1"  'any error is captured into the log

KILL "junk.db3":ERRCLEAR
slopen "junk.db3","C"

sql = "create table if not exists trantable(statement)" :slexe sql:logit(sql)
sql = "select * from trantable"                         :slsel sql:logit(sql)
sql = "drop table if exists HeidiKlum"                  :slexe sql:logit(sql)
sql = "create table if not exists trantable(statement)" :slexe sql:logit(sql)
sql = "create table wrong"                              :slexe sql:logit(sql)
sql = "drop table if exists Table1"                     :slexe sql:logit(sql)
sql = "select rowid      from trantable"                :slsel sql:logit(sql)
sql = "select statement  from trantable"                :slsel sql:logit(sql)
sql = "JIBBERISH"                                       :slexe sql:logit(sql)
sql = "select *          from trantable"                :slsel sql:logit(sql)
sql = "select * from xyz"                               :slsel sql:logit(sql)
sql = "select * from trantable"                         :slsel sql:logit(sql)
sql = "select 'Have'||' a'||' good'||' day'"            :slsel sql:logit(sql)

viewall

END FUNCTION

SUB ViewAll
LOCAL sArray() AS STRING
IF slSelAry("select statement from trantable",sArray(),"Q9E0") THEN
   ? slGetError,%MB_SYSTEMMODAL,"Viewer"
ELSEIF UBOUND(sArray) < 1 THEN
  ? "No data",%MB_SYSTEMMODAL,"Viewer"
ELSE
  ? JOIN$(sArray(),$CR),%MB_SYSTEMMODAL,"Viewer"
END IF
END SUB

FUNCTION LogIt(s AS STRING) THREADSAFE AS LONG
LOCAL sHeader AS STRING  'returns 1 on success
LOCAL AnError AS LONG
AnError = slGetErrorNumber 'set flag

IF AnError THEN 'experimental, show last error in log
  slexebind "insert into trantable values(?)",slBuildBindDat($E1 + slGetError,"T"),"E0"
END IF

sHeader = LEFT$(DATE$,5) + " " + TIME$ + " " + s
slexebind "insert into trantable values(?)",slBuildBindDat(s,"T"),"E0"
IF slGetErrorNumber THEN
   ? slGetError + $CR + $CR + s,%MB_SYSTEMMODAL,"LogIt"
   EXIT FUNCTION
END IF
IF AnError THEN slexebind "insert into trantable values(?)",slBuildBindDat($E2,"T"),"E0"
IF slGetChangeCount <> 1 THEN
   ? "Write to log failed",%MB_SYSTEMMODAL,"LogIt"
END IF

END FUNCTION

Is there a limit to the number of functions called in a SELECT statement?
Each of the strftime function calls work if broken into shorter Select statements.

#INCLUDE "sqlitening.inc"
FUNCTION PBMAIN () AS LONG
DIM sArray() AS STRING
slOpen "junk.db3","C"
slexe "drop table if exists t1"
slexe "create table if not exists t1(c1)"
slselAry "select strftime('%Y',c1),strftime('%m',c1),strftime('%d',c1)," +_
                 "strftime('%H',c1),strftime('%M',c1),strftime('%S',c1) from t1",sArray()
? JOIN$(sArray(),$CR)
END FUNCTION

SQLite added UPSERT equivalent today 6/4/2018 IN version 3.24.0

http://www.sqlite.org/lang_UPSERT.html

If an INSERT fails then an UPDATE to the same ROWID is attempted.
The update after a failing insert can fail if it is also a duplicate.

This links says it is the same as INSERT OR REPLACE INTO.
I think that may work, but it will delete all columns and then INSERT.
https://stackoverflow.com/questions/418898/sqlite-upsert-not-insert-or-replace


This example has 2 columns and it demonstrates the second column is not deleted, hurray!

#INCLUDE "sqlitening.inc"
FUNCTION PBMAIN () AS LONG
LOCAL sRecordSet AS STRING
slOpen "junk.db3","C"
slexe "drop table if exists t1"
slexe "create table if not exists t1(c1 unique, c2)"
DO
  slexe "insert into t1 values('Hello, world',' am i deleted') on conflict(c1) do update set c1 = '*duplicate so insert timer="+FORMAT$(TIMER) + "*'"
  sRecordSet = ""
  slsel "select rowid,* from t1"
  DO WHILE slgetrow
    sRecordSet+= slf(1) + " " + slf(2) + " " + slf(3) + $CR
  LOOP
  IF MSGBOX(sRecordSet,%MB_YESNO,"Yes = insert       No = done") <> %IDYES THEN EXIT DO
LOOP
END FUNCTION

SQLiteningServer.Bas

stop server by running SQLiteningServerAdmin.exe
download using link at bottom of page
extract  sqliteningserver.bas from the sqliteningserver .zip (it is the only file in there)
put sqliteningserver.bas into your \src folder with the other SQLitening source files
open SQLiteningServer.Bas in the PBEditor
#COMPILE EXE "c:\something\bin\SQLiteningServer"
start server by running SQLiteningServerAdmin.exe

'Notes:
'SqliteningServer.bas can now be compiled with a click
'SUB LogIt(BYVAL rlEntryType AS LONG, rsEntryData AS STRING)
'  Before: PRINT #gwLogFileNumber, REMOVE$(RIGHT$(DATE$, 2) & LEFT$(DATE$, 5) & TIME$, ANY "-:") & " " & _ ...
'  Now  : PRINT #gwLogFileNumber, DATE$  & " " & TIME$ & " " & _ ...
'END SUB


02-17-2018 14:19:23 Conn #24 SK 584 CJ MYCOMPUTER 192.168.0.2  (92.132.13.133 on port 54349)
180217141923        Conn #24 SK 584 CJ MYCOMPUTER 192.168.0.2  (before change)

At the bottom of the source (sqliteningserver.bas) is the new function PBgetIPandPort.
Date and time was a a simple change to the function Logit Date$ & " " & Time$

It is now easier to add other features to SQLiteningServer.Bas without getting type mismatches and
having to modify DECLARE and TYPE statements because win32api.inc is now used.

Here is an updated SqliteningServer.bas in a .zip file

http://sqlitening.com/support/index.php?topic=9690.msg25917#msg25917

Does each function have to be registered?
Are all functions unloaded at once with a single call?
If client crashes does this cause the server to need to be restarted  (see note at bottom of slRunProc in docs.)
slRunProc (rsProcName String, blParm1 Long, blParm2 Long, bsParm3 String, bsParm4 String, [rsModChars String]) Long
Are all the parameters explained somewhere?  The first and last is in slRunProc

'Easy insert and update using REPlACE INTO
'Routine adjusts sData() array to the create statement
'Rowids do not change if INTEGER PRIMARY KEY is used with REPLACE INTO

'To modify:
' 1. Drop previous table
' 2. Create a new create statement
' 3. Change GetNextHighestRow("c1") to column name of primary key
'
'Please post any comments or suggestions

#INCLUDE "sqlitening.inc"  'InsertOrReplace.bas
FUNCTION PBMAIN () AS LONG

LOCAL colnum AS LONG
LOCAL s,sql, sCreate,sTableName,sColumnName(),sData() AS STRING

slOpen "test.db3","C"

sTableName = "t1"
slexe "drop table if exists t1"
sCreate    = "create table if not exists "+sTableName+"(c1 INTEGER Primary Key,col2,col3,LastUpdate without rowid)"
CreateTable sCreate,sColumnName(),sData()

DO
  'in real application lock before getting highestRow
  s = GetNextHighestRow("c1")     'In a real-world data is supplied here
  s = INPUTBOX$("RowID",sql,s)    'in real application do not wait for user input while locked
  IF LEN(s) = 0 THEN EXIT DO
  sData(1)  = s
  sData(2) = "'two'"
  sData(3) = "'three'"
  sData(4) = "'" + TIME$ + "'"
  slexe "Insert or Replace into " +sTableName + " values("+ JOIN$(sData(),",")+");"
  'in real application unlock after insert or update
  sql = "select * from " + sTableName + " order by LastUpdate Desc"
  ? viewit(sql),,sql
LOOP

END FUNCTION

FUNCTION viewit(sql AS STRING) AS STRING
DIM sArray() AS STRING
slselary sql,sArray(),"Q9"
FUNCTION = JOIN$(sArray$(),$CR)
END FUNCTION

SUB CreateTable(sCreate AS STRING,sColNames()AS STRING,sData() AS STRING)
LOCAL x,LastCol AS LONG
LOCAL s,sTableName AS STRING
x = INSTR(sCreate,"(")
s = LEFT$(sCreate,x-1)
x = INSTR(-1,s," ")
sTableName = MID$(s,x+1)
slexe sCreate
s= slGetTableColumnNames(sTableName) 'column names
LastCol = PARSECOUNT(s,$NUL)         'get last column number
DIM sColNames(1 TO LastCol)          'dim array to hold column names
FOR x=1 TO LastCol                   'column name loop
  sColNames(x)=PARSE$(s,$NUL,x)       ' column name into array
NEXT                                 'next column n
REDIM sData(1 TO LastCol)           'init column data array
END SUB

FUNCTION GetNextHighestRow(sColName AS STRING) AS STRING
LOCAL s AS STRING
s = "select COALESCE(max(#),0)+1 from T1"
REPLACE "#" WITH scolName IN s
slsel s,0,"E0"
IF slGetErrorNumber = 0 THEN
  slGetRow
  FUNCTION = slf(1)
ELSE
  ? slGetError,,LCASE$(FUNCNAME$)
END IF
END FUNCTION


[font=courier]'Easy insert and update using REPlACE INTO
'Routine adjusts sData() array to the create statement
'Rowids do not change if INTEGER PRIMARY KEY is used with REPLACE INTO

'To modify:
' 1. Drop previous table
' 2. Create a new create statement
' 3. Change GetNextHighestRow("c1") to column name of primary key
'
'Please post any comments or suggestions

#INCLUDE "sqlitening.inc"  'InsertOrReplace.bas
FUNCTION PBMAIN () AS LONG

LOCAL colnum AS LONG
LOCAL s,sql, sCreate,sTableName,sColumnName(),sData() AS STRING

slOpen "test.db3","C"

sTableName = "t1"
slexe "drop table if exists t1"
sCreate    = "create table if not exists "+sTableName+"(c1 INTEGER Primary Key,col2,col3,LastUpdate without rowid)"
CreateTable sCreate,sColumnName(),sData()

DO
  s = GetNextHighestRow("c1")     'In a real-world data is supplied here
  s = INPUTBOX$("RowID",sql,s)
  IF LEN(s) = 0 THEN EXIT DO
  sData(1)  = s
  sData(2) = "'two'"
  sData(3) = "'three'"
  sData(4) = "'" + TIME$ + "'"
  slexe "Insert or Replace into " +sTableName + " values("+ JOIN$(sData(),",")+");"

  sql = "select * from " + sTableName + " order by LastUpdate Desc"
  ? viewit(sql),,sql
LOOP

END FUNCTION

FUNCTION viewit(sql AS STRING) AS STRING
DIM sArray() AS STRING
slselary sql,sArray(),"Q9"
FUNCTION = JOIN$(sArray$(),$CR)
END FUNCTION

SUB CreateTable(sCreate AS STRING,sColNames()AS STRING,sData() AS STRING)
LOCAL x,LastCol AS LONG
LOCAL s,sTableName AS STRING
x = INSTR(sCreate,"(")
s = LEFT$(sCreate,x-1)
x = INSTR(-1,s," ")
sTableName = MID$(s,x+1)
slexe sCreate
s= slGetTableColumnNames(sTableName) 'column names
LastCol = PARSECOUNT(s,$NUL)         'get last column number
DIM sColNames(1 TO LastCol)          'dim array to hold column names
FOR x=1 TO LastCol                   'column name loop
  sColNames(x)=PARSE$(s,$NUL,x)       ' column name into array
NEXT                                 'next column n
REDIM sData(1 TO LastCol)           'init column data array
END SUB

FUNCTION GetNextHighestRow(sColName AS STRING) AS STRING
LOCAL s AS STRING
s = "select COALESCE(max(#),0)+1 from T1"
REPLACE "#" WITH scolName IN s
slsel s,0,"E0"
IF slGetErrorNumber = 0 THEN
  slGetRow
  FUNCTION = slf(1)
ELSE
  ? slGetError,,LCASE$(FUNCNAME$)
END IF
END FUNCTION
[/font]


Without RowID requires a primary key so why no error as per the documentation?

#INCLUDE "sqlitening.inc"  'withoutrowid.bas
'https://www.sqlite.org/withoutrowid.html
FUNCTION PBMAIN () AS LONG
slOpen "junk.db3","C"
slexe  "drop table if exists t1"
slexe "create table if not exists t1(apples without rowid)"
slexe "insert into t1 values('pink lady')"
DIM sArray() AS STRING
slSelAry "select rowid,* from t1",sArray(),"Q9"
? JOIN$(sArray(),$CR)
END FUNCTION                                   

Using normal PowerBASIC file handling to read local files can eliminate having to load and unload SQLitening routines
if a program is accessing both local flat files and a remote database using the SQLitening server routines.

Using GetLocalFile(sFileName,sData)  and PutLocalFile(sFileName,sData) instead of slGetFile and slPutFile
can eliminate the need to use slSetProcessMods "L0" and slSetProcessMods "L1".

To make more robust need to add TableName and BlobColumnName parameters to GetBlob and PutBlob (to do list) which would match names in create statement.
The PutBlob(sKey,sData) function replaces the data if found or inserts the data if not found.

4 Helper functions:
FUNCTION PutBlob(sBlobKey AS STRING,sBlob AS STRING) THREADSAFE AS LONG
FUNCTION GetBlob(sBlobKey AS STRING,sBlobData AS STRING) THREADSAFE AS LONG
FUNCTION GetLocalFile(sFileName AS STRING, sData AS STRING) THREADSAFE AS LONG
FUNCTION PutLocalFile(sFileName AS STRING, sData AS STRING) THREADSAFE AS LONG


As always, comments welcome!

#INCLUDE "sqlitening.inc"
'-------------------------------------------------------------------------------------------------
FUNCTION PBMAIN() AS LONG

LOCAL sLocalFileName,sLocalData,sData,sKey AS STRING, eCode AS LONG

'create local test file which will later be saved into a SQLitening blob column
sLocalFileName="test.txt"
OPEN sLocalFileName FOR OUTPUT AS #1:PRINT #1,"If you read this, it worked!!":CLOSE

slconnect "think.freemyip.com",47381   
slOpen    "Test.db3","C"                          'database to open
slexe     "create table if not exists PictureTable(blobkey unique,blobdata)"

'read local file
eCode = GetLocalFile(sLocalFileName,sLocalData)
IF eCode THEN ? "GetLocalFile error" + STR$(eCode),%MB_SYSTEMMODAL,"GetLocalFile Error"

'save data to server using key
sKey  = "Heidi Klum"                              'get and save key
eCode = PutBlob(sKey,sLocalData)
IF eCode THEN ? slGetError,%MB_SYSTEMMODAL,"WriteBlob"           :EXIT FUNCTION

'read data from server
eCode = GetBlob(sKey,sData)
IF eCode THEN ? slGetError,%MB_SYSTEMMODAL,"Getblob"             :EXIT FUNCTION
? sData,%MB_SYSTEMMODAL,"GetBlob"

slDisconnect

eCode = PutLocalFile("junk.txt",sData)            'write data to a local file
IF eCode THEN ? "PutLocalFile error" + STR$(eCode),%MB_SYSTEMMODAL,"PutLocalFile":EXIT FUNCTION

eCode = GetLocalFile("junk.txt",sLocalData)
IF eCode THEN ? "GetLocalFile error" + STR$(eCode),%MB_SYSTEMMODAL,"GetLocalFile Error"
? sData,%MB_SYSTEMMODAL,"GetLocalFile"

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION PutBlob(sBlobKey AS STRING,sBlob AS STRING) THREADSAFE AS LONG

LOCAL NumberOfChanges AS LONG 'function returns 0 on success

NumberOfChanges = slGetChangeCount("T")
slexeBind "replace into PictureTable values('" + sBlobKey + "',?)",slBuildBindDat(sBlob)
IF slGetErrorNumber THEN
   FUNCTION = slGetErrorNumber
   EXIT FUNCTION
END IF
NumberOfChanges = slGetChangeCount("T") - NumberOfChanges
IF NumberOfChanges <> 1 THEN FUNCTION = -9999

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION GetBlob(sBlobKey AS STRING,sBlobData AS STRING) THREADSAFE AS LONG

sBlobData = ""   'function returns 0 on success
slSel "select blobdata from PictureTable where blobkey ='"+sBlobKey + "'"
IF slGetErrorNumber THEN
  FUNCTION = slGetErrorNumber
  EXIT FUNCTION
END IF
IF slGetRow THEN sBlobData = slf(1)

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION GetLocalFile(sFileName AS STRING, sData AS STRING) THREADSAFE AS LONG

sData = "" 'function returns 0 on success
LOCAL MaxRetry AS LONG
LOCAL hFile AS LONG

IF ISFALSE(ISFILE(sFileName)) THEN 'local file not found
  FUNCTION = 53                'set error 53, file not found
  EXIT FUNCTION                'exit function
END IF

hFile = FREEFILE              'file handle
FOR MaxRetry = 1 TO 10        'maximum 10 attempts to open
  ERRCLEAR                     'clear error
  OPEN sFileName FOR BINARY ACCESS READ LOCK WRITE AS #hFile 'block writers
  IF ERR THEN                  'open error
   SLEEP 500                   'wait
   ITERATE                     'retry open
  END IF
  GET$ #hFile,LOF(hFile),sData 'read data
  FUNCTION = ERR               '0 if success
  CLOSE #hFile                 'close file
  EXIT FOR
NEXT
FUNCTION = ERR                '10 attempts to open reached

END FUNCTION

FUNCTION PutLocalFile(sFileName AS STRING, sData AS STRING) THREADSAFE AS LONG

LOCAL MaxRetry AS LONG
LOCAL hFile AS LONG

hFile = FREEFILE              'file handle
FOR MaxRetry = 1 TO 10        'maximum 10 attempts to open
  ERRCLEAR                     'clear error
  OPEN sFileName FOR OUTPUT AS #hFile 'exclusive
  IF ERR THEN                  'open error
   SLEEP 500                   'wait
   ITERATE                     'retry open
  END IF
  PRINT #hFile, sData;         'write data
  FUNCTION = ERR               '0 if success
  CLOSE #hFile                 'close file
  EXIT FOR
NEXT
FUNCTION = ERR                '10 attempts to open reached

END FUNCTION

#INCLUDE "sqlitening.inc"
'-------------------------------------------------------------------------------------------------
FUNCTION PBMAIN() AS LONG

LOCAL sLocalFileName,sLocalData,sData,sKey AS STRING, eCode AS LONG

'create local test file
sLocalFileName="test.txt"
OPEN sLocalFileName FOR OUTPUT AS #1:PRINT #1,"If you read this, it worked!!":CLOSE

slconnect "sqlitening.freemyip.com"   
slOpen    "Test.db3","C"                   
slexe     "create table if not exists PictureTable(blobkey unique,blobdata)"

'read local file
eCode = GetLocalFile(sLocalFileName,sLocalData)
IF eCode THEN ? "GetLocalFile error" + STR$(eCode),%MB_SYSTEMMODAL,"GetLocalFile Error"

'save data to server using key
sKey  = "Heidi Klum"                           
eCode = PutBlob(sKey,sLocalData)
IF eCode THEN ? slGetError,%MB_SYSTEMMODAL,"WriteBlob"           :EXIT FUNCTION

'read data from server
eCode = GetBlob(sKey,sData)
IF eCode THEN ? slGetError,%MB_SYSTEMMODAL,"Getblob"             :EXIT FUNCTION
? sData,%MB_SYSTEMMODAL,"GetBlob"

slDisconnect

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION PutBlob(sBlobKey AS STRING,sBlob AS STRING) THREADSAFE AS LONG

LOCAL NumberOfChanges AS LONG 'function returns 0 on success

NumberOfChanges = slGetChangeCount("T")
slexeBind "replace into PictureTable values('" + sBlobKey + "',?)",slBuildBindDat(sBlob)
IF slGetErrorNumber THEN
   FUNCTION = slGetErrorNumber
   EXIT FUNCTION
END IF
NumberOfChanges = slGetChangeCount("T") - NumberOfChanges
IF NumberOfChanges <> 1 THEN FUNCTION = -9999

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION GetBlob(sBlobKey AS STRING,sBlobData AS STRING) THREADSAFE AS LONG

sBlobData = ""   'function returns 0 on success
slSel "select blobdata from PictureTable where blobkey ='"+sBlobKey + "'"
IF slGetErrorNumber THEN
  FUNCTION = slGetErrorNumber
  EXIT FUNCTION
END IF
IF slGetRow THEN sBlobData = slf(1)

END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION GetLocalFile(sFileName AS STRING, sData AS STRING) THREADSAFE AS LONG

sData = "" 'function returns 0 on success
LOCAL MaxRetry AS LONG
LOCAL hFile AS LONG

IF ISFALSE(ISFILE(sFileName)) THEN 'local file not found
  FUNCTION = 53                'set error 53, file not found
  EXIT FUNCTION                'exit function
END IF

hFile = FREEFILE              'file handle
FOR MaxRetry = 1 TO 10        'maximum 10 attempts to open
  ERRCLEAR                     'clear error
  OPEN sFileName FOR BINARY ACCESS READ LOCK WRITE AS #hFile 'block writers
  IF ERR THEN                  'open error
   SLEEP 500                   'wait
   ITERATE                     'retry open
  END IF
  GET$ #hFile,LOF(hFile),sData 'read data
  FUNCTION = ERR               '0 if success
  CLOSE #hFile                 'close file
  EXIT FOR
NEXT
FUNCTION = ERR                '10 attempts to open reached

END FUNCTION

FUNCTION PutLocalFile(sFileName AS STRING, sData AS STRING) THREADSAFE AS LONG

LOCAL MaxRetry AS LONG
LOCAL hFile AS LONG

hFile = FREEFILE              'file handle
FOR MaxRetry = 1 TO 10        'maximum 10 attempts to open
  ERRCLEAR                     'clear error
  OPEN sFileName FOR OUTPUT AS #hFile 'exclusive
  IF ERR THEN                  'open error
   SLEEP 500                   'wait
   ITERATE                     'retry open
  END IF
  PRINT #hFile, sData;         'write data
  FUNCTION = ERR               '0 if success
  CLOSE #hFile                 'close file
  EXIT FOR
NEXT
FUNCTION = ERR                '10 attempts to open reached

END FUNCTION

http://freemyip.com  Type in a name and it automtically creates a link to your local Ip address
Save the link provided and execute the link anytime to route to your current Ip or edit to go to another IP address.

#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG 'QuickTest2.bas 6/20/17
slconnect "NameYouUsed.freemyip.com"
slOpen "sample.db3"
ViewFile "select rowid,manuf,redref,product from parts limit 20"
slDisconnect
END FUNCTION

FUNCTION ViewFile(SQL AS STRING) AS LONG
LOCAL hFile AS LONG, sTempfile, sArray() AS STRING
IF slSelAry(sql,sArray(),"Q9 E2") THEN EXIT FUNCTION
sTempFile=GUIDTXT$(GUID$) + ".tmp"
hFile = FREEFILE
OPEN sTempFile FOR OUTPUT AS #hFile
IF ERR THEN ? ERROR$,,FUNCNAME$:EXIT FUNCTION
PRINT #hFile,"SQLitening Test"
IF ERR THEN
   ? ERROR$,,"Could not write heading " + FUNCNAME$
   EXIT FUNCTION
END IF
PRINT #hFile
PRINT #hFile, sArray()
IF ERR THEN ? ERROR$,,FUNCNAME$:EXIT FUNCTION
CLOSE #hFile
SHELL "write.exe " + sTempfile
SLEEP 500
KILL sTempfile
IF ERR THEN ? ERROR$,,FUNCNAME$
END FUNCTION

Formatted Row and Column Arrays Optionally To Disk

Solid State Drives and disk cache make writing to disk very fast.
Other programs may require TAB or other delimited formats to read in data.
If another program needs the same data it may already be in memory.

Data passed using a file uses little memory and has advantages.
Receiving programs can process the data lines at a time or read all in at once.
It also allows users to view the output on any station at any time.
Results may be produced in ROW order and COLUMN order without processing twice.
4 new functions are highlighted (no more too much data for a MSGBOX while testing.)

FUNCTION PBMAIN AS LONG

h& = freefile           
OPEN "output.txt" FOR APPEND AS #h&                  'open output file
slopen "sample.db3"                                  'open database
slselary "select * from parts",sArray()              'select data
WriteElementsRowOrder h&,sColRowArray(),$Delimiter   'format to disk in row order
PRINT #h&                                            'blank line

ReverseDimensions sArray(),sColArray()               'create array in column order
WriteElementsColumnOrder h&,sColArray(),$Delimiter   'format to disk in column order
CLOSE #h&                                            'close output file to allow display
DisplayTextFile "output.txt"                         'display using program for txt files

END FUNCTION

output.txt

NO|MANUF|REDREF|PRICE
1|3COM|00100283|3365
2|3COM|00100284|160420
3|3COM|00100285|49218
4|3COM|00100286|51861
5|3COM|00100287|2857
6|3COM|00100289|239358
7|3COM|00100290|779
8|3COM|00100295|68922
9|3COM|00100296|16941
10|3COM|00100298|6746
11|3COM|00100299|8376

NO|1|2|3|4|5|6|7|8|9|10|11
MANUF|3COM|3COM|3COM|3COM|3COM|3COM|3COM|3COM|3COM|3COM|3COM
REDREF|00100283|00100284|00100285|00100286|00100287|00100289|00100290|00100295|00100296|00100298|00100299
PRICE|3365|160420|49218|51861|2857|239358|779|68922|16941|6746|8376




#DIM ALL
#INCLUDE "win32api.inc"
#INCLUDE "sqlitening.inc"
$Delimiter = "|"

FUNCTION PBMAIN () AS LONG

LOCAL sColRowArray() AS STRING
LOCAL sRowColArray() AS STRING
LOCAL sOutputFile    AS STRING
LOCAL h              AS LONG

sOutputFile = "output.txt"
KILL sOutputFile:ERRCLEAR
h = FREEFILE
OPEN sOutputFile FOR APPEND AS #h
PRINT #h, "Formatted Row and Column Arrays Optionally To Disk";TAB(62)DATE$ + " " + TIME$
PRINT #h
PRINT #h, "Solid State Drives and disk cache make writing to disk very fast."
PRINT #h, "Other programs may require TAB or other delimited formats to read in data."
PRINT #h, "if another program uses the data on the same machine it may be in memory."
PRINT #h, "Receiving programs can process the data lines at a time or read all in at once."
PRINT #h, "It also allows users to view the output on any station at any time."
PRINT #h, "Results may be produced in ROW order and COLUMN order.
PRINT #h, "This program shells to the default program associated to read .TXT files."
PRINT #h,

REM slConnect "123.123.123.123"  'optional, get data far,far away

slopen "sample.db3"
slselary "select rowid as NO,MANUF,Redref,price from parts limit 11",sColRowArray()

WriteElementsRowOrder h,sColRowArray(),$Delimiter
PRINT #h, STRING$(80,"-")

ReverseDimensions sColRowArray(),sRowColArray() 'create array in column order
WriteElementsColumnOrder h,sRowColArray(),$Delimiter

CLOSE #h
DisplayTextFile sOutputFile

slDisconnect

END FUNCTION

FUNCTION ReverseDimensions(sSourceArray() AS STRING,sDestArray() AS STRING) AS LONG

'NOTE: Do not REDIM sDestArray() before or after calling to prevent corrupting SourceArray()

LOCAL lpSource AS LONG PTR
LOCAL lpDest   AS LONG PTR
LOCAL COL,ROW,lCol,lRow,uCol,uRow,Cols,Rows AS LONG

lCol = LBOUND(sDestArray,2)
UCol = UBOUND(sDestArray,2)
LRow = LBOUND(sDestArray,1)
URow = UBOUND(sDestArray,1)

rows = UROW-LRow '0 based number of rows
cols = UCOL-lCol '0 based number of columns

lpDest   = VARPTR(sDestArray  (lRow,lCol)) 'first element of destinstion array
FOR ROW = 0 TO rows
  FOR COL = 0 TO cols
   @lpDest[ROW OF rows , COL OF cols] = 0
  NEXT COL
NEXT ROW

'----------------------------------------------------------------------------------
lCol = LBOUND(sSourceArray,1)
UCol = UBOUND(sSourceArray,1)
LRow = LBOUND(sSourceArray,2)
URow = UBOUND(sSourceArray,2)

rows = UROW-LRow '0 based number of rows
cols = UCOL-lCol '0 based number of columns

REDIM sDestArray(LRow TO URow,LCol TO UCol) AS STRING

lpSource = VARPTR(sSourceArray(lCol,lRow)) 'first element of source array
lpDest   = VARPTR(sDestArray  (lRow,lCol)) 'first element of destinstion array

FOR ROW = 0 TO rows
  FOR COL = 0 TO cols
   @lpDest[ROW OF rows , COL OF cols] = @lpSource[COL OF cols, ROW OF rows]
  NEXT COL
NEXT ROW

END FUNCTION

FUNCTION DisplayTextFile(sFileName AS STRING) AS LONG
LOCAL zFileName AS ASCIIZ * 257
zFileName = sFileName
ShellExecute (0, "OPEN", zFileName, BYVAL 0, CURDIR$, %SW_SHOWNORMAL)
END FUNCTION


FUNCTION WriteElementsColumnOrder(hFile AS LONG, sArray() AS STRING,sDelimiter AS STRING) AS LONG

LOCAL COL,ROW,lCol,lRow,uCol,uRow,Cols,Rows AS LONG

lCol = LBOUND(sArray,2)  'row/column order values
UCol = UBOUND(sArray,2)
LRow = LBOUND(sArray,1)
URow = UBOUND(sArray,1)

rows = UROW-LRow '0 based number of rows
cols = UCOL-lCol '0 based number of columns
'array elements could be negative, 0, or positive so simple IF used
FOR COL = lCol TO UCol
  FOR ROW  = lRow TO Urow
   IF ROW < uRow THEN
    PRINT #hFile,sArray(ROW,COL);sDelimiter;
   ELSE
    PRINT #hFile,sArray(ROW,COL)
   END IF
  NEXT
NEXT COL

END FUNCTION

FUNCTION WriteElementsRowOrder(hFile AS LONG, sArray() AS STRING,sDelimiter AS STRING) AS LONG

LOCAL COL,ROW,lCol,lRow,uCol,uRow,Cols,Rows AS LONG

lCol = LBOUND(sArray,1)  'column/row order values
UCol = UBOUND(sArray,1)
LRow = LBOUND(sArray,2)
URow = UBOUND(sArray,2)

rows = UROW-LRow
cols = UCOL-lCol

'array elements could be negative, 0, or positive so simple IF used
FOR ROW  = lRow TO Urow
  FOR COL = lCol TO UCol
   IF COL < UCol THEN             'not last column use delimiter
     PRINT #hFile,sArray(COL,ROW);sDelimiter;
   ELSE
     PRINT #hfile,sArray(COL,ROW) 'last column no delimiter
   END IF
  NEXT COL
NEXT ROW

END FUNCTION

Demonstrate get and insert "next highest row" in a single sql statement
It may be useful to know what the new highest row will be before inserting a record

Handles problem getting correct next highest record of empty table using coalesce
If multi-user/threaded call within a transaction so next highest row is locked

#INCLUDE "sqlitening.inc" 'InsertNextHighestRow.Bas

FUNCTION PBMAIN () AS LONG
slOpen "cj.db3","C"
slexe "drop table if exists t1"
slexe "create table if not exists T1(C1 Integer Primary Key AutoIncrement,C2)"

DO
  REDIM sArray(0) AS STRING
  slSelAry "select * from T1",sArray$(),"Q9c E0"
  IF slGetErrorNumber = 0 THEN sResult$ = JOIN$(sArray$(),$CR) ELSE ? slGetError,,"slSelAry"
  IF MSGBOX(sResult$,%MB_YESNO,"Do you want to insert record " + GetNextHighestRow) <> %IDYES THEN
    EXIT DO
  END IF
  slexe "insert into T1 values(null,(select 'Something '||(COALESCE(max(C1),0)+1) from T1))","E0"
  IF slGetErrorNumber THEN ? slGetError,,"Insert error"
LOOP

END FUNCTION

FUNCTION GetNextHighestRow AS STRING
slsel "select COALESCE(max(C1),0)+1 from T1",0,"E0"
IF slGetErrorNumber = 0 THEN
  slGetRow
  FUNCTION = slf(1)
ELSE
  ? slGetError,,LCASE$(FUNCNAME$)
END IF
END FUNCTION

PowerBASIC Console compiler version 5
PowerBASIC Windows compiler version 9
PowerBASIC PowerForms version 1.5

http://www.classicsoftware.com/free.htm

An order form is filled that does not ask for credit card information.

Is FreeBasic code easy to convert from PowerBASIC?  http://www.freebasic.net
Anyone have an example like this in FreeBASIC

#INCLUDE "sqlitening.inc"
%DropTable = 0

FUNCTION PBMAIN () AS LONG  'GetHighest.bas

  LOCAL sResult,sql AS STRING,recnum AS LONG

  'open database
  IF slopen ("test.db3","C") THEN ? slGetError: EXIT FUNCTION

  'drop table
  IF %DropTable THEN slexe "drop table if exists T1"

  'create table
  slexe "create table if not exists T1(recnum integer primary key,Column2)"

  'get highest record and add 1
  sql = "select max(recnum) from T1"
  RecNum = VAL(GetData(sql)) + 1

  'insert record new highest record
  slexe "insert into T1 values(null,'I am record" + STR$(RecNum) + "')"

  'get lowest record
  sql = "select * from t1 order by recnum limit 1"
  sResult = GetData(sql)

  'get highest record
  sql = "select * from T1 where recnum = (select Max(recnum) from T1)"
  sResult+= GetData(sql)
  ? sResult,,"Lowest/Highest"
 
END FUNCTION

FUNCTION Getdata(sql AS STRING) AS STRING
  LOCAL sArray() AS STRING
  slSelAry sql,sArray(),"Q9c"
  FUNCTION = JOIN$(sArray(),$CR) + $CR
END FUNCTION

Got working with SQL Server 2012 R2