Extending the SecureADODB library

Question

SecureADODB is a very instructive VBA OOP demo. I have played with SecureADODB for a while and plan to integrate it into the prototype of my database manager application. In my previous post, I showed ContactEditor's class diagram with the ADOlib class encapsulated into the DataTableADODB backend. The ADOlib class contains a few very basic wrappers around the ADODB library, and I created it as a stub to focus on other components of the db manager app. Now, I would like to replace ADOlib with SecureADODB. In preparation, I forked SecureADODB, slightly refactored the original codebase, and incorporated additional functionality from ADOlib. The focus of this question is on several modifications, particularly the DbManager class and two helper classes.

---

Class diagram of this SecureADODB fork (inteface classes not shown)

Class Diagram

DbManager (renamed UnitOfWork)

'@Folder "SecureADODB.DbManager"
'@ModuleDescription("An object that encapsulates a database transaction.")
'@PredeclaredId
'@Exposed
Option Explicit
Implements IDbManager
Private Type TDbManager
 DbMeta As DbMetaData
 DbConnStr As DbConnectionString
 Connection As IDbConnection
 CommandFactory As IDbCommandFactory
 UseTransactions As Boolean
 LogController As ILogger
End Type
Private this As TDbManager
'@Ignore ProcedureNotUsed
'@Description("Returns class reference")
Public Property Get Class() As DbManager
 Set Class = DbManager
End Property
'@Description("Default factory")
Public Function Create(ByVal db As IDbConnection, _
 ByVal factory As IDbCommandFactory, _
 Optional ByVal UseTransactions As Boolean = True, _
 Optional ByVal LogController As ILogger = Nothing) As IDbManager
 Dim Instance As DbManager
 Set Instance = New DbManager
 Instance.Init db, factory, UseTransactions, LogController
 Set Create = Instance
End Function
'@Description("Default constructor")
Friend Sub Init(ByVal db As IDbConnection, _
 ByVal factory As IDbCommandFactory, _
 Optional ByVal UseTransactions As Boolean = True, _
 Optional ByVal LogController As ILogger = Nothing)
 
 Guard.NullReference factory
 Guard.NullReference db
 Guard.Expression db.State = adStateOpen, Source:="DbManager", Message:="Connection should be open."
 Set this.LogController = LogController
 Set this.Connection = db
 Set this.CommandFactory = factory
 this.UseTransactions = UseTransactions
