[RESOLVED] Early Bound Objects and Standard StdCall DLLs

[VanGoghGaming]

Yes, it's good practice to check with "GetModuleHandle" before calling "LoadLibrary". If the library had already been loaded then "LoadLibrary" will not load it again but simply return the handle (same as "GetModuleHandle") and also increment an internal "RefCount" used when calling "FreeLibrary". However we almost never need to call "FreeLibrary" since nowadays there is enough RAM available to keep them loaded until the application is closed (also we need to keep ActiveX DLLs loaded to be able to instantiate objects from them).

You mentioned the code was slow when trying to instantiate many objects and this can be addressed by using the same instance of "ClassFactory" once obtained instead of starting over each time. Here is the same version of TheTrick's code compacted and commented for easier understanding (sorry I don't have the pretty colors like your code ):

Option Explicit

Private Const DllGetClassObject As String = "DllGetClassObject"

Private Enum ConstantsEnum
    MEMBERID_NIL = -1
    S_OK
    S_FALSE
    REGKIND_NONE
    CC_STDCALL = 4
    PTR_SIZE = 4
End Enum

Private Enum vtbInterfaceOffsets
    ITypeLib_FindName = 11 * PTR_SIZE
    ITypeInfo_GetTypeAttr = 3 * PTR_SIZE
    ITypeInfo_ReleaseTypeAttr = 19 * PTR_SIZE
    IClassFactory_CreateInstance = 3 * PTR_SIZE
End Enum

Private Declare Function LoadLibraryW Lib "kernel32" (ByVal lpLibFileName As Long) As Long
Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgvt As Any, prgpvarg As Any, pvargResult As Variant) As Long
Private Declare Function LoadTypeLibEx Lib "oleaut32" (ByVal lpszFile As Long, ByVal RegKind As Long, pptLib As IUnknown) As Long

Private IClassFactory As IUnknown, ParamTypes(0 To 10) As Integer, ParamValues(0 To 10) As Long, lParamCount As Long, lpInterface As Long, vParams As Variant, _
        sCurrentLib As String, lpDllGetClassObject As Long, IID_IClassFactory(0 To 1) As Currency, IID_IUnknown(0 To 1) As Currency

Public Sub Main()
Dim objRegFree1 As MyClass, objRegFree2 As MyClass
    Set objRegFree1 = RegFree(App.Path & "\Bin\MyActiveX.dll", "MyClass")
    Set objRegFree2 = RegFree ' second and subsequent instantiations should be much faster as the ClassFactory is already created
    objRegFree1.CallSomeMethod
    objRegFree2.CallSomeMethod
End Sub

Private Function RegFree(Optional sLibName As String, Optional sClassName As String, Optional bNewClass As Boolean) As Object
Dim RegFreeIUnknown As IUnknown, ITypeLib As IUnknown, ITypeInfo As IUnknown, rgMemId As Long, pcFound As Long, lpTypeAttr As Long
    If bNewClass Then Set IClassFactory = Nothing ' Start over and instantiate objects from a new class name or from another ActiveX DLL
    If IClassFactory Is Nothing Then ' Once "IClassFactory" is instantiated we can keep using it to create new objects
        If LoadTypeLibEx(StrPtr(sLibName), REGKIND_NONE, ITypeLib) = S_OK Then ' REGKIND_NONE calls LoadTypeLib without the registration process enabled
            pcFound = 1 ' We want to find only one instance of this class name (there shouldn't be duplicates anyway)
            InvokeObj ITypeLib, ITypeLib_FindName, StrPtr(sClassName), 0&, VarPtr(ITypeInfo), VarPtr(rgMemId), VarPtr(pcFound) ' Search the TypeLib for our class name
            If rgMemId = MEMBERID_NIL Then ' If the class name is found then "rgMemId" will return MEMBERID_NIL
                If sLibName <> sCurrentLib Then
                    sCurrentLib = sLibName: lpDllGetClassObject = GetModuleHandleW(StrPtr(sCurrentLib)) ' Check if the library had already been loaded
                    If lpDllGetClassObject = 0 Then lpDllGetClassObject = LoadLibraryW(StrPtr(sCurrentLib)) ' If not then we load it
                    lpDllGetClassObject = GetProcAddress(lpDllGetClassObject, DllGetClassObject) ' Get the pointer to the DllGetClassObject function
                    If IID_IClassFactory(1) = 0 Then IID_IClassFactory(0) = 0.0001@: IID_IClassFactory(1) = 504403158265495.5712@: IID_IUnknown(1) = IID_IClassFactory(1) ' These IIDs are very similar so we hold them in "Currency" constants
                End If
                InvokeObj ITypeInfo, ITypeInfo_GetTypeAttr, VarPtr(lpTypeAttr) ' The first member of the "TypeAttr" structure is the class GUID so we don't need to CopyMemory its contents
                If lpTypeAttr Then InvokeObj Nothing, lpDllGetClassObject, lpTypeAttr, VarPtr(IID_IClassFactory(0)), VarPtr(IClassFactory) ' Call DllGetClassObject to retrieve the class object from the DLL object handler
                InvokeObj ITypeInfo, ITypeInfo_ReleaseTypeAttr, lpTypeAttr ' Release the previously allocated "TypeAttr" structure
            End If
        End If
    End If
    If InvokeObj(IClassFactory, IClassFactory_CreateInstance, 0&, VarPtr(IID_IUnknown(0)), VarPtr(RegFreeIUnknown)) = S_OK Then ' Create an instance of this class
        Set RegFree = RegFreeIUnknown ' Get the IDispatch implementation of this class
    End If
End Function

Private Function InvokeObj(Interface As IUnknown, vtbOffset As Long, ParamArray ParamsArray() As Variant) As Variant
Dim lRet As Long
    InvokeObj = S_FALSE: lpInterface = ObjPtr(Interface): vParams = ParamsArray ' Make a copy of the array of parameters to get rid of any VT_BYREF members
    For lParamCount = 0 To UBound(vParams): ParamTypes(lParamCount) = VarType(vParams(lParamCount)): ParamValues(lParamCount) = VarPtr(vParams(lParamCount)): Next lParamCount
    If lpInterface Then ' Call the object's method found at "vtbOffset" in its VTable
        lRet = DispCallFunc(lpInterface, vtbOffset, CC_STDCALL, vbLong, lParamCount, ParamTypes(0), ParamValues(0), InvokeObj)
    ElseIf vtbOffset > 1024 Then ' The object is "Nothing" so here we call a function pointer instead
        lRet = DispCallFunc(lpInterface, vtbOffset, CC_STDCALL, vbLong, lParamCount, ParamTypes(0), ParamValues(0), InvokeObj)
    End If
    If lRet Then Debug.Print Hex$(lRet) ' Display a helpful error code if DispCallFunc was called with an incorrect number or type of parameters (and it didn't crash right away!)
End Function

If you look at the "RegFree" function above, all the work of loading the TypeLib, searching the class name and creating the ClassFactory is done only once in the main "If block" and then subsequent objects are instantiated super fast.

If you need to instantiate other objects from other ActiveX DLLs then simply call "RegFree" with the optional "bNewClass" parameter and it will start over from the initial step. I've commented each line of code as best I could.