VBA class managing loading DLL libraries

Question

I am playing with a custom-built SQLite library intending to access it from VBA via the C-language API. I keep the library within the project folder, so I load it via the LoadLibrary API. To make the load/unload process more robust, I created the DllManager class wrapping the LoadLibrary, FreeLibrary, and SetDllDirectory APIs. DllManager can be used for loading/unloading multiple DLLs. It wraps a Scripting.Dictionary object to hold <DLL name> → <DLL handle> mapping.

DllManager.Create factory takes one optional parameter, indicating the user's DLL location, and passes it to DllManager.Init constructor. Ultimately, the DefaultPath setter (Property Let) handles this parameter. The setter checks if the parameter holds a valid absolute or a relative (w.r.t. ThisWorkbook.Path) path. If this check succeeds, SetDllDirectory API sets the default DLL search path. DllManager.ResetDllSearchPath can be used to reset the DLL search path to its default value.

DllManager.Load loads individual libraries. It takes the target library name and, optionally, path. If the target library has not been loaded, it attempts to resolve the DLL location by checking the provided value and the DefaultPath attribute. If resolution succeeds, the LoadLibrary API is called. DllManager.Free, in turn, unloads the previously loaded library.

DllManager.LoadMultiple loads a list of libraries. It takes a variable list of arguments (ParamArray) and loads them in the order provided. Alternatively, it also accepts a 0-based array of names as the sole argument. This routine has a dependency UnfoldParamArray (see CommonRoutines module and the Guard subpackage), handling the "array argument" case; otherwise, this dependency can be removed. DllManager.FreeMultiple is the counterpart of .LoadMultiple with the same interface. If no arguments are provided, all loaded libraries are unloaded.

Finally, while .Free/.FreeMultiple can be called explicitly, Class_Terminate calls .FreeMultiple and .ResetDllSearchPath automatically before the object is destroyed.

DllManager.cls

#If VBA7 Then
 Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
 Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
 Private Declare PtrSafe Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryW" (ByVal lpPathName As String) As Boolean
#Else
 Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
 Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
 Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryW" (ByVal lpPathName As String) As Boolean
#End If
Private Const LOAD_OK As Long = -1
Private Const LOAD_FAIL As Long = 0
Private Const LOAD_ALREADY_LOADED As Long = 1
Private Type TDllManager
 DefaultPath As String
 Dlls As Scripting.Dictionary
End Type
Private this As TDllManager
'@DefaultMember
Public Function Create(Optional ByVal DefaultPath As String = vbNullString) As DllManager
 Dim Instance As DllManager
 Set Instance = New DllManager
 Instance.Init DefaultPath
 Set Create = Instance
End Function
Friend Sub Init(Optional ByVal DefaultPath As String = vbNullString)
 Set this.Dlls = New Scripting.Dictionary
 this.Dlls.CompareMode = TextCompare
 Me.DefaultPath = DefaultPath
End Sub
Private Sub Class_Terminate()
 ResetDllSearchPath
 FreeMultiple
End Sub
Public Property Get Dlls() As Scripting.Dictionary
 Set Dlls = this.Dlls
End Property
Public Property Get DefaultPath() As String
 DefaultPath = this.DefaultPath
End Property
Public Property Let DefaultPath(ByVal Value As String)
 '@Ignore SelfAssignedDeclaration: Stateless utility object
 Dim fso As New Scripting.FileSystemObject
 Dim Path As String
 If fso.FolderExists(Value) Then
 '''' Absolute existing path is provided
 Path = Value
 ElseIf fso.FolderExists(fso.BuildPath(ThisWorkbook.Path, Value)) Then
 '''' Relative existing path is provided
 Path = fso.BuildPath(ThisWorkbook.Path, Value)
 Else
 Err.Raise ErrNo.FileNotFoundErr, "DllManager", _
 "DefaultPath not found: <" & Value & ">"
 End If
 Path = fso.GetAbsolutePathName(Path)
 
 '''' Set the default dll directory for LoadLibrary
 '''' https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-setdlldirectorya#remarks
 Dim ExecStatus As Boolean
 ExecStatus = SetDllDirectory(Path)
 If ExecStatus Then
 this.DefaultPath = Path
 Else
 Debug.Print "SetDllDirectory failed. Error code: " & CStr(Err.LastDllError)
 End If
