2
\$\begingroup\$

SQLite C/ADO VBA library with reflection

The SQLiteCAdo library is a VBA middleware facilitating access to SQLite databases. Its two subpackages provide alternative connectivity options: via ADODB/SQLiteODBC and directly via the C-language API. My earlier project, SQLiteDB, is the predecessor of the SQLiteADO subpackage. The SQLite For Excel VBA module, in turn, served as an inspiration for the other major component of the library, SQLiteC (Fig. 1).

Library Structure
Figure 1. SQLiteCAdo library structure

The SQLiteADO subpackage (Fig. 2) includes

  • SQLiteODBC connection string helper and a limited ADODB wrapper (SQLiteADO core)
  • validation/integrity checking of SQLite database files
  • SQL-based introspection of SQLite databases and engines
SQLiteADO
Figure 2. SQLiteADO classes

The SQLiteDB predecessor project was started as a component for the SecureADODB library, and its ADODB wrapper facilitated introspection and some of the health checks. This wrapper prevented the formation of a circular dependency with SecureADODB but focused on internal needs. For this reason, present SQLiteADO does not handle parameterized queries and ADODB events/errors.

The SQLiteC subpackage (Fig. 3) incorporates an SQLite C-language API wrapper, covering all core features. SQLiteC supports parameterized queries and API-based introspection. It also implements the ILiteADO interface, making it possible to use both connectivity paths via the same interface (as illustrated in Fig. 1). The DllManager class takes care of DLL loading, and a CleanUp cascade resolves the circular references at the termination stage.

SQLiteC
Figure 3. SQLiteC classes

This project uses the RubberDuck VBA unit testing framework with early binding, so it is a required dependency. The SQLiteODBC driver is the other dependency (its bitness must match that of the used Excel version), though only the SQLiteADO subpackage requires it.

This post only covers the two managers, LiteMan and SQLiteC. The full source code along with dependencies is available from the GitHub repo and the project documentation - from the GitHub pages site.

This immediate pane command ?LiteMan(":mem:").ExecADO.GetScalar("SELECT sqlite_version()") returns the version of the SQLite library used by the SQLiteODBC driver (usually embedded), e.g., 3.35.5, while this command ?SQLiteC("").CreateConnection(":mem:").ExecADO.GetScalar("SELECT sqlite_version()") returns the version of the SQLite library loaded by the project, e.g., 3.37.0.

Functionally, these two managers are loosely similar to UnitOfWork/SecureADODB. Their primary focus is setup/teardown, so both of them have some functionality that should probably be factored out. I have not yet made any attempts to optimize the library performance, and I think it is too early to worry about it.

LiteMan

'@Folder "SQLite.ADO"
'@ModuleDescription "Provides shortcuts for common operations."
'@PredeclaredId
'@IgnoreModule ValueRequired: False positive with ADO
'@IgnoreModule IndexedDefaultMemberAccess, FunctionReturnValueDiscarded
'@IgnoreModule ProcedureNotUsed
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SQLGetInstalledDrivers Lib "ODBCCP32" ( _
 ByVal lpszBuf As String, ByVal cbBufMax As Long, ByRef pcbBufOut As Long) As Long
#Else
Private Declare Function SQLGetInstalledDrivers Lib "ODBCCP32" ( _
 ByVal lpszBuf As String, ByVal cbBufMax As Long, ByRef pcbBufOut As Long) As Long
#End If
Private Type TLiteMan
 ExecADO As ILiteADO
 MetaADO As LiteMetaADO
 MetaSQL As LiteMetaSQL