End Sub
'''' Factory for file-based databases.
''''
'''' Args:
'''' DbType (string):
'''' Type of the database: "sqlite", "csv", "xls"
''''
'''' DbFileName (string, optional, ""):
'''' Database file name. If not provided, ThisWorkbook.VBProject.Name
'''' will be used. Extension is added based on the database type:
'''' "sqlite" - "db" or "sqlite"
'''' "csv" - "xsv" or "csv"
'''' "xls" - "xls
''''
'''' ConnectionOptions (variant, optional, Empty):
'''' Connection options. If Empty, default values is selected based on the
'''' database type (see DbConnectionString constructor code for details).
''''
'''' N.B.: "xls" backend support is not currently implemented
''''
'@Description "Factory for file-based databases"
Public Function CreateFileDb( _
 ByVal DbType As String, _
 Optional ByVal DbFileName As String = vbNullString, _
 Optional ByVal ConnectionOptions As String = vbNullString, _
 Optional ByVal UseTransactions As Boolean = True, _
 Optional ByVal LoggerType As LoggerTypeEnum = LoggerTypeEnum.logGlobal _
 ) As IDbManager
 Dim LogController As ILogger
 Select Case LoggerType
 Case LoggerTypeEnum.logDisabled
 Set LogController = Nothing
 Case LoggerTypeEnum.logGlobal
 Set LogController = Logger
 Case LoggerTypeEnum.logPrivate
 Set LogController = Logger.Create
 End Select
 
 Dim provider As IParameterProvider
 Set provider = AdoParameterProvider.Create(AdoTypeMappings.Default)
 
 Dim baseCommand As IDbCommandBase
 Set baseCommand = DbCommandBase.Create(provider)
 
 Dim factory As IDbCommandFactory
 Set factory = DbCommandFactory.Create(baseCommand)
 
 Dim DbConnStr As DbConnectionString
 Set DbConnStr = DbConnectionString.CreateFileDb(DbType, DbFileName, , ConnectionOptions)
 Dim db As IDbConnection
 Set db = DbConnection.Create(DbConnStr.ConnectionString, LogController)
 
 Dim Instance As DbManager
 Set Instance = DbManager.Create(db, factory, UseTransactions, LogController)
 Set Instance.DbConnStr = DbConnStr
 Set Instance.DbMeta = DbMetaData.Create(DbConnStr)
 Set CreateFileDb = Instance
End Function
'@Ignore ProcedureNotUsed
Public Property Get DbConnStr() As DbConnectionString
 Set DbConnStr = this.DbConnStr
End Property
Public Property Set DbConnStr(ByVal Instance As DbConnectionString)
 Set this.DbConnStr = Instance
End Property
'@Ignore ProcedureNotUsed
Public Property Get DbMeta() As DbMetaData
 Set DbMeta = this.DbMeta
End Property
Public Property Set DbMeta(ByVal Instance As DbMetaData)
 Set this.DbMeta = Instance
End Property
'@Description("Returns class reference")
Public Property Get IDbManager_Class() As DbManager
 Set IDbManager_Class = DbManager
End Property
Private Property Get IDbManager_LogController() As ILogger
 Set IDbManager_LogController = this.LogController
End Property
Private Property Get IDbManager_DbConnStr() As DbConnectionString
 Set IDbManager_DbConnStr = this.DbConnStr
End Property
Private Property Get IDbManager_DbMeta() As DbMetaData
 Set IDbManager_DbMeta = this.DbMeta
End Property
Private Property Get IDbManager_Connection() As IDbConnection
 Set IDbManager_Connection = this.Connection
End Property
Private Function IDbManager_Command() As IDbCommand
 Set IDbManager_Command = this.CommandFactory.CreateInstance(this.Connection)
End Function
Private Function IDbManager_Recordset( _
 Optional ByVal Scalar As Boolean = False, _
 Optional ByVal Disconnected As Boolean = True, _
 Optional ByVal CacheSize As Long = 10, _
 Optional ByVal CursorType As ADODB.CursorTypeEnum = -1, _
 Optional ByVal AsyncMode As Boolean = False, _
 Optional ByVal AsyncOption As ADODB.ExecuteOptionEnum = 0) As IDbRecordset
 Dim cmd As IDbCommand
 Set cmd = this.CommandFactory.CreateInstance(this.Connection)
 Set IDbManager_Recordset = DbRecordset.Create( _
 cmd, Scalar, Disconnected, CacheSize, CursorType, AsyncMode, AsyncOption)
End Function
Private Sub IDbManager_Begin()
 Guard.Expression this.UseTransactions, Source:="DbManager", Message:="Transactions are disabled by the caller."
 this.Connection.BeginTransaction
End Sub
Private Sub IDbManager_Commit()
 Guard.Expression this.UseTransactions, Source:="DbManager", Message:="Transactions are disabled by the caller."
 this.Connection.CommitTransaction
End Sub
Private Sub IDbManager_Rollback()
 Guard.Expression this.UseTransactions, Source:="DbManager", Message:="Transactions are disabled by the caller."
 this.Connection.RollbackTransaction
End Sub

---

While this DbManager class is functionally similar to the UnitOfWork class in RD SecureADODB, I added two helper classes to simplify specific tasks.

DbConnectionString

During the prototyping stage, I do not want to worry about config files and connection string issues. So using this class for file-based databases (currently SQLite and CSV backends are supported), I can simply indicate the type of the database and get a connection string with sane defaults.

'@Folder "SecureADODB.DbManager.DbConnectionString"
'@ModuleDescription "Helper routines for building connection strings"
'@PredeclaredId
'@Exposed
''''
'''' The module incorporates routines, which facilitate construction of
'''' connection strings for the ADODB library. Presently, a distinction is made
'''' between file-based databases, such as sqlite, csv, xls, etc., and network
'''' based databases. A file-based database is accessed based on its type and
'''' file pathname.
'''' CreateFileDB/InitFileDB pair is used for file based databases.
''''
Option Explicit
Option Compare Text
Private Type TDbConnectionString
 DbType As String
 DbPath As String
 Options As String
 Driver As String
 ConnectionString As String
End Type
Private this As TDbConnectionString
'''' Factory for file-based databases.
''''
'''' Args:
'''' FileType (string, optional, "sqlite"):
'''' Type of the database: "sqlite", "csv", "xls"
''''
'''' FileName (string, optional, ""):
'''' Database file name. If not provided, ThisWorkbook.VBProject.Name
'''' will be used. Extension is added based on the database type:
'''' "sqlite" - "db" or "sqlite"
'''' "csv" - "xsv" or "csv"
'''' "xls" - "xls
''''
'''' Driver (variant, optional, Empty):
'''' Database driver. If Empty, default values is selected based on
'''' the database type (see constructor code for details).
''''
'''' ConnectionOptions (variant, optional, Empty):
'''' Connection options. See above for details.
''''
'''' N.B.: "xls" backend support is not currently implemented
''''
'''' Examples:
'''' >>> ?DbConnectionString.CreateFileDB("sqlite").ConnectionString
'''' "Driver=SQLite3 ODBC Driver;Database=<Thisworkbook.Path>\SecureADODB.db;SyncPragma=NORMAL;FKSupport=True;"
''''
'''' >>> ?DbConnectionString.CreateFileDB("sqlite").QTConnectionString
'''' "OLEDB;Driver=SQLite3 ODBC Driver;Database=<Thisworkbook.Path>\SecureADODB.db;SyncPragma=NORMAL;FKSupport=True;"
''''
'''' >>> ?DbConnectionString.CreateFileDB("csv").ConnectionString
'''' "Driver={Microsoft Text Driver (*.txt; *.csv)};DefaultDir=<Thisworkbook.Path>;"
''''
'''' >>> ?DbConnectionString.CreateFileDB("xls").ConnectionString
'''' NotImplementedErr
''''
'@Description "Factory for file-based databases"
Public Function CreateFileDb(Optional ByVal FileType As String = "sqlite", _
 Optional ByVal FileName As String = vbNullString, _
 Optional ByVal Driver As Variant = Empty, _
 Optional ByVal ConnectionOptions As Variant = Empty _
 ) As DbConnectionString
 Dim Instance As DbConnectionString
 Set Instance = New DbConnectionString
 Instance.InitFileDB FileType, FileName, Driver, ConnectionOptions
 Set CreateFileDb = Instance
