' Die notwendigen API-Deklarationen:
Private Const WAIT_ABANDONED As Long = &H80&
Private Const WAIT_FAILED    As Long = &HFFFFFFFF
Private Const WAIT_OBJECT_0  As Long = &H0&
Private Const WAIT_TIMEOUT   As Long = &H102&
Private Const INFINITE       As Long = &HFFFF&
 
Private Declare Function LoadLibrary Lib "Kernel32" Alias "LoadLibraryA" (ByVal _
  FileName As String) As Long
Private Declare Function FreeLibrary Lib "Kernel32" (ByVal hModule As Long) As _
Long
Private Declare Function GetProcAddress Lib "Kernel32" (ByVal hModule As Long, _
ByVal ProcedureName As String) As Long
Private Declare Function CreateThread Lib "Kernel32" ( _
                                                      ByRef ThreadAttributes As _
                                                      Any, _
                                                      ByVal StackSize As Long, _
                                                      ByVal StartAddress As _
                                                      Long, _
                                                      ByVal Parameter As Long, _
                                                      ByVal CreationFlags As _
                                                      Long, _
                                                      ByRef ThreadID As Long _
                                                      ) As Long
Private Declare Function GetExitCodeThread Lib "Kernel32" (ByVal hThread As _
  Long, ByRef ExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "Kernel32" (ByVal hObject As _
Long, ByVal TimeOut As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As _
Long
 
Public Function RegisterServer(ByVal PathToFile As String, _
                               Optional ByVal Register As Boolean = True, _
                               Optional ByVal TimeOut As Long = 5000 _
                               ) As Boolean
' Registriert oder deregistriert eine ActiveX-DLL oder ein OCX
' -----------------------------------------------------------------------------
' ---
' Parameterinformation:
' -----------------------------------------------------------------------------
' ---
'
' - PathToFile:   Vollständiger Pfad zur Datei, die den COM-Server enthält.
'
' - Register:     TRUE, um den COM-Server zu registrieren.
'   (optional)    FALSE, um den COM-Server zu deregistrieren.
'                 Standardwert: TRUE (Registrierung des COM-Servers)
'
' - TimeOut:      Zeit in Millisekunden, die maximal auf den Vorgang
'   (optional)    verwendet werden soll. Im Regelfall gibt die Funktion
'                 sofort nach erledigter Registrierung/Deregistrierung
'                 oder nach erkannter Unmöglichkeit der Aktion die Ablauf-
'                 kontrolle an den Aufrufer zurück.
'                 Standardwert: 5000 (maximal 5 Sekunden)
'
' Rückgabewert:   TRUE bei erfolgreicher Aktion, FALSE bei erfolgloser Aktion.
'
' -----------------------------------------------------------------------------
' ---
Dim hModule As Long      ' Handle auf ein geladenes Modul
Dim lProcAddress As Long ' Adresse einer Funktion in einem geladenen Modul
Dim hThread As Long      ' Handle auf einen Thread
Dim loclngThread As Long    ' ID eines Threads
Dim lResult As Long      ' Rückgabewert für WaitForSingleObject
Dim lExitCode As Long    ' Exit-Code des erzeugten Threads
 
  ' Versuchen, die angegebene Datei als Modul zu laden
  hModule = LoadLibrary(PathToFile)
 
  ' Wenn kein Modul-Handle vorliegt, war LoadLibrary erfolglos:
  If hModule = 0 Then
    Exit Function
  End If
 
  ' Versuchen, die Adresse der Funktion DllRegisterServer (bzw.
  ' DllUnregisterServer) zu ermitteln:
  lProcAddress = GetProcAddress(hModule, IIf(Register, "DllRegisterServer", _
    "DllUnregisterServer"))
 
  ' Sofern Funktionsadresse = 0, war GetProcAddress erfolglos:
  If lProcAddress = 0 Then
    FreeLibrary hModule ' Bereits geladenes Modul freigeben
    Exit Function
  End If
 
  ' Versuchen, die Funktion aufzurufen:
  hThread = CreateThread(ByVal 0&, 0, lProcAddress, 0, 0, loclngThread)
 
  ' Liegt kein Thread-Handle vor, war CreateThread erfolglos:
  If hThread = 0 Then
    FreeLibrary hModule ' Bereits geladenes Modul freigeben
    Exit Function
  End If
 
  ' Auf Abarbeitung der Ausführung (oder auf TimeOut) warten:
  lResult = WaitForSingleObject(hThread, TimeOut)
 
  ' Liefert WaitForSingleObject WAIT_OBJECT_0 zurück, war
  ' die Abarbeitung vor Erreichen des TimeOuts erfolgreich:
  If lResult = WAIT_OBJECT_0 Then
    ' ExitCode des Threads ermitteln - bei Rückgabe von 0
    ' hat die aufgerufene Funktion die Aktion erfolgreich
    ' durchgeführt:
    GetExitCodeThread hThread, lExitCode
    If lExitCode = 0 Then
      RegisterServer = True
    End If
  End If
  CloseHandle hThread ' Handle auf den erzeugten Thread freigeben
  FreeLibrary hModule ' Geladenes Modul freigeben
End Function