• Welcome, Guest. Please login.
 
May 20, 2019, 12:24:41 pm

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.

Messages - cj

1
QuoteYour last post gave me an idea that works. Using the same table twice. Not the most elegant code, but it works.
It does what I want.
A small modification is suggested.
If an insert fails in either transaction might leave database in an inconsistent state or
another waiting user could jump in between transactions causing a potential problem.

A single transaction will solve both of these from happening.
IF MyTransaction THEN ? "transaction success" else ? "transaction failed"

Function MyTransaction as LONG
  slexe "begin Immediate"

  slexe  "first insert"
  IF slgetchangecount =0  then slexe "rollback":EXIT FUNCTION

  slexe  "last insert"
  IF slgetchangecount =0  then slexe "rollback":EXIT FUNCTION

  FUNCTION= 1
  slexe "end"
END FUNCTION
2
I don't know what column/row from the grid to put into the table columns.
I was thinking this might apply to your grid.

Table:  create table if not exists t1(invoice,client,code,qty,amt,DateTime)
            create table if not exists tblNextInvoice(counter INTEGER PRIMARY KEY AUTOINCREMENT)

Invoice number is 0 for each new unposted item for each client
Invoice: insert into t1 values(0, 87, 'paper', 1, 500,    datetime('now','localtime'))
Invoice: insert into t1 values(0, 87, 'chair', 1, 19995,  datetime('now','localtime'))

Post:    update t1 set invoice = counter+1 where client = clientnum and invoice = 0
All unposted entries for a client (invoice number 0) updated to next highest invoice counter



#INCLUDE "sqlitening.inc"  'fredrick8.bas for reference
%DropTables=1

FUNCTION PBMAIN () AS LONG
  LOCAL x AS LONG, s AS STRING
  slOpen  "junk.db3","C"
  IF %DropTables THEN slExe "drop table if exists t1":slexe "drop table if exists tblNextInvoice"

  slexe  "create table if not exists t1(invoice,client,code,qty,amt,DateTime)
  slexe  "create table if not exists tblNextInvoice(counter INTEGER PRIMARY KEY AUTOINCREMENT)

  CreateTestData

  PostClient 1
  PostClient 11
  Postclient 14
  PostClient 128
END FUNCTION

FUNCTION showall(sMsg AS STRING) AS STRING
  LOCAL sql AS STRING
  sql = "select invoice,client,code," +_
        "qty,printf('%.2f',amt*.01) as price,datetime from t1 order by client"

  LOCAL sarray() AS STRING
  slSelAry sql,sarray(),"Q9"
  ? JOIN$(sarray(),$CR),%MB_SYSTEMMODAL,sMsg
END FUNCTION

SUB PostClient(ClientNum AS LONG)
  LOCAL s AS STRING
  LOCAL nextInv AS LONG

  slexe "begin exclusive"  'lock others out
  slSel "select counter from tblNextInvoice"
  DO WHILE slGetRow  'only 1 record, this will closeset automatically
    nextinv = VAL(slf(1)) + 1 'new next highest invoice
  LOOP
  IF nextinv = 0 THEN 'only applies to first invoice ever created
    slexe "insert into tblNextInvoice values(0)" 'make counter 0
    nextinv = 1
  END IF
  slexe "update tblNextInvoice set counter = counter + 1"
  s = CHR$("update t1 set invoice=",FORMAT$(nextInv)," where client=",FORMAT$(ClientNum)," and invoice=0")
  slexe s
  slexe "end"

  ShowAll "Post client"+STR$(ClientNum)
END SUB

SUB CreateTestData
  LOCAL x AS LONG
  slexe "begin exclusive"
  FOR x = 1 TO 3
    'slexe                      inv,cli, code,  qty,amt,    date_time
    slexe  "insert into t1 values(0,1,  'chair', 1, 4995,  datetime('now','localtime'))"
    slexe  "insert into t1 values(0,11, 'pencil',1, 95,    datetime('now','localtime'))"
    slexe  "insert into t1 values(0,14, 'desk',  1, 13995, datetime('now','localtime'))"
    slexe  "insert into t1 values(0,92, 'ink',  1, 135,  datetime('now','localtime'))"
    slexe  "insert into t1 values(0,128,'sofa',  1, 64995, datetime('now','localtime'))"
  NEXT
  slexe "end"

  ShowAll "Any unposted invoices show as invoice 0"
