Programming » Visual Basic 6 » Visual Basic 6 Code » Miscellaneous » ");?>
Register any DLL/OCX by specifying it's filename.
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias _
        "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
        lpdwHandle As LongAs Long

Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" _
        (ByVal lptstrFilename As StringByVal dwhandle As LongByVal dwlen As Long, _
        lpdata As Any) As Long

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
        (ByVal lpLibFileName As StringAs Long

Private Declare Function GetProcAddress Lib "kernel32" _
        (ByVal hModule As LongByVal lpProcName As StringAs Long

Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, _
        ByVal dwStackSize As LongByVal lpStartAddress As Long, _
        ByVal lParameter As LongByVal dwCreationFlags As Long, _
        lpThreadID As LongAs Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
        (ByVal hHandle As LongByVal dwMilliseconds As LongAs Long

Private Declare Function GetExitCodeThread Lib "kernel32" _
        (ByVal hThread As Long, lpExitCode As LongAs Long

Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)

Private Declare Function FreeLibrary Lib "kernel32" _
        (ByVal hLibModule As LongAs Long

Private Declare Function CloseHandle Lib "kernel32" _
        (ByVal hObject As LongAs Long

Public Enum DLLRegServiceResults
    regSuccess = 0
    regFailLoadLib
    regFailCreateThread
    regThreadTimeout
End Enum

Public Function DLLRegisterService(ByVal FileLocation As String, _
            ByVal Register As BooleanAs DLLRegServiceResults
    Dim hLib As Long    'Handle of the control library
    Dim lpDLLEntryPoint As Long    'Address of Function
                                   ' [DllRegisterServer/DllUnregisterServer]
    Dim lpThreadID As Long    ' Pointer that receives the thread identifier
    Dim lpExitCode As Long    ' Exit code of GetExitCodeThread
    Dim mResult As Long
    Dim hThread As Long
    Const RegProcName = "DllRegisterServer"
    Const UnregProcName = "DllUnregisterServer"

    'Load the library
    hLib = LoadLibrary(FileLocation)

    If hLib = 0 Then
        DLLRegisterService = regFailLoadLib
        Exit Function
    End If

    'Find the function entry point [DllRegisterServer/DllUnregisterServer]
    lpDLLEntryPoint = GetProcAddress(hLib, IIf(Register, RegProcName, UnregProcName))

    If lpDLLEntryPoint = vbNull Then
        FreeLibrary hLib
        DLLRegisterService = regFailLoadLib
        Exit Function
    End If
    'Create a thread to execute the function
    hThread = CreateThread(ByVal 0, 0, ByVal lpDLLEntryPoint, ByVal 0, 0, lpThreadID)

    If hThread = 0 Then
        FreeLibrary hLib
        DLLRegisterService = regFailCreateThread
        Exit Function
    End If
    'WaitForSingleObject returns 0 if it times out
    mResult = WaitForSingleObject(hThread, 10000)

    If mResult <> 0 Then
        FreeLibrary hLib
        lpExitCode = GetExitCodeThread(hThread, lpExitCode)
        ExitThread lpExitCode
        DLLRegisterService = regThreadTimeout
        Exit Function
    End If

    'close object
    CloseHandle hThread
    FreeLibrary hLib
    DLLRegisterService = regSuccess
End Function