SQLite Wrapper

jcfuller

Member

Join Date: Aug 1998
Posts: 1472

18 Aug 2008, 03:08 PM

This demo is based on Stan Durham's fine work.
You will need sqlite3.dll
James

sqliteclass_02.inc

Code:

'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'sqlite base access using Objects
'
'Adapted from and based on the work of Stan Durham
'
'
'James C. Fuller August 18,2008
'------------------------------------------------------------------------------
' 

'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'Use Jose's include
#INCLUDE ONCE "Jose_sqlite_359.inc"

'==============================================================================
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'Helper Functions
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
FUNCTION sqlDate( BYVAL sDate AS STRING ) AS STRING
    LOCAL d$, m$, y$
    'change most dates to SQL date - 2006-01-25
    '
    'basic date$ - ok
    '11/1/05 - ok
    '11,01,05 - ok
    '11.1.2005 - ok
    '1-23-05 - ok
    'YYYYMMDD - ok
    '1-23-99 won't fix = 2099-01-23

    IF sDate="" THEN EXIT FUNCTION
    REPLACE "." WITH "," IN sDate
    REPLACE "-" WITH "," IN sDate
    REPLACE "/" WITH "," IN sDate
    REPLACE "\" WITH "," IN sDate

    IF INSTR(sDate,",")=0 THEN
        ''' date is in YYYYMMDD format?
        FUNCTION = LEFT$(sDate,4) +"-"+ MID$(sDate,5,2) +"-"+ RIGHT$(sDate,2)
        EXIT FUNCTION
    END IF

    d$ = PARSE$(sDate,",",2)
    m$ = PARSE$(sDate,",",1)
    y$ = PARSE$(sDate,",",3)
    IF LEN(d$)=1 THEN d$ = "0"+d$
    IF LEN(m$)=1 THEN m$ = "0"+m$
    IF LEN(y$)=2 THEN y$ = "20"+y$

    FUNCTION = y$+"-"+m$+"-"+d$
END FUNCTION
'==============================================================================
FUNCTION sqlTimeStamp() AS STRING
    'current SQL Time Stamp = "2005-11-30 17:15:46"
    FUNCTION = sqlDate(DATE$) +" "+ TIME$
END FUNCTION
'==============================================================================
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'CLASSES
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'Connection Class
'==============================================================================
CLASS CSQLLConnect
    INSTANCE hDb		AS LONG
	 INTERFACE ISQLLConnect '$SQLLConnectIfaceGUID
	   INHERIT iUnknown            ' inherit the base class
'------------------------------------------------------------------------------
      METHOD sqlOpen( BYVAL sFileSpec AS STRING ) AS LONG
		  LOCAL szFileSpec AS ASCIIZ * 400

        ''' create or open database
        ''' set database handle
        ''' success=>0 Handle to Db / error=0
        szFileSpec = sFileSpec
        IF sqlite3_open( szFileSpec, hDb ) = 0 THEN
		    METHOD = hDb
		  ELSE
		    METHOD = 0
		  END IF
		END METHOD
'------------------------------------------------------------------------------
      METHOD sqlClose( )
        IF ISTRUE hDb THEN
          ME.sqlExe("commit")
          sqlite3_close(hDb)
          hDB = 0
        END IF
		END METHOD
'------------------------------------------------------------------------------
      METHOD sqlErrMsg( ) AS STRING
        'Thanks to Don Dickinson
        DIM pzErr AS ASCIIZ PTR

    ''' get the SQLite error message
    ''' ? sqlErrMsg(hDB)

       pzErr = sqlite3_errmsg(hDB)
       IF pzErr = 0 THEN
        METHOD = ""
       ELSE
        METHOD = @pzErr
       END IF
	  END METHOD
