PBWin/PBCC lite SQLite Class

[Stanley Durham]

'SQLiteClass1.inc
Declare Function sqlite3_open CDecl Lib "sqlite3.dll" Alias "sqlite3_open" (zFilename As Asciiz, mHDB As Long) As Long
Declare Sub      sqlite3_close CDecl Lib "sqlite3.dll" Alias "sqlite3_close" (ByVal mHDB As Long)
Declare Function sqlite_get_table CDecl Lib "sqlite3.dll" Alias "sqlite3_get_table" (ByVal mHDB As Long, szSql As Asciiz, lpTable As Long, nRow As Long, nColumn As Long, lpErrMsg As Long) As Long
Declare Function sqlite_free_table CDecl Lib "sqlite3.dll" Alias "sqlite3_free_table" (ByVal lpTable As Long Ptr) As Long
Declare Function sqlite3_errmsg CDecl Lib "sqlite3.dll" Alias "sqlite3_errmsg" (ByVal mHDB As Long) As Long
    'simple little class for working with local SQLite databases
    '   need: latest DLL from SQLite.org
    '
    '   check [URL]http://planetsquires.com/[/URL] for heavy duty SQLite work
    '
    'Open("database");
    '   opens existing database
    '   creates database and opens it if file doesn't exist
    '
    'Execute(); execute SQL statement that doesn't return a result: "CREATE TABLE ..."
    'Quickie(); execute statement that only returns one result: "SELECT COUNT(*)"
    '
    'Queries:
    '   SelectBegin("select * from ...") : Queries must be closed; SelectEnd()
    '
    '   RowCount() = number of rows in query results
    '   ColumnCount() = number of columns in query results
    '
    '   First(), Next(), Last(), Previous(); move around query results
    '   Get() or GetAt() to get column's value in query results
    '
    '
    'query results indexes are ONE based
    '   first row = 1; first column in result = 1
    '
    'you can use Column Name or the order of the Column in the statement to get a column's value
    '   Get("name"); GetAt(1)