End Type
Private this As TLiteMan
'''' Args:
'''' DbPathName (string):
'''' String describing the target database:
'''' * relative or absolute file pathname
'''' * ':memory:' - anonymous in-memory database
'''' * ':temp:'/':tmp:' - file db in the Temp folder with random name
'''' * ':blank:' - anonymous file-based db
''''
'''' AllowNonExistent (variant, optional, Empty):
'''' Controls additional path preprocessing and creatability
'''' * Empty - db file must exist, no path resolution
'''' * Not (Empty or Boolean) - new db file is ok, no path resolution
'''' * True/False - new db file is based on the value
'''' and path resolution is enabled
''''
'''' ConnOptions (Variant, optional, Empty):
'''' Either a string or dictionary of ODBC options. If a string is provided,
'''' it is used as is. If a dictionary is provided, the containing options
'''' are added to / override the default options.
''''
'@DefaultMember
Public Function Create(ByVal Database As String, _
 Optional ByVal AllowNonExistent As Variant = True, _
 Optional ByVal ConnOptions As Variant = Empty) As LiteMan
 Dim Instance As LiteMan
 Set Instance = New LiteMan
 Instance.Init Database, AllowNonExistent, ConnOptions
 Set Create = Instance
End Function
Friend Sub Init(ByVal Database As String, _
 Optional ByVal AllowNonExistent As Variant = True, _
 Optional ByVal ConnOptions As Variant = Empty)
 With this
 Set .ExecADO = NewDB(Database, AllowNonExistent, ConnOptions)
 Set .MetaADO = LiteMetaADO(.ExecADO)
 Set .MetaSQL = .MetaADO.MetaSQL
 End With
End Sub
Friend Function NewDB(ByVal Database As String, _
 ByVal AllowNonExistent As Variant, _
 Optional ByVal ConnOptions As Variant = Empty) As ILiteADO
 Dim PathCheck As LiteFSCheck
 Set PathCheck = LiteFSCheck(Database, AllowNonExistent)
 With PathCheck
 If .ErrNumber <> 0 Then .Raise
 Dim FilePathName As String
 FilePathName = .DatabasePathName
 Debug.Assert (Len(FilePathName) > 0 And Database <> ":blank:") _
 Or (Len(FilePathName) = 0 And Database = ":blank:")
 Set NewDB = LiteADO(.DatabasePathName, AllowNonExistent Or .IsSpecial, _
 ConnOptions)
 End With
End Function
Public Property Get ExecADO() As ILiteADO
 Set ExecADO = this.ExecADO
End Property
Public Property Get MetaADO() As LiteMetaADO
 Set MetaADO = this.MetaADO
End Property
Public Property Get MetaSQL() As LiteMetaSQL
 Set MetaSQL = this.MetaADO.MetaSQL
End Property
'@Description "Attaches SQLite database to existing connection"
Public Sub AttachDatabase(ByVal DbName As String, _
 Optional ByVal DbAlias As String = vbNullString)
 Dim SQLQuery As String
 SQLQuery = SQLlib.Attach(NewDB(DbName, False).MainDB, DbAlias)
 this.ExecADO.ExecuteNonQuery SQLQuery
End Sub
'@Description "Detaches SQLite database from existing connection"
Public Sub DetachDatabase(ByVal DatabaseAlias As String)
 this.ExecADO.ExecuteNonQuery SQLlib.Detach(DatabaseAlias)
End Sub
'@Description "Defer foreing keys"
Public Sub DeferForeignKeys()
 this.ExecADO.ExecuteNonQuery SQLlib.DeferForeignKeys
End Sub
'''' Executes provided SQLQuery and prints returned Recordset as a table to
'''' 'immediate'. If OutputRange is provided, the returned Recordset is also
'''' placed on the referenced Excel Worksheet via the QueryTable feature.
''''
'@Description "'Debug.Print' for an SQL query"
Public Sub DebugPrintRecordset(ByVal SQLQuery As String, _
 Optional ByVal OutputRange As Excel.Range = Nothing)
 Guard.EmptyString SQLQuery
 
 Dim AdoRecordset As ADODB.Recordset
 Set AdoRecordset = this.ExecADO.GetAdoRecordset(SQLQuery)
 
 If Not OutputRange Is Nothing Then
 ADOlib.RecordsetToQT AdoRecordset, OutputRange
 End If
 
 Dim FieldIndex As Long
 Dim FieldNames() As String
 ReDim FieldNames(1 To AdoRecordset.Fields.Count)
 For FieldIndex = LBound(FieldNames) To UBound(FieldNames)
 FieldNames(FieldIndex) = AdoRecordset.Fields(FieldIndex - 1).Name
 Next FieldIndex
 
 Dim Table As String
 Table = Join(FieldNames, vbTab) & vbNewLine & _
 AdoRecordset.GetString(, , vbTab, vbNewLine)
 Debug.Print Table