END SUB
3
I am not getting notifications of your posts today by email?
Anyway, sounds like an MLG issue getting the values?

DIM x AS LONG
DIM s(1 to 7) AS STRING
'Fill element s(1) to s(3) from textboxes
'Fill element s(4) to s(7) from grid
'Bind and insert
FOR x = 1 to 7
  s(x) = slBuildBindDat(s(x))
next
slExebind "insert into t1 values(?,?,?,?,?,?,?)",JOIN$(s(),""),"V7"
4
#INCLUDE "sqlitening.inc"
FUNCTION PBMAIN () AS LONG
LOCAL r,c,rows,cols,hdlg AS LONG
slOpen "junk.db3","C"
slexe  "drop table if exists t1"
slexe  "create table if not exists t1(text1,text2,text3,grid1,grid2,grid3,grid4)"
rows = 20
cols = 7
REDIM sData(1 TO rows) AS STRING
REDIM sCol(1 TO cols)  AS STRING
FOR r = 1 TO rows
 FOR c = 1 TO cols
  SELECT CASE AS LONG c
   CASE 1:CONTROL GET TEXT hDlg, 1001 TO sCol(c)
   CASE 2:CONTROL GET TEXT hDlg, 1002 TO sCol(c)
   CASE 3:CONTROL GET TEXT hDlg, 1003 TO sCol(c)
   CASE 4:sCol(c)=""
   CASE 5:sCol(c)=""
   CASE 6:sCol(c)=""
   CASE 7:sCol(c)=""
  END SELECT
  sCol(c) = slBuildBindDat(sCol(c),"T")
 NEXT
 sData(r) = JOIN$(sCol(),"")
NEXT
slExebind "insert into t1 values(?,?,?,?,?,?,?)",JOIN$(sData(),""),"V7"
LOCAL sRecordSet() AS STRING
slSelAry "select rowid,* from t1",sRecordSet(),"Q9"
? JOIN$(sRecordSet(),$CR),%MB_SYSTEMMODAL,"done"
END FUNCTION
5
General Board / Money no leading zero using CASE
April 18, 2019, 09:39:27 pm
#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
 
6
#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG 'group_by_having.bas alias wilson3.bas 4/13/19

 LOCAL sql     AS STRING
 LOCAL sresult AS STRING

 slopen "group_having.db3","C"

 slexe  "drop table if exists iTable"
 slexe  "drop table if exists hTable"
 slexe  "create table if not exists iTable (iKey unique,iQty INTEGER)"
 slexe  "create table if not exists hTable (hKey,       hQty INTEGER)"

 slexe  "insert into iTable values ('bear',1),('dog',0),('fox',3)"
 slexe  "insert into hTable values ('dog',3) ,('dog',2),('fox',4)"

 sql =  "select iKey as Code,sum(hQty)as Held,iQTY as OnHand from hTable,iTable" +_
        " where iKey=hKey" +_
        " group by hKey" + _
        " having Held > iQTY" 'changed sum(hQty) to Held

 sresult = getrs(sql)
 ? sresult,,"Held Report"

END FUNCTION

FUNCTION getrs (sql AS STRING) AS STRING
 LOCAL sArray() AS STRING
 slSelAry sql,sArray(),"Q9 E0"
 IF slGetErrorNumber THEN ? slGetError,,"GetData":EXIT FUNCTION
 IF UBOUND(sArray)>0 THEN
  FUNCTION = JOIN$(sArray(),$CR)
 ELSE
  FUNCTION = "No records found"
 END IF
END FUNCTION


'Testing new forum software 4/18/19
'Can edit, but can't create a new thread  or reply
7
QuoteI want to run a query that will give me result the shows the total holds vs inventory qty on hand. I want to show all the items that have more holds than the current 
inventory level.

1. Add OnHold column to Inventory table
2. select * from table1 where qty < OnHold"

QuoteIn theory the system will never allow a user to put on hold if there is not an enough inventory.

UpdateteFlag& = Increment(sCode$,HoldMore)  ' return 1 if successful (doesn't allow out of limits)