'------------------------------------------------------------------------------
      METHOD sqlExe( BYVAL sSql AS STRING ) AS LONG
        LOCAL lpTable    AS LONG PTR
        LOCAL lpErrorSz  AS LONG
        LOCAL RowCount&, ColCount&

        ''' execute no return SQL statement
        ''' success=-1 / error=0
        ''' ? sqlErrMsg(hDB)

        METHOD = IIF&( sqlite3_get_table(hDB, BYVAL STRPTR(sSQL), lpTable, RowCount&, ColCount&, lpErrorSz)=0, -1, 0 )
        sqlite3_free_table lpTable
  	   END METHOD


'------------------------------------------------------------------------------
	 END INTERFACE
END CLASS
'==============================================================================
'RecordSet Class
'==============================================================================

CLASS CSQLLRecordSet
  INSTANCE sqlData() AS STRING
  INSTANCE ColNames() AS STRING
  INSTANCE RowCount, ColCount, Ndx, IsEof, IsBof, HasKey AS LONG
  INSTANCE hDB AS DWORD


	 INTERFACE ISQLLRecordSet '$SQLLRecordSetIfaceGUID
	   INHERIT iUnknown            ' inherit the base class
'==============================================================================

		PROPERTY SET DbHandle( BYVAL Value AS DWORD)
		  hDB = Value
		END PROPERTY
'------------------------------------------------------------------------------
      PROPERTY GET RowCount() AS LONG
		  PROPERTY = RowCount
		END PROPERTY
'------------------------------------------------------------------------------
      PROPERTY GET ColCount() AS LONG
		  property = ColCount
		END PROPERTY
'------------------------------------------------------------------------------
      PROPERTY GET IsEof() AS LONG
		  property = IsEof
		END PROPERTY
'------------------------------------------------------------------------------
      PROPERTY GET IsBof() AS LONG
		  property = IsBof
		END PROPERTY
'------------------------------------------------------------------------------
      PROPERTY GET Ndx() AS LONG
		  property = Ndx
		END PROPERTY
'------------------------------------------------------------------------------
      PROPERTY GET HasKey() AS LONG
		  property = HasKey
		END PROPERTY

'------------------------------------------------------------------------------
      METHOD sqlErrMsg() AS STRING
        'Thanks to Don Dickinson
        DIM pzErr AS ASCIIZ PTR

    ''' get the SQLite error message
    ''' ? sqlErrMsg(hDB)

       pzErr = sqlite3_errmsg(hDB)
       IF pzErr = 0 THEN
        METHOD = ""
       ELSE
        METHOD = @pzErr
       END IF
	  END METHOD

'------------------------------------------------------------------------------
	 METHOD sqlRecSetClear()
	   'DIM Dummy( 1 TO -1) AS STRING
		'vDataArray = Dummy()
		'vColArray = Dummy()
		ERASE ColNames()
		ERASE sqlData()
		RowCount = 0
		ColCount = 0
		Ndx = -1
		IsEof = -1
		IsBof = -1
		HasKey = 0
	 END METHOD
'------------------------------------------------------------------------------
    METHOD sqlFix( BYVAL sString AS STRING) AS STRING
      ''' fix single quotes
      REPLACE "'" WITH "''" IN sString
      METHOD = sString
	END METHOD

'------------------------------------------------------------------------------
    METHOD sqlSelect(BYVAL sSql AS STRING ) AS LONG
      LOCAL i, x       AS LONG
      LOCAL lpTable    AS LONG PTR     ' Array of fields returned from get_table (starts with column names)
      LOCAL lpErrorSz  AS LONG         ' Error msg
      LOCAL pzField    AS ASCIIZ PTR   ' Field return from get_table (element in lpTable array)
      LOCAL lRow, lCol AS LONG

'
    ''' execute query and return record set
    '''
    ''' success=-1 / error=0
    '''
    ''' number rows = tRS.RowCount
    ''' number coulmns = tRS.ColCount
