'SQLite3VB.dll declarations------------------------------------------------
Private Declare Sub sqlite3_open Lib "SQLite3VB.dll" _
                                 (ByVal FileName As String, _
                                  ByRef handle As Long)
Private Declare Sub sqlite3_close Lib "SQLite3VB.dll" _
                                  (ByVal DB_Handle As Long)
Private Declare Function sqlite3_last_insert_rowid _
                          Lib "SQLite3VB.dll" _
                              (ByVal DB_Handle As Long) As Long
Private Declare Function sqlite3_changes _
                          Lib "SQLite3VB.dll" _
                              (ByVal DB_Handle As Long) As Long
Private Declare Function sqlite_get_table _
                          Lib "SQLite3VB.dll" _
                              (ByVal DB_Handle As Long, _
                               ByVal SQLString As String, _
                               ByRef ErrStr As String) As Variant()
'Now returns a BSTR
Private Declare Function sqlite_libversion _
                          Lib "SQLite3VB.dll" () As String
'// This function returns the number of rows from the last sql statement.
'// Use this to ensure you have a valid array
Private Declare Function number_of_rows_from_last_call _
                          Lib "SQLite3VB.dll" () As Long
'holding all the DB handles and paths
Private collSQLiteDB As Collection
Private lLastDBHandle As Long

Function OpenDB(strDB As String, _
                Optional bClose As Boolean) As Long

   Dim i As Long
   Dim lDBHandle As Long
   Dim strTempCurDrive As String
   Dim strTempCurDir As String
   Dim strErrors As String
   Dim bFile As Boolean
   Dim strLocalDrive As String
   Dim arr(1 To 2) As Variant

   'can do this, but it makes it no faster
   '--------------------------------------
   '   If bClose Then
   '      Exit Function
   '   End If

   On Error GoTo ERROROUT

   If collSQLiteDB Is Nothing Then
      Set collSQLiteDB = New Collection
   End If

   strTempCurDir = CurDir
   strTempCurDrive = Left$(strTempCurDir, 1)

   strLocalDrive = Left$(Application.path, 1)

   'this is to point to SQLite3VB.dll
   '---------------------------------
   ChDrive strLocalDrive
   ChDir strLocalDrive & ":\RBSSynergyReporting\Program\"

   If InStr(1, strDB, ":memory:", vbTextCompare) = 0 Then
      bFile = True
   End If

   If bClose Then
      For i = 1 To collSQLiteDB.count
         If collSQLiteDB(i)(2) = strDB Then
            sqlite3_close collSQLiteDB(i)(1)
            collSQLiteDB.Remove i
            Exit For
         End If
      Next
   Else
      If collSQLiteDB.count = 0 Then
         sqlite3_open strDB, lDBHandle
         arr(1) = lDBHandle
         arr(2) = strDB
         'for in case there was a duplicate key in the DB collection
         On Error Resume Next
         'so a db path can only be in the collection once
         collSQLiteDB.Add arr, strDB
         On Error GoTo ERROROUT
         OpenDB = lDBHandle
      Else
         'see if there is a valid connection already for this DB
         '------------------------------------------------------
         For i = 1 To collSQLiteDB.count
            If collSQLiteDB(i)(2) = strDB Then
               If collSQLiteDB(i)(1) > 0 Then
                  OpenDB = collSQLiteDB(i)(1)
                  ChDrive strTempCurDrive
                  ChDir strTempCurDir
                  Exit Function
               End If
               sqlite3_close collSQLiteDB(i)(1)
               collSQLiteDB.Remove i
            End If
         Next
         sqlite3_open strDB, lDBHandle
         arr(1) = lDBHandle
         arr(2) = strDB
         'for in case there was a duplicate key in the DB collection
         On Error Resume Next
         'so a db path can only be in the collection once
         collSQLiteDB.Add arr, strDB
         On Error GoTo ERROROUT
         OpenDB = lDBHandle
      End If
      'these speed up inserts enormously, particulary the second one
      '-------------------------------------------------------------
      sqlite_get_table lDBHandle, "PRAGMA page_size=4096;", strErrors
      sqlite_get_table lDBHandle, "PRAGMA synchronous=off;", strErrors
      sqlite_get_table lDBHandle, "PRAGMA encoding='UTF-8';", strErrors
      sqlite_get_table lDBHandle, "PRAGMA auto_vacuum = 0;", strErrors
      'sqlite_get_table lDBHandle, "PRAGMA vdbe_trace = OFF;", strErrors
      'not sure default_cache_size applies to a memory database, probably
not
      If bFile Then
         sqlite_get_table lDBHandle, _
                          "PRAGMA default_cache_size = 32768;", strErrors
      End If
   End If

   'to return to the CurDir at the start of the procedure
   '-----------------------------------------------------
   ChDrive strTempCurDrive
   ChDir strTempCurDir

   Exit Function
ERROROUT:

   ChDrive strTempCurDrive
   ChDir strTempCurDir

   MsgBox Err.Description, , "error number: " & Err.Number

End Function

Function AlterDB(strCommand As String, _
                 Optional lDBHandle, _
                 Optional strDB As String) As Variant

   Dim strError As String
   Dim lChanges As Long
   Dim lLastInsertRowID As Long
   Dim arr(1 To 3) As Variant

   On Error GoTo ERROROUT

   If lDBHandle <> lLastDBHandle Or lDBHandle = 0 Then
      lDBHandle = OpenDB(strDB)
   End If
   lLastDBHandle = lDBHandle

   sqlite_get_table lDBHandle, strCommand, strError

   If Len(strError) = 0 Then
      lChanges = sqlite3_changes(lDBHandle)
      lLastInsertRowID = sqlite3_last_insert_rowid(lDBHandle)
   End If

   arr(1) = lChanges
   arr(2) = lLastInsertRowID
   arr(3) = strError

   AlterDB = arr

   Exit Function