End Sub
'@Description "Queries journal mode for the given database"
Public Function JournalModeGet(Optional ByVal SchemaAlias As String = "main") As String
 Dim SQLQuery As String
 SQLQuery = "PRAGMA " & SchemaAlias & ".journal_mode"
 JournalModeGet = this.ExecADO.GetScalar(SQLQuery)
End Function
'''' Args:
'''' JournalMode (string, optional, "WAL"):
'''' New journal mode. 'WAL' mode is more efficient and should be used in
'''' most circumstances unless ACID transactions across multiple attached
'''' databases are required, in which case 'DELETE' or 'TRUNCATE' should be
'''' used.
''''
'''' SchemaAlias (string, optional, "main"):
'''' Database alias, for which journal mode should be set. If "ALL" is provided,
'''' the mode will be set for all attached databases.
''''
'''' This routine also sets sync mode to 'NORMAL'.
''''
'@Description "Sets journal mode for the given database"
Public Sub JournalModeSet(Optional ByVal JournalMode As String = "WAL", _
 Optional ByVal SchemaAlias As String = "main")
 Const JOURNAL_MODES As String = "DELETE | TRUNCATE | PERSIST | MEMORY | WAL | OFF"
 Dim JournalModeUC As String
 JournalModeUC = UCase$(JournalMode)
 Dim CheckResult As Boolean
 CheckResult = CBool(InStr("| " & JOURNAL_MODES & " |", "| " & JournalModeUC & " |"))
 Guard.Expression CheckResult, "SQLiteDB/JournalModeSet", _
 "Invalid journal mode: '" & JournalMode & "'. Valid values are: " _
 & JOURNAL_MODES
 
 Dim SQLQuery As String
 Dim Databases As Variant
 If UCase$(SchemaAlias) <> "ALL" Then
 Databases = Array(SchemaAlias)
 Else
 SQLQuery = "SELECT name FROM pragma_database_list"
 Databases = ArrayLib.GetRow(this.ExecADO.GetAdoRecordset(SQLQuery).GetRows, 0)
 End If
 
 Dim DbIndex As Long
 
 '''' The SQLite ODBC driver appears to have a bug. It tries to do some statement
 '''' interpretation and fails, when multiple "PRAGMA" statements are inlcuded.
 For DbIndex = LBound(Databases) To UBound(Databases)
 If JournalModeUC = "WAL" Then
 SQLQuery = "PRAGMA [" & Databases(DbIndex) & "].synchronous = 'NORMAL'"
 this.ExecADO.ExecuteNonQuery SQLQuery
 End If
 SQLQuery = "PRAGMA [" & Databases(DbIndex) & "].journal_mode = '" & JournalMode & "'"
 this.ExecADO.ExecuteNonQuery SQLQuery
 Next DbIndex
End Sub
'''' This routines queries the database to get the list of databases attached
'''' to the current connection. For each database, two pragmas are generated:
'''' one sets sync mode to 'NORMAL', the other sets journal mode according to
'''' the provided argument. 'WAL' mode is more efficient and should be used
'''' in most circumstances unless ACID transactions across multiple attached
'''' databases are required, in which case 'DELETE' or 'TRUNCATE' should be
'''' used.
''''
'@Description "Sets NORMAL sync and journal mode to WAL or DELETE for all attached dbs"
Public Sub JournalModeToggle(Optional ByVal JournalMode As String = "WAL")
 Dim Databases As Variant
 Databases = this.ExecADO.GetAdoRecordset(this.MetaSQL.Databases).GetRows
 Databases = ArrayLib.GetRow(Databases, 0)
 
 Dim DbIndex As Long
 For DbIndex = LBound(Databases) To UBound(Databases)
 Databases(DbIndex) = _
 "PRAGMA " & Databases(DbIndex) & ".synchronous='NORMAL';" & vbNewLine & _
 "PRAGMA " & Databases(DbIndex) & ".journal_mode='" & JournalMode & "'"
 Next DbIndex
 
 Dim SQLQuery As String
 SQLQuery = Join(Databases, ";" & vbNewLine) & ";"
 this.ExecADO.ExecuteNonQuery SQLQuery
End Sub
'''' @ClassMethodStrict
'''' This method should only be used on the default instance
''''
'''' Clones an SQLite database.
''''
'''' Triggers cannot be disabled in SQLite, so trigger schema should be cloned
'''' separately after the all data is transfered.
'''' Defer_foreign_keys does not behave expectedly (FK violation during data
'''' transfer step). Prefer disabling foreign keys for the duration of process.
'''' Present implmentation does not clone the ROWID column for tables with
'''' separate hidden ROWID column. The use of such column should be avoided
'''' anyway, as its value can change at any time. In practice, either
'''' INTEGER PRIMARY KEY AUTOINCREMENT should be defined to serve as ROWID or
'''' the table should be defined as "WITHOUT ROWID".
''''
'''' Args:
'''' DstDbName (string):
'''' Name of the new clone database, referring to either ":memory:" or
'''' non-existent file to be created. Initial steps:
'''' 1) Run integrity checks.
'''' 2) Attach the destination database as the "main" to a new SQLiteDB
'''' instance use "True" as the second argument to the factory to enable
'''' file creation.
''''
'''' SrcDbName (string):
'''' Name of the database to be cloned referring to an existing file or an
'''' empty string, if fallback checks can pick it up.
'''' 3) Attach as an additional database with alias "source" to the SQLiteDB
'''' instance from step (2).
'''' 4) Retrieve source schema without triggers and trigger schema.
'''' 5) Retrieve source table list.
''''
'''' 6) Set journal mode to 'WAL'; Disable foreign keys; Start transaction; Execute schema;
'''' Commit transaction
'''' 7) Start transaction; Clone data; Commit transaction
'''' 8) Start transaction; Execute trigger schema; Commit transaction; Enable foreign keys
'''' 9) Verify transfer and run integrity check on the destination database.
''''
'''' Returns:
'''' Database manager for the newly created database clone.
''''
'@Description "Clones SQLite database."
Public Function CloneDb(ByVal DstDbName As String, ByVal SrcDbName As String) As LiteMan
 Dim SQLQuery As String
 Dim AdoRecordset As ADODB.Recordset
 Dim CheckResult As Boolean
 
 '''' 1) Check source integrity
 '''' DB reference is not saved, so the db is released at check exit.
 LiteACID(NewDB(SrcDbName, False)).IntegrityADODB
 
 '''' 2) Attach destination db
 Dim dbm As LiteMan
 Set dbm = LiteMan(DstDbName, True)
 Debug.Assert Not dbm Is Nothing
 Debug.Print "-- Destination db is attached"
 Dim ExecADO As ILiteADO
 Set ExecADO = dbm.ExecADO
 Dim MetaADO As LiteMetaADO
 Set MetaADO = dbm.MetaADO
 
 '''' 3) Attach source db
 dbm.AttachDatabase SrcDbName, "source"
 SQLQuery = dbm.MetaSQL.Databases
 Set AdoRecordset = ExecADO.GetAdoRecordset(SQLQuery)
 CheckResult = (AdoRecordset.RecordCount = 2)
 Set AdoRecordset = Nothing
 Guard.Expression CheckResult, "LiteMan/CloneDb", "Attach source db failed"
 Debug.Print "-- Source db is attached"
 
 With MetaADO
 '''' 4) Get schema without triggers and trigger schema
 Dim SchemaNoTriggersSQL As String
 SchemaNoTriggersSQL = .GetDbSchemaNoTriggersSQL("source")
 Debug.Assert Len(SchemaNoTriggersSQL) > 0
 Dim TriggerSchemaSQL As String
 TriggerSchemaSQL = .GetTriggersSQL("source")
 Debug.Print "-- Source schema is retrieved"
 
 '''' 5) Get table list
 Dim TableList As Variant
 TableList = .GetTableList("source")
 Debug.Assert Not IsEmpty(TableList)
 Debug.Print "-- Source table list is retrieved"
 End With
 
 With ExecADO
 '''' 6) Clone schema without triggers
 .ExecuteNonQuery SQLlib.FKStatus(False)
 dbm.JournalModeSet "WAL", "main"
 .Begin
 .ExecuteNonQuery SchemaNoTriggersSQL
 .Commit
 Debug.Assert UBound(TableList) = UBound(MetaADO.GetTableList)
 Debug.Print "-- Schema without triggers is cloned"
 
 '''' 7) Clone data
 Dim TableName As Variant
 .Begin
 For Each TableName In TableList
 SQLQuery = SQLlib.CopyTableData("source", TableName)
 .ExecuteNonQuery SQLQuery
 Next TableName
 .Commit
 Debug.Print "-- Data is cloned"
 
 '''' 8) Clone trigger schema
 .Begin
 .ExecuteNonQuery TriggerSchemaSQL
 .Commit
 .ExecuteNonQuery SQLlib.FKStatus(True)
 Debug.Print "-- Triggers are cloned"
 End With
 
 '''' 9) Verify transfer and target db integrity
 ' TODO:
 ' Transfer verification (e.g., compare row counts for each table)
 dbm.DetachDatabase "source"
 ExecADO.ExecuteNonQuery "ANALYZE"
 '@Ignore IndexedDefaultMemberAccess
 LiteACID(ExecADO).IntegrityADODB
 
 Set CloneDb = dbm