'
    ''' thanks to Terence McDonnell
'
    ME.sqlRecSetClear
    IF ISFALSE hDB THEN EXIT METHOD
'
    IF sqlite3_get_table(hDB, BYVAL STRPTR(sSQL), lpTable, RowCount, ColCount, lpErrorSz)<>0 THEN
        METHOD = 0
    ELSEIF RowCount=0 THEN
        METHOD = -1
        sqlite3_free_table lpTable
    ELSE
   'column names

		  REDIM ColNames(1 TO ColCount)

        FOR i=1 TO ColCount
            pzField = @lpTable[i-1]
				ColNames(i) = @pzField
        NEXT i

    'data

		  REDIM sqlData(1 TO RowCount,1 To ColCount)
        x = ColCount 'skip col row
        lRow = 1
        FOR i = 1 TO RowCount
            FOR lCol=1 TO ColCount
                pzField = @lpTable[x]
					 sqlData(lRow,lCol) = @pzField
                INCR x
            NEXT j
            INCR lRow
        NEXT i


        METHOD = -1
        IF LCASE$(ColNames(1)) = "rowid" THEN
            HasKey = -1
        ELSE
            HasKey = 0
        END IF
        sqlite3_free_table lpTable
      END IF
	 END METHOD
'------------------------------------------------------------------------------
    METHOD MoveFirst()
      'move first row
      Ndx = 1
      IsBof = 0
      IsEof = 0
      IF RowCount < 1 THEN
        IsBof = -1
        IsEof = -1
      ELSEIF Ndx > RowCount THEN
        IsEof = -1
      END IF
	 END METHOD
'------------------------------------------------------------------------------
    METHOD MoveNext()
      'move next row
      INCR Ndx
      IsBof = 0
      IsEof = 0
      IF RowCount < 1 THEN
        IsBof = -1
        IsEof = -1
      ELSEIF Ndx < 1 THEN
        IsBof = -1
      ELSEIF Ndx > RowCount THEN
        IsEof = -1
      END IF
	 END METHOD
'------------------------------------------------------------------------------
    METHOD MovePrev()
      'move backwards
      DECR Ndx
      IsBof = 0
      IsEof = 0
      IF RowCount<1 THEN
        IsBof = -1
        IsEof = -1
      ELSEIF Ndx<1 THEN
        IsBof = -1
      ELSEIF Ndx>RowCount THEN
        IsEof = -1
      END IF
	 END METHOD
'------------------------------------------------------------------------------
    METHOD MoveTo(BYVAL lMoveTo AS LONG )
      'move to lMoveTo
      Ndx = lMoveTo
      IsBof = 0
      IsEof = 0
      IF RowCount<1 THEN
        IsBof = -1
        IsEof = -1
      ELSEIF Ndx<1 THEN
        IsBof = -1
      ELSEIF Ndx>RowCount THEN
        IsEof = -1
      END IF
	 END METHOD
'------------------------------------------------------------------------------
    METHOD MoveLast()
      'move to last row
      Ndx = RowCount
      IsBof = 0
      IsEof = 0
      IF RowCount<1 THEN
        IsBof = -1
        IsEof = -1
      ELSEIF Ndx<1 THEN
        IsBof = -1
      ELSEIF Ndx>RowCount THEN
        IsEof = -1
      END IF
	 END METHOD
'------------------------------------------------------------------------------
    METHOD ColNo(BYVAL sColName AS STRING ) AS LONG
      ''' get column number from record set column list
      ''' return 0 = not found
	   LOCAL x AS LONG

	   ARRAY SCAN ColNames(), COLLATE UCASE, =UCASE$(sColName), TO x
      METHOD = x
	 END METHOD
'------------------------------------------------------------------------------
    METHOD ColName( BYVAL lColNo AS LONG ) AS STRING
      ''' get column name from record set column list
      ''' return "" = not found
		METHOD = ColNames(lColNo)
    END METHOD
'------------------------------------------------------------------------------
    METHOD sqlGet( BYVAL sColName AS STRING ) AS STRING
      LOCAL x AS LONG

      'get column value by column name

      x = ME.ColNo(sColName)
      iF x<1 THEN EXIT METHOD
	   METHOD = sqlData(Ndx,x)

	 END METHOD
'------------------------------------------------------------------------------
    METHOD sqlGetAt( BYVAL lColNo AS LONG ) AS STRING
      'get column value by column number
      'first column = 1

       METHOD = sqlData(Ndx,lColNo)
    END METHOD
'------------------------------------------------------------------------------
    METHOD sqlSet( BYVAL sColName AS STRING, BYVAL sValue AS STRING )
      LOCAL x AS LONG
      'set column value by column name
		x = ME.ColNo(sColName)
      IF x<1 THEN EXIT METHOD
      sqlData(Ndx,x) = sValue
	 END METHOD
'------------------------------------------------------------------------------
    METHOD sqlSetAt( BYVAL lColNo AS LONG, BYVAL sValue AS STRING )
      'set column value by column number
      'first column = 1
		 sqlData(Ndx,lColNo) = sValue
    END METHOD
'------------------------------------------------------------------------------
    METHOD sqlUpdateRow( BYVAL sTable AS STRING ) AS LONG
      LOCAL i AS LONG
      LOCAL sSql AS STRING
      LOCAL sKeyVal AS STRING

      ' update current row
      ' [rowid] must be the first column in record set
      ' "SELECT rowid,* FROM MyTable"
      ' rowid won't be in results unless you specifically ask for it
      '
      ' WARNING: you shouldn't use sqlUpdateRow() if you use direct
      ' SQL statements to modify the Table while moving through a
      ' RecordSet
      '
      ' Either use direct SQL statements OR sqlUpdateRow(), NOT both.
      '
      IF ISFALSE HasKey THEN EXIT METHOD
      IF ColCount<2 THEN EXIT METHOD

      sKeyVal = ME.sqlGetAt(1)
      sSql = "update ["+sTable+"] set "
      FOR i=2 TO ColCount
        sSql = sSql + "["+ME.ColName(i)+"]='"+ME.sqlFix(ME.sqlGetAt(i))+"', "
      NEXT i
      sSql = RTRIM$(sSql,", ") + " where rowid="+sKeyVal
      METHOD = ME.sqlExe( sSql)
	 END METHOD
'------------------------------------------------------------------------------
    METHOD sqlUpdateRecSet( BYVAL sTable AS STRING ) AS LONG
      ' update whole record set
      '
      'WARNING: you shouldn't use sqlUpdateRecSet() if you use direct
      'SQL statements to modify the Table while moving through a
      'RecordSet
      '
      'Either use direct SQL statements OR sqlUpdateRecSet(), NOT both
      '
      IF ISFALSE hDB THEN EXIT METHOD
      ME.MoveFirst
      WHILE NOT IsEof
        IF ISFALSE ME.sqlUpdateRow(sTable) THEN EXIT METHOD
          ME.MoveNext
      WEND
      METHOD = -1
	 END METHOD
'------------------------------------------------------------------------------
      METHOD sqlExe( BYVAL sSql AS STRING ) AS LONG
        LOCAL lpTable    AS LONG PTR
        LOCAL lpErrorSz  AS LONG
        LOCAL RowCount&, ColCount&

        ''' execute no return SQL statement
        ''' success=-1 / error=0
        ''' ? sqlErrMsg(hDB)

        METHOD = IIF&( sqlite3_get_table(hDB, BYVAL STRPTR(sSQL), lpTable, RowCount&, ColCount&, lpErrorSz)=0, -1, 0 )
        sqlite3_free_table lpTable
  	   END METHOD

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

