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).
 |
|---|
| 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
 |
|---|
| 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.
 |
|---|
| 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