End Function
'@Description "Constructor for file-based databases"
Friend Sub InitFileDB(Optional ByVal FileType As String = "sqlite", _
 Optional ByVal FileName As String = vbNullString, _
 Optional ByVal Driver As String = vbNullString, _
 Optional ByVal ConnectionOptions As Variant = Empty)
 With this
 .DbType = LCase$(FileType)
 .Driver = Driver
 .Options = ConnectionOptions
 Select Case .DbType
 Case "sqlite"
 If Len(Driver) = 0 Then
 .Driver = "SQLite3 ODBC Driver"
 End If
 If IsEmpty(ConnectionOptions) Then
 .Options = "SyncPragma=NORMAL;FKSupport=True;"
 End If
 .DbPath = VerifyOrGetDefaultPath(FileName, Array("db", "sqlite"))
 .ConnectionString = "Driver=" + .Driver + ";" + _
 "Database=" + .DbPath + ";" + _
 .Options
 Case "worksheet", "wsheet"
 .DbPath = VerifyOrGetDefaultPath(FileName, Array("xls"))
 .ConnectionString = .DbPath
 Case "csv"
 .DbPath = VerifyOrGetDefaultPath(FileName, Array("xsv", "csv"))
 Dim DbFileName As String
 DbFileName = Dir$(.DbPath, vbArchive + vbNormal + vbHidden + vbReadOnly + vbSystem)
 .DbPath = Left$(.DbPath, Len(.DbPath) - Len(DbFileName) - 1)
 #If Win64 Then
 .Driver = "Microsoft Access Text Driver (*.txt, *.csv)"
 #Else
 .Driver = "{Microsoft Text Driver (*.txt; *.csv)}"
 #End If
 .ConnectionString = "Driver=" + .Driver + ";" + _
 "DefaultDir=" + .DbPath + ";"
 Case Else
 .ConnectionString = vbNullString
 End Select
 End With
 If this.ConnectionString = vbNullString Then
 Dim errorDetails As TError
 With errorDetails
 .Number = ErrNo.NotImplementedErr
 .Name = "NotImplementedErr"
 .Source = "DbConnectionString"
 .Description = "Unsupported backend: " & FileType
 .Message = .Description
 End With
 RaiseError errorDetails
 End If