End Function
'''' This function attempts to confirm that the standard registry key for the
'''' SQLite3ODBC driver is present and that the file driver exists. No attempt
'''' is made to verify its usability.
''''
'''' Attempt to determine environment (native X32onX32 or X64onX64) or X32onX64.
'''' If successfull, try retrieving SQLite3ODBC driver file pathname from the
'''' standard registry key (adjusted to the type of environment, if necessary).
'''' If successful, adjust path to the type of environment, if necessary, and
'''' check if file driver exists. If successful, return true, or false otherwise.
''''
'@Description "Checks if SQLite3ODBC diver is available."
Public Function SQLite3ODBCDriverCheck() As Boolean
 Const SQLITE3_ODBC_NAME As String = "SQLite3 ODBC Driver"
 
 '''' Check if SQLGetInstalledDrivers contains the standard SQLite3ODBC driver
 '''' description. Fail if not found.
 Dim Buffer As String
 Buffer = String(2000, vbNullChar)
 Dim ActualSize As Long: ActualSize = 0 '''' RD ByRef workaround
 Dim Result As Boolean
 Result = SQLGetInstalledDrivers(Buffer, Len(Buffer) * 2, ActualSize)
 Debug.Assert Result = True
 Result = InStr(Replace(Left$(Buffer, ActualSize - 1), vbNullChar, vbLf), _
 SQLITE3_ODBC_NAME)
 If Not Result Then GoTo DRIVER_NOT_FOUND:
 
 Dim ODBCINSTPrefix As String
 Dim EnvArch As EnvArchEnum
 EnvArch = GetEnvX32X64Type()
 Select Case EnvArch
 Case ENVARCH_NATIVE
 ODBCINSTPrefix = "HKLM\SOFTWARE\ODBC\ODBCINST.INI\"
 Case ENVARCH_32ON64
 ODBCINSTPrefix = "HKLM\SOFTWARE\WOW6432Node\ODBC\ODBCINST.INI\"
 Case ENVARCH_NOTSUP
 Logger.Logg "Failed to determine Win/Office architecture or " & _
 "unsupported.", , DEBUGLEVEL_ERROR
 SQLite3ODBCDriverCheck = False
 Exit Function
 End Select
 
 '''' Query standard ODBCINST.INI registry keys
 '@Ignore SelfAssignedDeclaration
 Dim wsh As New IWshRuntimeLibrary.WshShell
 Dim SQLite3ODBCDriverInstalled As Boolean
 Dim RegPath As String
 RegPath = ODBCINSTPrefix & "ODBC Drivers\" & SQLITE3_ODBC_NAME
 On Error Resume Next
 SQLite3ODBCDriverInstalled = (wsh.RegRead(RegPath) = "Installed")
 If Not SQLite3ODBCDriverInstalled Then GoTo DRIVER_NOT_FOUND:
 On Error GoTo 0
 RegPath = ODBCINSTPrefix & SQLITE3_ODBC_NAME & "\Driver"
 Dim SQLite3ODBCDriverPath As String
 On Error Resume Next
 SQLite3ODBCDriverPath = wsh.RegRead(RegPath)
 If Len(SQLite3ODBCDriverPath) = 0 Then GoTo DRIVER_NOT_FOUND:
 On Error GoTo 0
 Const SYSTEM_NATIVE As String = "System32"
 Const SYSTEM_32ON64 As String = "SysWOW64"
 If EnvArch = ENVARCH_32ON64 Then
 SQLite3ODBCDriverPath = _
 Replace(SQLite3ODBCDriverPath, SYSTEM_NATIVE, SYSTEM_32ON64)
 End If
 
 '''' Check if driver file exists
 '@Ignore SelfAssignedDeclaration
 Dim fso As New IWshRuntimeLibrary.FileSystemObject
 If Not fso.FileExists(SQLite3ODBCDriverPath) Then GoTo DRIVER_NOT_FOUND:
 
 Logger.Logg "SQLite3ODBC driver appears to be available.", , DEBUGLEVEL_INFO
 SQLite3ODBCDriverCheck = True
 Exit Function
 
DRIVER_NOT_FOUND:
 Logger.Logg "Failed to verify SQLite3ODBC driver availability", , DEBUGLEVEL_ERROR
 SQLite3ODBCDriverCheck = False
 Exit Function
End Function

SQLiteC

'@Folder "SQLite.C.Manager"
'@ModuleDescription "Provides common workflows for SQLite db interactions"
'@PredeclaredId
'@Exposed
'@IgnoreModule IndexedDefaultMemberAccess
Option Explicit
#If VBA7 Then
'''' Engine test, no db is necessary
Private Declare PtrSafe Function sqlite3_libversion Lib "SQLite3" () As LongPtr ' PtrUtf8String
Private Declare PtrSafe Function sqlite3_libversion_number Lib "SQLite3" () As Long
'''' Backup
Private Declare PtrSafe Function sqlite3_backup_init Lib "SQLite3" (ByVal hDbDest As LongPtr, _
 ByVal zDestName As LongPtr, ByVal hDbSource As LongPtr, ByVal zSourceName As LongPtr) As LongPtr
Private Declare PtrSafe Function sqlite3_backup_step Lib "SQLite3" (ByVal hBackup As LongPtr, ByVal nPage As Long) As Long
Private Declare PtrSafe Function sqlite3_backup_remaining Lib "SQLite3" (ByVal hBackup As LongPtr) As Long
Private Declare PtrSafe Function sqlite3_backup_pagecount Lib "SQLite3" (ByVal hBackup As LongPtr) As Long
Private Declare PtrSafe Function sqlite3_backup_finish Lib "SQLite3" (ByVal hBackup As LongPtr) As Long
#Else
'''' Engine test, no db is necessary
Private Declare Function sqlite3_libversion Lib "SQLite3" () As Long ' PtrUtf8String
Private Declare Function sqlite3_libversion_number Lib "SQLite3" () As Long
'''' Backup
Private Declare Function sqlite3_backup_init Lib "SQLite3" (ByVal hDbDest As Long, _
 ByVal zDestName As Long, ByVal hDbSource As Long, ByVal zSourceName As Long) As Long
Private Declare Function sqlite3_backup_step Lib "SQLite3" (ByVal hBackup As Long, ByVal nPage As Long) As Long
Private Declare Function sqlite3_backup_remaining Lib "SQLite3" (ByVal hBackup As Long) As Long
Private Declare Function sqlite3_backup_pagecount Lib "SQLite3" (ByVal hBackup As Long) As Long
Private Declare Function sqlite3_backup_finish Lib "SQLite3" (ByVal hBackup As Long) As Long
#End If
Private Type TSQLiteC
 DllMan As DllManager
 Connections As Scripting.Dictionary
 '''' The first created connection is designated as the main db, MainDB and
 '''' is set to this connection's ID, which is the pathname of its 'main' db.
 MainDB As Variant
End Type
Private this As TSQLiteC
'@DefaultMember
Public Function Create(ByVal DllPath As String, _
 Optional ByVal DllNames As Variant = Empty) As SQLiteC
 Dim Instance As SQLiteC
 Set Instance = New SQLiteC
 Instance.Init DllPath, DllNames
 Set Create = Instance
End Function
Friend Sub Init(ByVal DllPath As String, _
 Optional ByVal DllNames As Variant = Empty)
 Dim FileNames As Variant
 If Not IsEmpty(DllNames) Then
 FileNames = DllNames
 Else
 #If Win64 Then
 '''' SQLite3.dll-x64 is built with MSYS2/MinGWx64
 '''' LoadLibrary resolves/loads dependencies automatically.
 FileNames = "sqlite3.dll"
 #Else
 '''' SQLite3.dll-x32 is built with MSVC and follows STDCALL
 '''' LoadLibrary fails to resolve/load dependencies automatically,
 '''' so loading them explicitly.
 FileNames = Array("icudt68.dll", "icuuc68.dll", "icuin68.dll", _
 "icuio68.dll", "icutu68.dll", "sqlite3.dll")
 #End If
 End If
 '''' DllManager is responsible for DllPath validation/resolution
 Set this.DllMan = DllManager.Create(DllPath, FileNames)
 Set this.Connections = New Scripting.Dictionary
 this.Connections.CompareMode = TextCompare
 this.MainDB = Null
End Sub
'''' SQLiteC class hierarchy includes multiple instances of circular references,
'''' (parent object holding references to its children and children keeping a
'''' parent reference (see class diagram in the project docs). Such objects
'''' cannot be disposed of properly automatically by VBA.
''''
'''' SQLiteC is the top-level class and its encapsulated class SQLiteCConnection
'''' does not need and does not hold a reference to the manager. Thus, SQLiteC
'''' objects are destructed automatically, and through its Class_Terminate, this
'''' routine initiates a descending cascade of cleanup routines responsible for
'''' unraveling the circular references.
''''
Private Sub Class_Terminate()
 Logger.Logg "======== SQLiteC Class_Terminate ========", , DEBUGLEVEL_INFO
 With this
 If .Connections Is Nothing Then Exit Sub
 Dim DbConn As SQLiteCConnection
 Dim ConnName As Variant
 For Each ConnName In .Connections.Keys
 Set DbConn = .Connections(ConnName)
 DbConn.CleanUp
 Next ConnName
 Set DbConn = Nothing
 .Connections.RemoveAll
 Set .Connections = Nothing
 End With