'------------------------------------------------------------------------------
	 END INTERFACE
END CLASS
'==============================================================================

SQLTest13.bas

Code:

' SED_PBCC ' Use PBCC compiler
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'This is a small SQLite example using Classes built around Stan Durham's excellent code.
'I am sure many improvements can and will be implemented in the future as new and
'old PowerBASIC Programmers discover the Power of the PowerBASIC Class implementation.
'This was coded very early in the beta cycle and I have not made any changes but
'all seems well.
'******************************************************************************
'                               James C. Fuller
'                             [email protected]
'                                August 4,2008
'******************************************************************************

'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
#DIM ALL
#COMPILE EXE
#DEBUG ERROR ON
#TOOLS OFF
#INCLUDE "sqliteclass_02.inc"

%MAXRECORDS = 1000
%TESTRECORDS = 50
$DataFile = "TemperatureDat.Txt"
'==============================================================================
FUNCTION _
  AddTemps ( _
    BYVAL hDB AS LONG _
    ) AS LONG

    LOCAL i,j,k,ff1,Count AS LONG
    LOCAL sSql,sLineIn AS STRING
    DIM oRs	AS ISQLLRecordSet

	 oRs = CLASS "CSQLLRecordSet"
	 oRs.DbHandle = hDB


    ff1 = FREEFILE
	IF ISFILE($DataFile) = 0 THEN
		PRINT "No Data File -> " $DataFile
		WAITKEY$
		EXIT FUNCTION
	END IF

    OPEN $DataFile FOR INPUT AS ff1

    FILESCAN ff1, RECORDS TO j

    PRINT "Records = ";j
    IF j > %MAXRECORDS THEN
		j = %MAXRECORDS
	END IF
    PRINT "Working .";
    oRs.sqlExe("begin")
    FOR i = 1 TO %MAXRECORDS

      LIne INPUT# ff1 ,sLineIn

      IF LEN(sLineIn) = 0 THEN
        EXIT FOR
      END IF
      sSql = "insert into  MyTemps(Date,Time,T_In,H_In,T_Out,H_Out) values ("+sLineIn+")"
      IF ISFALSE oRs.sqlExe(sSql) THEN
         ? oRs.sqlErrMsg()
         EXIT FOR
      END IF
     IF (i MOD 100) = 0  THEN
      PRINT ".";
    END IF

    NEXT i
    CLOSE #ff1
    PRINT "Before Commit"
	oRs.sqlExe("commit")
	PRINT "After Commit"