Class SQLiteDatabaseC
    Instance mHDB As Long
    Instance mPTable As Long Ptr
    Instance mColumns() As String
    Instance mRowCount As Long
    Instance mColCount As Long
    Instance mRowNo As Long
    Instance mFirstCol As Long
    Interface SQLiteDatabaseI
        Inherit IUnknown
        Method Open(ByVal file As String) As Long
            'Create or Open a database file
            'True/False success
            If Len(file) Then
                If sqlite3_open(ByVal StrPtr(file), mHDB) = 0 Then
                    Method = 1
                Else
                    mHDB = 0
                End If
            End If
        End Method
        Method Close()
            'close database file
            sqlite3_close(mHDB)
            mHDB = 0
        End Method
        Method ErrorMessage() As String
            'return last error message
            'Thanks to Don Dickinson
            Local pzErr As Asciiz Ptr
            pzErr = sqlite3_errmsg(mHDB)
            If pzErr Then Method = @pzErr
        End Method
        Method Fix(ByVal s As String) As String
            'escape single quotes in string
            Replace "'" With "''" In s
            Method = s
        End Method
        Method Execute(ByVal sql As String) As Long
            'execute an SQL statement with NO return
            'True/False success
            '   "CREATE TABLE ...", "BEGIN TRANSACTION", "END TRANSACTION", ...etc
            Local lpTable    As Long Ptr
            Local lpErrorSz  As Long
            Local RowCount&, ColCount&
            Method = IIf&( sqlite_get_table(mHDB, ByVal StrPtr(sql), lpTable, RowCount&, ColCount&, lpErrorSz)=0, 1, 0 )
            sqlite_free_table lpTable
        End Method
        Method Quickie(ByVal sql As String) As String
            'return a value from an SQL statement that will have only one return
            '   SELECT COUNT(*) ...
            If me.SelectBegin(sql) And me.First() Then Method = me.GetAt(1)
            me.SelectEnd()
        End Method
        Method SelectBegin(ByVal sql As String) As Long
            'execute a query and return a record set
            '   MUST be freed: SelectEnd()
            'True/False success
            '   thanks to Terence McDonnell
            Local i As Long
            Local lpErrorSz  As Long
            Local pzCol As Asciiz Ptr
            mPTable = 0
            Erase mColumns()
            mRowCount = 0
            mColCount = 0
            mRowNo = 0
            mFirstCol = 0
            If Len(sql) Then
                If sqlite_get_table(mHDB, ByVal StrPtr(sql), mPTable, mRowCount, mColCount, lpErrorSz) = 0 Then
                    If mRowCount = 0 Then
                        Method = 1 'command succeed - no return
                        sqlite_free_table mPTable
                    Else
                        ReDim mColumns(1 To mColCount)
                        For i = 1 To mColCount
                            pzCol = @mPTable[i - 1]
                            mColumns(i) = @pzCol
                        Next i
                        Method = 1
                    End If
                End If
            End If
        End Method
        Method SelectEnd()
            'close query
            '   MUST close queries to free sqlite internal table
            If mRowCount Then sqlite_free_table mPTable
            mPTable = 0
            Erase mColumns()
            mRowCount = 0
            mColCount = 0
            mRowNo = 0
            mFirstCol = 0
        End Method
        Method RowCount() As Long
            'get query result row count
            Method = mRowCount
        End Method
        Method ColumnCount() As Long
            'get query result column count
            Method = mColCount
        End Method
        Method First() As Long
            'move to first row in query results
            'True/False success
            If mRowCount Then
                mRowNo = 1
                mFirstCol = mRowNo * mColCount
                Method = 1
            End If
        End Method
        Method Last() As Long
            'move to last row in query results
            'True/False success
            If mRowCount Then
                mRowNo = mRowCount
                mFirstCol = mRowNo * mColCount
                Method = 1
            End If
        End Method
        Method Next() As Long
            'move to next row in query results
            'True/False success
            If mRowCount Then
                Incr mRowNo
                If mRowNo > 0 And mRowNo <= mRowCount Then
                    mFirstCol = mRowNo * mColCount
                    Method = 1
                End If
            End If
        End Method
        Method Previous() As Long
            'move to previous row in query results
            'True/False success
            If mRowCount Then
                Decr mRowNo
                If mRowNo > 0 And mRowNo <= mRowCount Then
                    mFirstCol = mRowNo * mColCount
                    Method = 1
                End If
            End If
        End Method
        Method GoTo(ByVal row As Long) As Long
            'move to row in query results
            'True/False success
            If mRowCount And row > 0  And row <= mRowCount Then
                mRowNo = row
                mFirstCol = mRowNo * mColCount
                Method = 1
            End If
        End Method
        Method Get(ByVal Column As String) As String
            'get value for column on current row of query results
            If mRowNo > 0 And mRowNo <= mRowCount Then
                Local x, ndx As Long
                x = me.ColumnNo(Column)
                ndx = mFirstCol + x - 1
                Local pzCol As Asciiz Ptr
                pzCol = @mPTable[ndx]
                Method = @pzCol
            End If
        End Method
        Method pszGet(ByVal Column As String) As Long
            'get value for column on current row of query results
            'returns ASCIIZ ptr to value
            '   lot faster way to load ListView which is expecting an ASCIIZ ptr
            If mRowNo > 0 And mRowNo <= mRowCount Then
                Local x, ndx As Long
                x = me.ColumnNo(Column)
                ndx = mFirstCol + x - 1
                Method = @mPTable[ndx]
            End If
        End Method
        Method GetAt(ByVal columnNo As Long) As String
            'get value for columnNo on current row of query results
            If mRowNo > 0 And mRowNo <= mRowCount Then
                If columnNo > 0 And columnNo <= UBound(mColumns) Then
                    Local ndx As Long
                    ndx = mFirstCol + columnNo - 1
                    Local pzCol As Asciiz Ptr
                    pzCol = @mPTable[ndx]
                    Method = @pzCol
                End If
            End If
        End Method
        Method pszGetAt(ByVal columnNo As Long) As Long
            'get value for columnNo on current row of query results
            'returns ASCIIZ ptr to value
            '   lot faster way to load ListView which is expecting an ASCIIZ ptr
            If mRowNo > 0 And mRowNo <= mRowCount Then
                If columnNo > 0 And columnNo <= UBound(mColumns) Then
                    Local ndx As Long
                    ndx = mFirstCol + columnNo - 1
                    Method = @mPTable[ndx]
                End If
            End If
        End Method
        Method ColumnNo(ByVal Column As String) As Long
            'return position of column in query results
            'zero if not found
            'ToDo: replace with hash or trie
            Local x As Long
            Array Scan mColumns(), Collate UCase, = Column, To x
            Method = x
        End Method
        Method Column(ByVal columnNo As Long) As String
            'get column name for columnNo in query results
            'ONE based index
            If columnNo > 0 And columnNo <= UBound(mColumns) Then Method = mColumns(columnNo)
        End Method
    End Interface
End Class

[Stanley Durham]