End Sub
Public Property Get MainDbId() As Variant
 MainDbId = this.MainDB
End Property
Public Property Get DllMan() As DllManager
 Set DllMan = this.DllMan
End Property
'''' vbNullString is an acceptable StmtName.
'''' Raises an error if DbPathName (or resolved value) has already been used.
'@Description "Creates a new SQLiteCConnection instance."
Public Function CreateConnection(ByVal DbPathName As String, _
 Optional ByVal AllowNonExistent As Variant = True _
 ) As SQLiteCConnection
 Dim PathCheck As LiteFSCheck
 Set PathCheck = LiteFSCheck(DbPathName, AllowNonExistent)
 Guard.ExpressionTrueErr PathCheck.ErrNumber <> 0, PathCheck.ErrNumber, _
 "SQLiteCConnection/Init", PathCheck.ErrDescription
 Dim FilePathName As String
 FilePathName = PathCheck.DatabasePathName
 If this.Connections.Exists(FilePathName) Then
 Err.Raise ErrNo.KeyAlreadyExistsErr, "SQLiteC", _
 "Connection pathname already exists!"
 End If
 Dim DbConn As SQLiteCConnection
 Set DbConn = SQLiteCConnection(FilePathName)
 If DbConn Is Nothing Then Err.Raise ErrNo.UnknownClassErr, _
 "SQLiteC", "Failed to create an SQLiteCConnection instance."
 Set this.Connections(FilePathName) = DbConn
 If IsNull(this.MainDB) Then this.MainDB = FilePathName
 Set CreateConnection = DbConn