slexe "create table table1(code unique, qty, OnHold)"
slexe "insert into table1 values('wilson',9,0)"
slexe "insert into table1 values('klume',100,103)"
slexe "insert into table1 values('squires',500,602)"

Test program
GLOBAL gs AS STRING
#INCLUDE "sqlitening.inc"

FUNCTION Increment(sCode AS STRING, hold AS LONG) AS LONG
'Update OnHold if qty& >= OnHold and hold > 0
IF hold < 1 THEN EXIT FUNCTION 'updating by less than 1 could be endless
slexe "update table1 set OnHold=OnHold+"+STR$(hold) + " where code='" + sCode$ + "' and qty >= OnHold+" + STR$(hold)
FUNCTION = slGetChangeCount
END FUNCTION

FUNCTION PBMAIN () AS LONG
LOCAL sCode         AS STRING
LOCAL HoldMore      AS LONG
LOCAL UpdateFlag    AS LONG
gs+= CHR$("Update OnHold until >=Quantity",$CR,$CR,"Code",$TAB,"Qty",$TAB,"OnHold",$CR)
CreateTable

scode = "wilson"
HoldMore = 1
DO 'test Increment function by holding more until limit reached
  ShowTable "select * from table1 where code = '" + sCode + "'"
  UpdateFlag = Increment(sCode,HoldMore)
LOOP WHILE UpdateFlag

gs+= CHR$($CR,$CR,"Qty <= OnHold",$CR,$CR,"Code",$TAB,"Qty",$TAB,"OnHold",$CR)
ShowTable "select * from table1 where Qty <= OnHold"
? gs,,"Done"
END FUNCTION

SUB ShowTable(sql AS STRING)
LOCAL sArray() AS STRING
slSelAry sql,sArray(),"Q9c"
IF UBOUND(sArray) > 0 THEN
  gs = gs + JOIN$(sArray(),$CR) + $CR
ELSE
  gs = "No data" + $CR
END IF
END SUB

SUB CreateTable
LOCAL sCode AS STRING
LOCAL hold,UpdateFlag AS LONG
slOpen "table1","C"
slexe "drop table if exists table1"
slexe "create table table1(code unique, qty, OnHold)"
slexe "insert into table1 values('wilson',9,0)"
slexe "insert into table1 values('klume',100,103)"
slexe "insert into table1 values('squires',500,602)"
END SUB
8
Incorrect sql statements are caught by slSel, but a zero length sql statement will not error until slGetColumnCount with an error -14.

Added this error check:
IF LEN(sql) = 0 THEN ? "No select statement",%MB_SYSTEMMODAL OR %MB_ICONERROR,"GetRecordSet":EXIT FUNCTION

Also added:
If rownum = 0 then ERASE sRecordSet:EXIT FUNCTION ' so a big empty array is not returned when there is no data to return.


#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN()
LOCAL sql,sRecordSet(),sColumnDelimiter,sReturned AS STRING
sColumnDelimiter = "  "
slopen "sample.db3","C"
sql = "select rowid,manuf,price from parts limit 3"
sReturned = GetRecordSet(sql,sRecordSet(),sColumnDelimiter)
IF LEN(sReturned) THEN ? sReturned
END FUNCTION

FUNCTION GetRecordSet(sql AS STRING,sRecordSet() AS STRING,sColumnDelimiter AS STRING) AS STRING
LOCAL colnum,rownum,columns,highelement AS LONG
IF LEN(sql) = 0 THEN ? "No select statement",%MB_SYSTEMMODAL OR %MB_ICONERROR,"GetRecordSet":EXIT FUNCTION
slsel sql,0,"E0"

IF slGetErrorNumber THEN                          'execute the sql statement
   ? sql + $CR +$CR + slGetError,%MB_SYSTEMMODAL OR %MB_ICONERROR,"GetRecordSet"
   EXIT FUNCTION
END IF

columns = slGetColumnCount                        'number of columns to return

DIM sCol(1 TO columns) AS STRING                  'avoid concatenation of current row
highelement = 50000                               'arbitrary top limit of recordset array
REDIM sRecordset(1 TO highelement) AS STRING