'SQLiteTest.bas

 
#PBForms CREATED V1.51
'pbwin 9
$TestSource = "SQLiteTest.bas"
$TestTitle = "SQLite Class Test"
#Compile Exe "SQLiteTest.exe"
#Dim All
#Optimize Speed
#Include Once "SQLiteClass1.inc"
#PBForms BEGIN INCLUDES
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "PBForms.INC"
#PBForms END INCLUDES
#PBForms BEGIN CONSTANTS
%Dlg1    =  101
%BtnTest = 1002
%Lbx1    = 1001
#PBForms END CONSTANTS
Declare CallBack Function ShowDlg1Proc()
Declare Function ShowDlg1(ByVal hParent As Dword) As Long
#PBForms DECLARATIONS
Global lbx As LBxI
Global tmr As TimerI
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
Sub BtnTest(ByVal hDlg As Long)
    Local i, j, ok As Long
    Local file As String
    Local Col1, Col2 As String
    Local s As String
    Randomize
    lbx.Clear(2)
    Local db As SQLiteDatabaseI : db = Class "SQLiteDatabaseC"
    If IsNothing(db) Then
        ? "database object IsNothing"
        Exit Sub
    End If
    'open database - create database if it doesn't exist
    file = EXE.Path$ + "TestDB.SQLite"
    If db.Open(file) = %FALSE Then
        ? "fail to open database" : Exit Sub
    End If
    'you can use Execute() to execute an SQL statement that doesn't return a result
    db.Execute("drop table Table1")
    db.Execute("create table Table1 (Col1 text, Col2 txt)")
    For i = 1 To 10
        Col1 = ""
        Col2 = ""
        For j = 1 To 5
            Col1 += Chr$(Rnd(Asc("a"), Asc("z")))
            Col2 += Chr$(Rnd(Asc("a"), Asc("z")))
        Next j
        db.Execute("insert into Table1 (Col1, Col2) values ('"+Col1+"', '"+Col2+"')")
    Next i
    'quickie SQL query; for queries that only return one value
    lbx.Add( "Row Count = " + db.Quickie("select count(*) from Table1") )
    If IsFalse db.SelectBegin("select * from Table1") Then
        lbx.Add(db.ErrorMessage())
        ? "query failed" : Exit Sub
    End If
    lbx.Add("")
    lbx.Add("Query 1:")
    ok = db.First()
    While ok
        s = "| "
        s += db.GetAt(1)
        s += " | "
        s += db.GetAt(2)
        s += " |"
        lbx.Add(s)
        ok = db.Next()
    Wend
    lbx.Add("!!! absolutely must free a SelectBegin() query !!!: SelectEnd()")
    lbx.Add("     that frees SQLite's internal result table")
    lbx.Add("  Execute() and Quickie() automatically free SQLite table")
    db.SelectEnd()
    
    db.SelectBegin("select * from Table1 order by Col1, Col2")
    lbx.Add("")
    lbx.Add("Query 1: Backwards")
    ok = db.Last()
    While ok
        s = "| "
        s += db.Get("col1")
        s += " | "
        s += db.Get("col2")
        s += " |"
        lbx.Add(s)
        ok = db.Previous()
    Wend
    db.SelectEnd()
    'close database
    db.Close()
    lbx.Add("")
    lbx.Add("done...")
End Sub
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_InitDialog
             lbx = Class "LBxC"
             lbx.INI(Cb.Hndl, %Lbx1)
             lbx.SetHorizontal(1000)
             tmr = Class "TimerC"
        Case %WM_NCActivate
            Static hWndSaveFocus As Dword
            If IsFalse CbWParam Then
                hWndSaveFocus = GetFocus()
            ElseIf hWndSaveFocus Then
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            End If
        Case %WM_Command
            Select Case As Long CbCtl
                Case %BtnTest
                    If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                        BtnTest(Cb.Hndl)
                    End If
            End Select
    End Select
End Function
Function ShowDlg1(ByVal hParent As Dword) As Long
    Local lRslt  As Long
#PBForms BEGIN DIALOG %Dlg1->->
    Local hDlg   As Dword
    Local hFont1 As Dword
    Dialog New hParent, $TestTitle, 67, 61, 341, 241, %WS_Popup _
        Or %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or _
        %WS_MinimizeBox 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 ListBox, hDlg, %Lbx1, , 5, 5, 330, 210, %WS_Child Or _
        %WS_Visible Or %WS_HScroll Or %WS_VScroll Or %LBS_Notify Or _
        %LBS_NoIntegralHeight, %WS_Ex_ClientEdge Or %WS_Ex_Left Or _
        %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar
    Control Add Button,  hDlg, %BtnTest, "Test", 275, 220, 60, 15
    hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    Control Send hDlg, %Lbx1, %WM_SETFONT, hFont1, 0
#PBForms END DIALOG
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
#PBForms BEGIN CLEANUP %Dlg1
    DeleteObject hFont1
#PBForms END CLEANUP
    Function = lRslt
End Function
Class LBxC
    Instance meHDlg As Long
    Instance meID As Long
    Interface LBxI
        Inherit IUnknown
        Method INI(ByVal hDlg As Long, ByVal Id As Long)
            meHDlg = hDlg
            meID = Id
        End Method
        Method SetHorizontal(ByVal Count As Long)
            Local hCntrl&
            Control Handle meHDlg, meID To hCntrl&
            SendMessage hCntrl&, %LB_SETHORIZONTALEXTENT, Count, 0
        End Method
        Method Clear(Opt doEventsCount As Long)
            ListBox Reset meHDlg, meID
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
        Method Add(ByVal s As String, Opt doEventsCount As Long) As String
            ListBox Add meHDlg, meID, s
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
    End Interface
    Class Method DoEventsCount(ByVal Count As Long)
        Local i As Long
        For i = 1 To Count
            Dialog DoEvents
        Next i
    End Method
End Class
Class TimerC
    Instance meTime As Double
    Interface TimerI
        Inherit IUnknown
        Method Start()
            meTime = Timer
        End Method
        Method Get() As String
            Method = "    Time: " + Format$(Timer - meTime, "###.###############")
        End Method
    End Interface
End Class