End Function
'''' vbNullString is an acceptable DbPathName (should resolve to anon temp db).
'@Description "Returns an existing SQLiteCConnection instance or Nothing."
Public Function ConnDb(Optional ByVal DbPathName As String = vbNullString _
 ) As SQLiteCConnection
 '''' SQLiteCConnection is responsible for DbPathName validation/resolution
 If this.Connections.Exists(DbPathName) Then
 Set ConnDb = this.Connections(DbPathName)
 ElseIf Len(DbPathName) = 0 And this.Connections.Exists(this.MainDB) Then
 Set ConnDb = this.Connections(this.MainDB)
 Else
 Set ConnDb = Nothing
 End If
End Function
'''' Reference: https://www.sqlite.org/c3ref/backup_finish.html
'''' Reference: https://www.sqlite.org/backup.html
'''' Reference: https://www.sqlite.org/lang_vacuum.html#vacuuminto
''''
'''' Returns:
'''' number of pages copied
''''
'@Description "Performs online database backup."
Public Function DupDbOnlineFull(ByVal DbConnDest As SQLiteCConnection, _
 Optional ByVal DstAlias As String = "main", _
 Optional ByVal DbConnSrc As SQLiteCConnection, _
 Optional ByVal SrcAlias As String = "main") As Long
 Dim DbConnDst As SQLiteCConnection
 Set DbConnDst = IIf(DbConnDest Is Nothing, DbConnSrc, DbConnDest)
 FixGuard.DbNotOpened DbConnSrc, "SQLiteC/DupDbOnlineFull"
 FixGuard.DbNotOpened DbConnDst, "SQLiteC/DupDbOnlineFull"
 #If VBA7 Then
 Dim DbHandleBak As LongPtr
 Dim SrcAliasPtr As LongPtr
 Dim DstAliasPtr As LongPtr
 #Else
 Dim DbHandleBak As Long
 Dim SrcAliasPtr As Long
 Dim DstAliasPtr As Long
 #End If
 
 Dim SrcAliasUTF8B() As Byte
 Dim DstAliasUTF8B() As Byte
 SrcAliasUTF8B = UTFlib.UTF8BytesFromStr(SrcAlias)
 DstAliasUTF8B = UTFlib.UTF8BytesFromStr(DstAlias)
 SrcAliasPtr = VarPtr(SrcAliasUTF8B(0))
 DstAliasPtr = VarPtr(DstAliasUTF8B(0))
 
 DbHandleBak = sqlite3_backup_init(DbConnDst.DbHandle, DstAliasPtr, _
 DbConnSrc.DbHandle, SrcAliasPtr)
 If DbHandleBak = 0 Then GoTo RESULT_CODE:
 Dim ResultCode As SQLiteResultCodes
 ResultCode = sqlite3_backup_step(DbHandleBak, -1)
 If ResultCode <> SQLITE_DONE Then GoTo RESULT_CODE:
 Dim PagesLeft As Long
 PagesLeft = sqlite3_backup_remaining(DbHandleBak)
 If PagesLeft <> 0 Then GoTo RESULT_CODE:
 Dim PagesDone As Long
 PagesDone = sqlite3_backup_pagecount(DbHandleBak)
 ResultCode = sqlite3_backup_finish(DbHandleBak)
 Debug.Assert ResultCode = SQLITE_OK
 DupDbOnlineFull = PagesDone
 Exit Function
RESULT_CODE:
 '@Ignore AssignmentNotUsed
 ResultCode = DbConnDst.ErrInfoRetrieve
 DupDbOnlineFull = 0
End Function
'''' Reference: https://www.sqlite.org/c3ref/libversion.html
''''
'@Description "Returns SQLite version. No database is necessary."
Public Function Version(Optional ByVal Numeric As Boolean = True) As Variant
 If Numeric Then
 Version = sqlite3_libversion_number()
 Else
 Version = UTFlib.StrFromUTF8Ptr(sqlite3_libversion())
 End If
End Function
asked Dec 9, 2021 at 7:55
\$\endgroup\$

0

Know someone who can answer? Share a link to this question via email, Twitter, or Facebook.

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.