vbAccelerator - Contents of code file: cLibrary.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cLibrary"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' To Report API errors:
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA"
 (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal
 dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments
 As Long) As Long


Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA"
 (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As
 Long
' Missing from VB API declarations:
Private Const DONT_RESOLVE_DLL_REFERENCES = &H1&
Private Const LOAD_LIBRARY_AS_DATAFILE = &H2&
Private Const LOAD_WITH_ALTERED_SEARCH_PATH = &H8&
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 m_sFileName As String
Private m_hMod As Long

Public Property Get Filename() As String
   Filename = m_sFileName
End Property

Public Property Let Filename(ByVal sFileName As String)
   ClearUp
   m_sFileName = sFileName
   If m_sFileName <> "" Then
      m_hMod = LoadLibraryEx(m_sFileName, 0, 0)
      If (m_hMod = 0) Then
         Err.Raise vbObjectError + 1048 + 1, App.EXEName & ".cLibrary",
          WinError(Err.LastDllError)
      End If
   End If
End Property

Public Property Get hModule() As Long
   hModule = m_hMod
End Property

Private Sub ClearUp()
   If (m_hMod <> 0) Then
      FreeLibrary m_hMod
   End If
   m_hMod = 0
   m_sFileName = ""
End Sub

Private Function WinError(ByVal lLastDLLError As Long) As String
Dim sBuff As String
Dim lCount As Long
    
    ' Return the error message associated with LastDLLError:
    sBuff = String$(256, 0)
    lCount = FormatMessage( _
      FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
      0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
    If lCount Then
      WinError = left$(sBuff, lCount)
    End If
               
End Function
Private Sub Class_Terminate()
   ClearUp
End Sub