END FUNCTION
'==============================================================================
'Traverse the MyTemps Table
SUB TestDb(BYVAL hDB AS LONG)
    LOCAL i,j AS LONG
    LOCAL sSql AS STRING
    LOCAL s AS STRING
    LOCAL zPtr AS ASCIIZ PTR
    DIM oRs	AS ISQLLRecordSet

	  oRs = CLASS "CSQLLRecordSet"

	 oRs.DbHandle = hDB

    sSql = "select rowid,* from MyTemps"
    IF ISFALSE oRs.sqlSelect( sSql ) THEN
        ? oRs.sqlErrMsg()
        EXIT SUB
    END IF

    ? "rs.RowCount, rs.ColCount"
    ? oRs.RowCount, oRs.ColCount
    ? "move forward"
    oRs.MoveFirst
    WHILE ISFALSE oRs.IsEof
        s=""
        s = s + oRs.sqlGet("rowid") + ", "
        s = s + oRs.sqlGet("Date") + ", "
        s = s + oRs.sqlGet("Time") + ", "
        s = s + oRs.sqlGet("T_Out")

        ? s
        oRs.MoveNext
		IF INSTAT THEN
			EXIT SUB
		END IF
		INCR j
		IF j > %TESTRECORDS THEN
			EXIT LOOP
		END IF
    WEND
	j = 0
    ? "move backward"
    oRs.MoveLast
    WHILE ISFALSE oRs.IsBof
        s=""
        s = s + oRs.sqlGet("rowid") + ", "
        s = s + oRs.sqlGet("Date") + ", "
        s = s + oRs.sqlGet("Time") + ", "
        s = s + oRs.sqlGet("T_Out")
        ? s
        oRs.MovePrev
		IF INSTAT THEN
			EXIT SUB
		END IF
		INCR j
		IF j > %TESTRECORDS THEN
			EXIT LOOP
		END IF
    WEND
	j = 0
    ? "loop through record set"
    ? "get value by column number"
    FOR i=1 TO oRs.RowCount
        oRs.MoveTo i
        s=""
        s = s + oRs.sqlGetAt(1) + ", "
        s = s + oRs.sqlGetAt(2) + ", "
        s = s + oRs.sqlGetAt(3) + ", "
        s = s + oRs.sqlGetAt(6)
        ? s
		IF INSTAT THEN
			EXIT SUB
		END IF
        IF i > %TESTRECORDS THEN
			EXIT FOR
		END IF
    NEXT i

