SQLitening Support Forum

Please login or register.

Login with username, password and session length
Advanced search  

News:

Welcome to the SQLitening support forums!

Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Topics - cj

Pages: [1] 2 3 ... 5
1
General Board / Audit trail and slInsert (Version 2)
« on: September 12, 2018, 04:26:32 PM »
'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




2
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

3
General Board / UPSERT was added to SQLite in version 3.24.0 6/4/18
« on: June 04, 2018, 05:35:37 PM »
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




4
General Board / Source code - Remote Ip/Port added to SQLiteningServer.log
« on: February 16, 2018, 11:32:23 PM »
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

5
You've got Questions? We've got Answers! / slRunProc
« on: December 07, 2017, 10:25:27 AM »
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

6
You've got Questions? We've got Answers! / Easy Insert/Update using array
« on: September 25, 2017, 06:35:31 PM »
'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

Code: [Select]
[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]

7
You've got Questions? We've got Answers! / Without RowID
« on: September 24, 2017, 12:41:51 AM »
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                                   

8
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!
Code: [Select]
#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



9
General Board / FreeMyIp.Com very simple free DNS routing
« on: June 20, 2017, 01:12:11 AM »
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



10


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



Code: [Select]
#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

11
General Board / Next Highest Row Example
« on: March 03, 2017, 02:59:59 PM »
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

12
General Board / Free PowerBASIC compilers
« on: November 15, 2016, 08:34:15 AM »
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.

13
You've got Questions? We've got Answers! / FreeBasic
« on: November 01, 2016, 11:34:07 AM »
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

14
Got working with SQL Server 2012 R2




15
General Board / Assure threads allocate example
« on: July 16, 2016, 12:00:44 PM »
GLOBAL gsResult AS STRING
TYPE MyType
  sDatabase AS STRING * 64
  sIpAddress AS STRING * 32
  PortNumber AS LONG
  sql      AS STRING * 512
  hEventReady AS LONG
END TYPE

#INCLUDE ONCE "win32api.inc"
#INCLUDE ONCE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG
  slSetProcessMods "E0" 'applies to all threads
  LOCAL x, Threads AS LONG, t AS MyType
  Threads = 5
  REDIM hThreads(1 TO Threads) AS LONG
  FOR x = 1 TO Threads
    t.sDatabase       = "sample.db3"
    t.sIpAddress      = "192.168.1.2" 'change this
    t.PortNumber      = 51234         'change this
    t.sql             = "select count(*) from parts"
    t.hEventReady     = CreateEvent (BYVAL 0, BYVAL %TRUE, BYVAL %FALSE, BYVAL 0)
    THREAD CREATE Test(VARPTR(t)) TO hThreads(x)
    WaitForSingleObject t.hEventReady,%INFINITE
    CloseHandle t.hEventReady
  NEXT
  waitformultipleobjects Threads, hThreads(1),%True,%INFINITE
  FOR x = 1 TO Threads 'close all thread handles
    THREAD CLOSE hThreads(x) TO hThreads(x)
  NEXT
  ? gsResult,%MB_SYSTEMMODAL,"Recordsets"
END FUNCTION

THREAD FUNCTION Test(BYVAL t  AS MyType PTR) AS LONG
  ThreadSafeHelper t
END FUNCTION

SUB ThreadSafeHelper(BYVAL t AS MyType PTR) THREADSAFE
  DIM s() AS STRING
  LOCAL sDatabase,sIpAddress, sql AS STRING, PortNumber AS LONG

  'Assign local variables to pointed to memory addresses
  sDatabase  = TRIM$(@t.sDatabase)
  sIpAddress = TRIM$(@t.sIpAddress)
  PortNumber = @t.PortNumber
  sql = @t.sql
  'Now allocated, let same memory address be reused
  SetEvent @t.hEventReady'thread allocate, release event

  slConnect sIpAddress,PortNumber
  IF slGetErrorNumber = 0 THEN
    slOpen sDatabase, "C"
    IF slGetErrorNumber= 0 THEN
      slSelAry sql,s(),"Q9c"
      gsResult+= JOIN$(s(),$CR) + $CR
    ELSE
      gsResult+= "Database open error" + $CR
    END IF
    slDisconnect
  ELSE
    gsResult+="Could not connect" + $CR
  END IF
END SUB

Pages: [1] 2 3 ... 5