Create a new module and paste this code into it. Call the module basRegistration.
If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: basRegistration
' Written By: C&D Programming Corp.
' Create Date: 2/2000
' Copyright: Copyright 2000 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
'----------------------------------------------------------------------
Option Explicit
Private Declare Function LoadLibrary Lib "KERNEL32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "KERNEL32" _
(ByVal lLibModule As Long) As Long
Private Declare Function GetProcAddressRegister Lib "KERNEL32" _
Alias "GetProcAddress" (ByVal Module As Long, _
ByVal lpProcName As String) As Long
Private Declare Function CreateThreadForRegister Lib "KERNEL32" _
Alias "CreateThread" (lpThreadAttributes As Any, _
ByVal lStackSize As Long, ByVal lpStartAddress As Long, _
ByVal lpParameter As Long, ByVal lCreationFlags As Long, _
lpThreadID As Long) As Long
Private Declare Function WaitForSingleObject Lib "KERNEL32" _
(ByVal lHandle As Long, _
ByVal lMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "KERNEL32" _
(ByVal lThread As Long, lpExitCode As Long) As Long
Private Declare Sub ExitThread Lib "KERNEL32" (ByVal lExitCode As Long)
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal lObject As Long) As Long
Public Enum eRegStatus
statSuccess
statCouldNotLoadInMemorySpace
statInvalidActiveXComponent
statRegistrationFailed
End Enum
Public Function RegisterComponent(sFilename As String) As eRegStatus
RegisterComponent = CallRegFunction(sFilename, "DllRegisterServer")
End Function
Public Function UnregisterComponent(sFilename As String) As eRegStatus
UnregisterComponent = CallRegFunction(sFilename, "DllUnregisterServer")
End Function
Private Function CallRegFunction(sFilename As String, sFunction As String) As eRegStatus
Dim lLib As Long
Dim lProcAddress As Long
Dim lThreadID As Long
Dim lExitCode As Long
Dim lThread As Long
If sFilename = "" Then Exit Function
lLib = LoadLibrary(sFilename)
If lLib = 0 Then
CallRegFunction = statCouldNotLoadInMemorySpace
Exit Function
End If
lProcAddress = GetProcAddressRegister(lLib, sFunction)
If lProcAddress = 0 Then
CallRegFunction = statInvalidActiveXComponent
GoTo Cleanup
Else
lThread = CreateThreadForRegister(ByVal 0&, 0&, ByVal lProcAddress, _
ByVal 0&, 0&, lThreadID)
If lThread Then
If WaitForSingleObject(lThread, 10000) <> 0 Then
Call GetExitCodeThread(lThread, lExitCode)
Call ExitThread(lExitCode)
CallRegFunction = statRegistrationFailed
GoTo Cleanup
Else
CallRegFunction = statSuccess
End If
Call CloseHandle(lThread)
End If
End If
Cleanup:
If lLib <> 0 Then
Call FreeLibrary(lLib)
End If
End Function