ERROROUT:

   arr(1) = lChanges
   arr(2) = lLastInsertRowID
   arr(3) = strError

   AlterDB = arr

End Function

Function GetFromDB(strSQL As String, _
                   Optional lReturnedRows As Long, _
                   Optional strError As String, _
                   Optional lDBHandle As Long, _
                   Optional strDB As String) As Variant

   Dim arr

   On Error GoTo ERROROUT

   If lDBHandle <> lLastDBHandle Or lDBHandle = 0 Then
      lDBHandle = OpenDB(strDB)
   End If
   lLastDBHandle = lDBHandle

   arr = sqlite_get_table(lDBHandle, strSQL, strError)

   If Len(strError) = 0 Then
      lReturnedRows = number_of_rows_from_last_call()
   End If

   If lReturnedRows = 0 Then
      lReturnedRows = -1
      GetFromDB = strError
   Else
      GetFromDB = arr
   End If

   Exit Function
ERROROUT:

   lReturnedRows = -1
   GetFromDB = strError

End Function

Sub TableSQL2Sheet()

   Dim strDB As String
   Dim lDBHandle As Long
   Dim lRows As Long
   Dim strError As String
   Dim strSQL As String
   Dim arr

   On Error GoTo ERROROUT

   If Go <> 1 Then
      Exit Sub
   End If

   SetSQLiteSearchDB
   strDB = strSQLiteSearchDB

   lDBHandle = OpenDB(strDB)

   If SQLiteTableExists("SQL", strDB, , True) = False Then
      MsgBoxDLL "There is no SQLite table called SQL", _
                "dump queries from table SQL to sheet", , , , , , , _
                uCLR.lClrMainForm
      FocusTreeview
      OpenDB strDB, True
      Exit Sub
   Else
      If SQLiteTableIsEmpty(strDB, "SQL", True) Then
         MsgBoxDLL "The SQLite table SQL is empty", _
                   "dump queries from table SQL to sheet", , , , , , , _
                   uCLR.lClrMainForm
         FocusTreeview
         OpenDB strDB, True
         Exit Sub
      End If
   End If

   strSQL = "SELECT STATEMENT_COUNT, DB, QUERY_TIME, QUERY_LENGTH, QUERY
FROM SQL"
   arr = GetFromDB(strSQL, lRows, strError, lDBHandle, strDB)

   If Len(strError) > 0 Then
      GoTo ERROROUT
   End If

   ArrayToSheet arr, , , , 2, , True, , True
   ThinBottomBorder Range(Cells(1), Cells(5))
   With Range(Cells(1), Cells(5))
      .Font.Bold = True
      .Interior.ColorIndex = 20
   End With
   With Range(Cells(1), Cells(lRows + 1, 5))
      .HorizontalAlignment = xlLeft
      .Name = "SQL_Dump"
   End With

   OpenDB strDB, True

   Exit Sub
ERROROUT:

   MsgBoxDLL "SQLite error: " & strError & vbCrLf & vbCrLf & _
             "DB handle: " & lDBHandle & vbCrLf & _
             "DB path: " & strDB, "error dumping the SQL table", , , , , , ,
_
             uCLR.lClrMainForm

   OpenDB strDB, True

End Sub

Function SQLiteTableExists(strTable As String, _
                           Optional strDB As String, _
                           Optional bStatement As Boolean, _
                           Optional bCurrentConnection As Boolean) As
Boolean

   Dim strSQL As String
   Dim lDBHandle As Long
   Dim lRows As Long
   Dim strError As String
   Dim arr

   On Error GoTo ERROROUT

   If Len(strTable) = 0 Then
      SQLiteTableExists = False
      Exit Function
   End If

   If bCurrentConnection = False Then
      lDBHandle = OpenDB(strDB)
   End If

   strSQL = "SELECT name FROM SQLITE_MASTER " & _
            "WHERE TYPE = 'table' AND NAME = '" & strTable & "'"

   If bStatement Then
      ShowStatement strSQL, , , 2, True, True
   End If

   arr = GetFromDB(strSQL, lRows, strError, lDBHandle, strDB)

   If lRows > 0 Then
      SQLiteTableExists = True
   End If

   If bCurrentConnection = False Then
      OpenDB strDB, True
   End If

   Exit Function
ERROROUT:

   If bCurrentConnection = False Then
      OpenDB strDB, True
   End If

End Function

Function SQLiteTableIsEmpty(strDB As String, _
                            strTable As String, _
                            Optional bNoNewConnection As Boolean, _
                            Optional bStatement As Boolean) As Boolean

   Dim strSQL As String
   Dim lDBHandle As Long
   Dim lRows As Long
   Dim strError As String
   Dim arr
   
   On Error GoTo ERROROUT

   strSQL = "SELECT (SELECT ROWID FROM '" & strTable & "' limit 1) IS NOT
NULL"

   If bNoNewConnection = False Then
      lDBHandle = OpenDB(strDB)
   End If

   If bStatement Then
      ShowStatement strSQL, , , 2, True, True
   End If
   
   arr = GetFromDB(strSQL, lRows, strError, lDBHandle, strDB)
   
   If Not arr(1, 0) = 1 Then
      SQLiteTableIsEmpty = True
   End If

   If bNoNewConnection = False Then
      OpenDB strDB, True
   End If

   Exit Function
ERROROUT:

   If bNoNewConnection = False Then
      OpenDB strDB, True
   End If
   
   SQLiteTableIsEmpty = True

End Function