End Sub
Public Property Get ConnectionString() As String
 ConnectionString = this.ConnectionString
End Property
Public Property Get QTConnectionString() As String
 QTConnectionString = "OLEDB;" & this.ConnectionString
End Property

DbConnectionString relies on the VerifyOrGetDefaultPath routine, which takes a file pathname candidate (possibly blank) and an array of default extensions. Then it attempts to locate the file, checking default directories and file naming conventions.

'''' Resolves file pathname
''''
'''' This helper routines attempts to interpret provided pathname as
'''' a reference to an existing file:
'''' 1) check if provided reference is a valid absolute file pathname, if not,
'''' 2) construct an array of possible file locations:
'''' - ThisWorkbook.Path & Application.PathSeparator
'''' - Environ("APPDATA") & Application.PathSeparator &
'''' & ThisWorkbook.VBProject.Name & Application.PathSeparator
'''' construct an array of possible file names:
'''' - FilePathName
'''' - ThisWorkbook.VBProject.Name & Ext (Ext comes from the second argument
'''' 3) loop through all possible path/filename combinations until a valid
'''' pathname is found or all options are exhausted
''''
'''' Args:
'''' FilePathName (string):
'''' File pathname
''''
'''' DefaultExts (string or string/array):
'''' 1D array of default extensions or a single default extension
''''
'''' Returns:
'''' String:
'''' Resolved valid absolute pathname pointing to an existing file.
''''
'''' Throws:
'''' Err.FileNotFoundErr:
'''' If provided pathname cannot be resolved to a valid file pathname.
''''
'''' Examples:
'''' >>> ?VerifyOrGetDefaultPath(Environ$("ComSpec"), "")
'''' "C:\Windows\system32\cmd.exe"
''''
'@Description "Resolves file pathname"
Public Function VerifyOrGetDefaultPath(ByVal FilePathName As String, ByVal DefaultExts As Variant) As String
 Dim PATHuSEP As String: PATHuSEP = Application.PathSeparator
 Dim PROJuNAME As String: PROJuNAME = ThisWorkbook.VBProject.Name
 
 Dim FileExist As Variant
 Dim PathNameCandidate As String
 
 '''' === (1) === Check if FilePathName is a valid path to an existing file.
 If Len(FilePathName) > 0 Then
 '''' If matched, Dir returns Len(String) > 0;
 '''' otherwise, returns vbNullString or raises an error
 PathNameCandidate = FilePathName
 On Error Resume Next
 FileExist = FileLen(PathNameCandidate)
 On Error GoTo 0
 If FileExist > 0 Then
 VerifyOrGetDefaultPath = PathNameCandidate
 Exit Function
 End If
 End If
 
 '''' === (2a) === Array of prefixes
 Dim Prefixes As Variant
 Prefixes = Array( _
 ThisWorkbook.Path & PATHuSEP, _
 Environ$("APPDATA") & PATHuSEP & PROJuNAME & PATHuSEP _
 )
 
 '''' === (2b) === Array of filenames
 Dim NameCount As Long
 NameCount = 0
 If Len(FilePathName) > 1 And InStr(FilePathName, PATHuSEP) = 0 Then
 NameCount = NameCount + 1
 End If
 If VarType(DefaultExts) = vbString Then
 If Len(DefaultExts) > 0 Then NameCount = NameCount + 1
 ElseIf VarType(DefaultExts) >= vbArray Then
 NameCount = NameCount + UBound(DefaultExts, 1) - LBound(DefaultExts, 1) + 1
 Debug.Assert VarType(DefaultExts(0)) = vbString
 End If
 If NameCount = 0 Then
 VBA.Err.Raise _
 Number:=ErrNo.FileNotFoundErr, _
 Source:="CommonRoutines", _
 Description:="File <" & FilePathName & "> not found!"
 End If
 
 Dim FileNames() As String
 ReDim FileNames(0 To NameCount - 1)
 Dim ExtIndex As Long
 Dim FileNameIndex As Long
 FileNameIndex = 0
 If Len(FilePathName) > 1 And InStr(FilePathName, PATHuSEP) = 0 Then
 FileNames(FileNameIndex) = FilePathName
 FileNameIndex = FileNameIndex + 1
 End If
 If VarType(DefaultExts) = vbString Then
 If Len(DefaultExts) > 0 Then
 FileNames(FileNameIndex) = PROJuNAME & "." & DefaultExts
 End If
 ElseIf VarType(DefaultExts) >= vbArray Then
 For ExtIndex = LBound(DefaultExts, 1) To UBound(DefaultExts, 1)
 FileNames(FileNameIndex) = PROJuNAME & "." & DefaultExts(ExtIndex)
 FileNameIndex = FileNameIndex + 1
 Next ExtIndex
 End If
 
 '''' === (3) === Loop through pathnames
 Dim PrefixIndex As Long
 
 On Error Resume Next
 For PrefixIndex = 0 To UBound(Prefixes)
 For FileNameIndex = 0 To UBound(FileNames)
 PathNameCandidate = Prefixes(PrefixIndex) & FileNames(FileNameIndex)
 FileExist = FileLen(PathNameCandidate)
 Err.Clear
 If FileExist > 0 Then
 VerifyOrGetDefaultPath = Replace$(PathNameCandidate, _
 PATHuSEP & PATHuSEP, PATHuSEP)
 Exit Function
 End If
 Next FileNameIndex
 Next PrefixIndex
 On Error GoTo 0
 
 VBA.Err.Raise _
 Number:=ErrNo.FileNotFoundErr, _
 Source:="CommonRoutines", _
 Description:="File <" & FilePathName & "> not found!"