DO WHILE slGetRow                                 'read recordset loop
  INCR rownum                                      'actual number of reads rows
  IF rownum > highelement THEN                     'redim recordset array if needed
    highelement = highelement + 50000
    REDIM PRESERVE sRecordset(1 TO highelement)
  END IF
  FOR colnum = 1 TO columns                        'read columns of current row
   sCol(colnum) = slf(colnum)                      'place into current column array
  NEXT
  sRecordset(rownum) = JOIN$(sCol(),sColumnDelimiter)  'concatenate columns into current recordset(row)
LOOP

IF rownum = 0 THEN
    ERASE sRecordSet
    ? "No data",%MB_SYSTEMMODAL,"GetRecordSet"
    EXIT FUNCTION      'exit if no rows returned
END IF

REDIM PRESERVE sRecordset(1 TO rownum)            'shrink array to actual size
FUNCTION = JOIN$(sRecordSet(),$CR)
END FUNCTION                     
9
QuoteI use a page up/page down to retreive the next record.

In SQLite the recordset is filled and scrolled.
The concept of previous/next is of the recordset.

Sounds like you are not reading to the end of the recordset which will close it.
If you issue slCloseSet like FIM says should fix the problem, but reading to end of data should be the solution.

Different set numbers should not be needed if the recordset is closed after each select by reading to the end.
The read recordset loop should be examined to see if it is being exited before reading everything.
I normally used slSelAry so never see this problem.   See the function below named FillControl.

Example filling a textbox with multiple recordsets from the SQLite database "sample.db3"  "parts" table using a global string.
If slSelAry in the below function FillControl is replaced with your read recordset loop should reveal the error.


#PBFORMS CREATED V2.01 'scroll.bas for future reference https://www.sqlitening.planetsquires.com/index.php?topic=9733.msg26332#msg26332
#COMPILE EXE
#DIM ALL
GLOBAL ghDlg AS DWORD  'global handle to dialog
GLOBAL gs AS STRING    'recordset string to fill textbox
#PBFORMS BEGIN INCLUDES
#INCLUDE ONCE "WIN32API.INC"
#PBFORMS END INCLUDES
#INCLUDE "SQLITENING.INC"
#PBFORMS BEGIN CONSTANTS
%BUTTON_SELECT = 1001
%TEXT_RESULT   = 1002
%TEXT_SQL      = 1003
#PBFORMS END CONSTANTS
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
FUNCTION FillControl AS LONG
LOCAL sql      AS STRING
LOCAL sArray() AS STRING
'slconnect "192.168.0.2"
slopen "sample.db3"
CONTROL GET TEXT ghDlg,%TEXT_SQL TO sql    'sql statement
slselary sql,sArray(),"Q9c"                'get recordset
gs+=JOIN$(sArray(),$CRLF)                  'add to previous recordset
gs+=$CRLF + STRING$(150,".") + $CRLF       'optional
CONTROL SET TEXT ghDlg,%TEXT_RESULT, gs    'fill control
'CONTROL SEND ghDlg,%TEXT_Result,%WM_VSCROLL,%SB_BOTTOM,0  'scroll to bottom
'slClose                                    'close database
'slDisconnect                               'disconnect
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION

CALLBACK FUNCTION ShowDIALOG1Proc()
  SELECT CASE AS LONG CB.MSG
    CASE %WM_INITDIALOG
     Fillcontrol

    CASE %WM_COMMAND
      SELECT CASE AS LONG CB.CTL

       CASE %BUTTON_SELECT
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
            FillControl
          END IF
      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, "Dialog1", 457, 206, 358, 225, %WS_POPUP OR %WS_BORDER _
    OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
    %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
    %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR, TO hDlg
  CONTROL ADD BUTTON,  hDlg, %BUTTON_SELECT, "Select", 200, 200, 50, 15
  CONTROL ADD TEXTBOX, hDlg, %TEXT_RESULT, "", 5, 5, 345, 185, %WS_CHILD OR _
    %WS_VISIBLE OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE _
    OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_WANTRETURN, _
    %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
    %WS_EX_RIGHTSCROLLBAR
  CONTROL ADD TEXTBOX, hDlg, %TEXT_SQL, "select rowid,MANUF,PRODUCT from " + _
    "parts limit 5", 5, 200, 190, 13
#PBFORMS END DIALOG
  ghDlg = hDlg
  DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION'