End Property
'''' https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-setdlldirectorya#remarks
Public Sub ResetDllSearchPath()
 Dim ExecStatus As Boolean
 ExecStatus = SetDllDirectory(vbNullString)
 If ExecStatus Then
 this.DefaultPath = vbNullString
 Else
 Debug.Print "Reset SetDllDirectory failed. Error code: " & CStr(Err.LastDllError)
 End If
End Sub
Public Function Load(ByVal DllName As String, Optional ByVal Path As String = vbNullString) As Long
 '@Ignore SelfAssignedDeclaration: Stateless utility object
 Dim fso As New Scripting.FileSystemObject
 Dim FileName As String
 FileName = fso.GetFileName(DllName)
 
 If this.Dlls.Exists(FileName) Then
 Debug.Print "A library with file name <" & FileName & "> has already been loaded."
 Load = LOAD_ALREADY_LOADED
 Exit Function
 End If
 
 Dim Prefix As String
 If fso.FolderExists(Path) Then
 '''' Absolute existing path is provided
 Prefix = Path
 ElseIf fso.FolderExists(fso.BuildPath(ThisWorkbook.Path, Path)) Then
 '''' Relative existing path is provided
 Prefix = fso.BuildPath(ThisWorkbook.Path, Path)
 Else
 '''' Default path
 Prefix = fso.BuildPath(fso.BuildPath(ThisWorkbook.Path, "Library"), _
 ThisWorkbook.VBProject.Name)
 End If
 Prefix = fso.GetAbsolutePathName(Prefix)
 
 
 Dim FilePathName As String
 If fso.FileExists(DllName) Then
 FilePathName = DllName
 ElseIf fso.FileExists(fso.BuildPath(Prefix, DllName)) Then
 FilePathName = fso.BuildPath(Prefix, DllName)
 ElseIf fso.FileExists(fso.BuildPath(this.DefaultPath, DllName)) Then
 FilePathName = fso.BuildPath(this.DefaultPath, DllName)
 Else
 Err.Raise ErrNo.FileNotFoundErr, "DllManager", _
 "DllName not found: <" & DllName & ">"
 End If
 FilePathName = fso.GetAbsolutePathName(FilePathName)
 
 Dim DllHandle As Long
 DllHandle = LoadLibrary(FilePathName)
 If DllHandle <> 0 Then
 '@Ignore IndexedDefaultMemberAccess: Dictionary
 this.Dlls(FileName) = DllHandle
 Debug.Print "<" & DllName & "> loaded."
 Load = LOAD_OK
 Else
 Debug.Print "Library <" & FilePathName & "> loading error: " & CStr(Err.LastDllError)
 Load = LOAD_FAIL
 End If
End Function
Public Function Free(Optional ByVal DllName As String) As Long
 '@Ignore SelfAssignedDeclaration: Stateless utility object
 Dim fso As New Scripting.FileSystemObject
 Dim FileName As String
 FileName = fso.GetFileName(DllName)
 Dim Result As Long
 If Not this.Dlls.Exists(FileName) Then
 Debug.Print "<" & DllName & "> not loaded."
 Free = LOAD_OK
 Else
 Result = FreeLibrary(this.Dlls(FileName))
 If Result <> 0 Then
 Debug.Print "<" & DllName & "> unloaded."
 Free = LOAD_OK
 this.Dlls.Remove FileName
 Else
 Free = LOAD_FAIL
 Debug.Print "Error unloading <" & DllName & ">. Result: " _
 & CStr(Result) & ". LastDllError: "; CStr(Err.LastDllError)
 End If
 End If
End Function
Public Function LoadMultiple(ParamArray DllNames() As Variant) As Long
 Dim Result As Long
 Result = LOAD_OK
 Dim FileNames() As Variant
 FileNames = UnfoldParamArray(DllNames)
 Dim FileNameIndex As Long
 For FileNameIndex = LBound(FileNames) To UBound(FileNames)
 Result = Result And Load(FileNames(FileNameIndex))
 Next FileNameIndex
 LoadMultiple = -Abs(Result)