End Function

---

DbMetaData

DbMetaData currently provides a routine, which takes a table name and returns field names, types, and a mapping from field name to its position.

'@Folder "SecureADODB.DbManager.DbMetaData"
'@ModuleDescription "Database introspection functionality"
'@PredeclaredId
'@Exposed
Option Explicit
Private Type TDbMeta
 DbConnStr As DbConnectionString
End Type
'@Ignore MoveFieldCloserToUsage: Follow the standard pattern
Private this As TDbMeta
'@Description "Default factory"
Public Function Create(ByVal DbConnStr As DbConnectionString) As DbMetaData
 Dim Instance As DbMetaData
 Set Instance = New DbMetaData
 Instance.Init DbConnStr
 Set Create = Instance
End Function
'@Description "Default constructor"
Friend Sub Init(ByVal DbConnStr As DbConnectionString)
 Guard.NullReference DbConnStr
 Set this.DbConnStr = DbConnStr
End Sub
'@Ignore ParameterCanBeByVal: False positive
'@Description "Query table field metadata via the ADOX library"
Public Sub QueryTableADOXMeta(ByVal TableName As String, _
 ByRef FieldNames As Variant, _
 ByRef FieldTypes As Variant, _
 ByVal FieldMap As Scripting.Dictionary)
 Dim Catalog As ADOX.Catalog
 Set Catalog = New ADOX.Catalog
 Catalog.ActiveConnection = this.DbConnStr.ConnectionString
 Dim Table As ADOX.Table
 '@Ignore IndexedDefaultMemberAccess
 Set Table = Catalog.Tables(TableName)
 Dim FieldCount As Long
 FieldCount = Table.Columns.Count
 
 ReDim FieldNames(1 To FieldCount)
 ReDim FieldTypes(1 To FieldCount)
 
 Dim Column As ADOX.Column
 Dim FieldIndex As Long
 For FieldIndex = 1 To FieldCount
 '@Ignore IndexedDefaultMemberAccess
 Set Column = Table.Columns(FieldIndex - 1)
 FieldNames(FieldIndex) = Column.Name
 FieldTypes(FieldIndex) = Column.Type
 '@Ignore IndexedDefaultMemberAccess
 FieldMap(Column.Name) = FieldIndex
 Next FieldIndex
End Sub