END SUB
'==============================================================================
Sub FindHiLo(BYVAL hDb AS DWORD,ByVal sDate As String)

   DIM oRs	AS ISQLLRecordSet
	LOCAL sSql,sLoTime,sHiTime As String
	LOCAL iRowId As Long
	LOCAL nHi,nLo,nVal As Single
     oRs = CLASS "CSQLLRecordSet"
   oRs.DbHandle = hDB

	nHi = -99
	nLo = 150
	sSql = BUILD$("select rowid,* from MyTemps where Date = ",$SQ,sDate,$SQ)
   if oRs.sqlSelect( sSql ) = 0 then
     Print oRs.sqlErrMsg()
     Exit sub
   END If
   If oRs.RowCount = 0 Then
   	Exit sub
   End If

   oRs.MoveFirst
	While oRs.IsEof = 0
		nVal = Val(oRs.sqlGet("T_Out"))
		If nVal < nLo Then
			nLo = nVal
			sLoTime = oRs.sqlGet("Time")
		End If
		If nVal > nHi Then
			nHi = nVal
			sHiTime  = oRs.sqlGet("Time")
		End If
		oRs.MoveNext
	Wend
	Print "High Temperature for "+ sDate + " was "+FORMAT$(nHi,"###.00")+ " at " + sHiTime
	Print "Low  Temperature for "+ sDate + " was "+FORMAT$(nLo,"###.00")+ " at " + sLoTime

END SUB

'==============================================================================
FUNCTION PBMAIN()
  DIM oDb AS ISQLLConnect
  DIM oRs	AS ISQLLRecordSet
  LOCAL hDb,RetVal AS LONG
  LOCAL sSql,sLineIn	AS STRING
  LOCAL ErrFlag,ff1,i AS lONG

  TRACE NEW "SQLT07_TRACE.TXT"


	oDb = CLASS "CSQLLConnect"

    hDB = oDb.sqlOpen( "MyTempDB.db")
    IF ISFALSE hDB THEN
        ? "unable to open db"
		  GOTO AllDone
	 ELSE
	     ? "Was Ok"
    END IF

	 'Create Table
    sSql = "create table MyTemps (Date DATE, Time TIME, T_In REAL, H_In INTEGER,T_Out REAL,H_Out INTEGER)"
    IF ISFALSE oDb.sqlExe(sSql) THEN
        IF oDb.sqlErrMsg() <> "table MyTemps already exists" THEN
			GOTO AllDone
		END IF
	ELSE
		AddTemps hDB
		PRINT "MyTemps Table Created"
		PRINT "Any Key to Continue"
		WAITKEY$
    END IF
	TestDb hDB
	FindHiLo hDb,"2006-06-18"

AllDone:
  oDb.sqlClose
  'Below is Not really needed here.
  'Objects are deleted when they loose scope just like normal variables
  'I use the below to check things in the CLASS METHOD DESTROY before the
  'app ends
  oDb = NOTHING
  oRs = NOTHING
  TRACE CLOSE
  ? "Ok -> Any Key"

  WAITKEY$
END FUNCTION
'==============================================================================

Attached Files

sqliteTest.zip (116.3 KB, 100 views)

Tags: None

Previous template Next

Announcement

Forum Guidelines

SQLite Wrapper

SQLite Wrapper