11
You've got Questions? We've got Answers! / Re: Security
December 19, 2018, 09:33:06 pm
QuoteUsing Sqlitening - What measures should be adopted to prevent SQL Injection attacks. Any thoughts would be appreciated.


This is an old thread from 2015, but these answers were not given.
Today is 12/19/2018.

slExeBind
slSelBind
https://www.sqlitening.planetsquires.com/index.php?topic=9730.msg26326;topicseen#msg26326

Thoughts:
I've wondered who would inject the code in a local network?
If they can inject code they can just as easily write sql statements or delete a database.
If used over the internet the transmits should be encrypted so they shouldn't be able to inject.

I like slExeBind because text can be inserted "as is" without needing to wrap text with $SQ and also wrap embedded $SQ's.
12
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
13
You've got Questions? We've got Answers! / Re: Encryption
December 19, 2018, 09:08:27 pm
Search on name of image or a non-encrypted column
Added slSelBind

THREADED sb AS ISTRINGBUILDERA

#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG

LOCAL x     AS LONG
LOCAL sKey  AS STRING

sb = CLASS "StringBuilderA"

slopen "junk.db3","C"
slexe  "drop table if exists t1"
slexe  "create table if not exists t1(MyKey UNIQUE,MyData)"
slSetProcessMods "K" + SPACE$(32)
sKey = "key1"
slExeBind "insert into t1 values(?,?)",slBuildBindDat(sKey,"T") +_
                                        slBuildBindDat("Heidi","TN")

IF slGetChangeCount <> 1 THEN ? "Insert error":EXIT FUNCTION
slSel "select MyData from t1 where MyKey = " + WRAP$(sKey,$SQ,$SQ)

DO WHILE slGetRow
  AddItem slConvertDat(slf(1),"D")
  AddItem slfx(1,"D")
  AddItem slfnx("MyData","D")
LOOP

LOCAL sArray() AS STRING
slSelAry  "select MyData from t1 where MyKey="+WRAP$(sKey,$SQ,$SQ),sArray(),"D1 Q9c"
FOR x = 1 TO UBOUND(sArray)
  AddItem sArray(x)
NEXT

'This could prevent sql injection
slSelBind "select MyData from t1 where MyKey = ?",slBuildBindDat(sKey,"T")
DO WHILE slGetRow
  AddItem slConvertDat(slf(1),"D")
  AddItem slfx(1,"D")
  AddItem slfnx("MyData","D")
LOOP
? sb.string
END FUNCTION

SUB AddItem(s AS STRING)
sb.add s + $CR
END SUB
14
You've got Questions? We've got Answers! / Re: Encryption
December 19, 2018, 02:37:27 pm
Searching on the blob column may not work unless you know the exact value.
It makes more sense to search on the non-encrypted columns such as a key column.
See post #5 (below) which makes more sense.
It shows using slExeBind and slSelBind which may prevent SQL injection

Get equal (=) tests seem to work (with binding), but (< and  >) are not correct.
Notice in this example "Apple" is less than "B", but "Apple" is not returned.
If anyone sees an error in my ways, please post it!
https://www.sqlitening.planetsquires.com/index.php?topic=9579.msg25200#msg25200

Hopefully other products handle this.

#INCLUDE "sqlitening.inc"

FUNCTION PBMAIN () AS LONG
LOCAL s AS STRING
slopen "junk.db3","C"
slexe  "drop table if exists t1"
slexe  "create table if not exists t1(c1)"
slSetProcessMods "K" + SPACE$(32)  'set encrypt key
slExeBind "insert into t1 values(?)",slBuildBindDat("Apple","TN")          'insert encrypted Apple
slSelBind "select c1 from t1 where c1 < ?",slBuildBindDat("B","TN")        'Apple less than B test
DO WHILE slGetRow
  s+= slfx(1,"D") + $CR
LOOP
? s
END FUNCTION                   
15
SQlitening's built-in AES256 Cookbook encryption is used on columns and can be turned on and off.
SQLitening's was written by Greg Turcheson and would not be understood by third-party viewers.

Buying SQLite's AES256 encryption or https://www.zetetic.net/sqlcipher/ encrypt at the database level.
These products may work with some third-party products