End Function
Public Function FreeMultiple(ParamArray DllNames() As Variant) As Long
 Dim Result As Long
 Result = LOAD_OK
 Dim FileNames() As Variant
 FileNames = UnfoldParamArray(DllNames)
 If UBound(FileNames) - LBound(FileNames) + 1 = 0 Then FileNames = this.Dlls.Keys
 Dim FileNameIndex As Long
 For FileNameIndex = LBound(FileNames) To UBound(FileNames)
 Result = Result And Free(FileNames(FileNameIndex))
 Next FileNameIndex
 FreeMultiple = Result
End Function

The DllManagerDemo example below illustrates how this class can be used and compares the usage patterns between system and user libraries. In this case, WinSQLite3 system library is used as a reference (see GetWinSQLite3VersionNumber). A call to a custom compiled SQLite library placed in the project folder demos the additional code necessary to make such a call (see GetSQLite3VersionNumber). In both cases, sqlite3_libversion_number routine, returning the numeric library version, is declared and called.

'@Folder "DllManager"
Option Explicit
Option Private Module
#If VBA7 Then
'''' System library
Private Declare PtrSafe Function winsqlite3_libversion_number Lib "WinSQLite3" Alias "sqlite3_libversion_number" () As Long
'''' User library
Private Declare PtrSafe Function sqlite3_libversion_number Lib "SQLite3" () As Long
#Else
'''' System library
Private Declare Function winsqlite3_libversion_number Lib "WinSQLite3" Alias "sqlite3_libversion_number" () As Long
'''' User library
Private Declare Function sqlite3_libversion_number Lib "SQLite3" () As Long
#End If
Private Type TDllManagerDemo
 DllMan As DllManager
End Type
Private this As TDllManagerDemo
Private Sub GetWinSQLite3VersionNumber()
 Debug.Print winsqlite3_libversion_number()
End Sub
Private Sub GetSQLite3VersionNumber()
 '''' Absolute or relative to ThisWorkbook.Path
 Dim DllPath As String
 DllPath = "Library\SQLiteCforVBA\dll\x32"
 
 SQLiteLoadMultipleArray DllPath
 Debug.Print sqlite3_libversion_number()
 Set this.DllMan = Nothing
End Sub
Private Sub SQLiteLoadMultipleArray(ByVal DllPath As String)
 Dim DllMan As DllManager
 Set DllMan = DllManager(DllPath)
 Set this.DllMan = DllMan
 Dim DllNames As Variant
 DllNames = Array( _
 "icudt68.dll", _
 "icuuc68.dll", _
 "icuin68.dll", _
 "icuio68.dll", _
 "icutu68.dll", _
 "sqlite3.dll" _
 )
 DllMan.LoadMultiple DllNames
End Sub
' ========================= '
' Additional usage examples '
' ========================= '
Private Sub SQLiteLoadMultipleParamArray()
 Dim RelativePath As String
 RelativePath = "Library\SQLiteCforVBA\dll\x32"
 
 Dim DllMan As DllManager
 Set DllMan = DllManager(RelativePath)
 
 DllMan.LoadMultiple _
 "icudt68.dll", _
 "icuuc68.dll", _
 "icuin68.dll", _
 "icuio68.dll", _
 "icutu68.dll", _
 "sqlite3.dll"
End Sub
Private Sub SQLiteLoad()
 Dim RelativePath As String
 RelativePath = "Library\SQLiteCforVBA\dll\x32"
 
 Dim DllMan As DllManager
 Set DllMan = DllManager(RelativePath)
 Dim DllNames As Variant
 
 DllNames = Array( _
 "icudt68.dll", _
 "icuuc68.dll", _
 "icuin68.dll", _
 "icuio68.dll", _
 "icutu68.dll", _
 "sqlite3.dll" _
 )
 
 Dim DllNameIndex As Long
 For DllNameIndex = LBound(DllNames) To UBound(DllNames)
 Dim DllName As String
 DllName = DllNames(DllNameIndex)
 DllMan.Load DllName, RelativePath
 Next DllNameIndex
End Sub

The source code is deposited into a GitHub repo

• Greedo: In your examples could you please include when and how you call the free methods, and how you might be using this class in conjunction with the code to actually call into the loaded DLL? It's hard to comment on the interface without seeing the context of the entire lifetime of instances of this class, not just their creation.
• PChemGuy: Thank you, @Greedo for your pointers. I have updated the question to address your questions. Please note that the Class_Terminate destructor unloads the libraries.