Snippet Library

Option Explicit

Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Declare Function FreeLibrary Lib "kernel32" _                            (ByVal hLibModule As Long) As Long

Declare Function GetProcAddress Lib "kernel32" _                            (ByVal hModule As Long, ByVal lpProcName As String) As Long

Declare Function CreateThread Lib "kernel32" _                            (lpThreadAttributes As Any, _                            ByVal dwStackSize As Long, _                            lpStartAddress As Long, _                            lpParameter As Any, _                            ByVal dwCreationFlags As Long, _                            lpThreadID As Long) As Long
' (lpThreadAttributes As SECURITY_ATTRIBUTES, _

' dwCreationFlags param, call ResumeThread to
' wake the thread up, specify 0 for an alive thread
Public Const CREATE_SUSPENDED = &H4

Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _                            ByVal dwMilliseconds As Long) As Long

' dwMilliseconds param, specify 0 for immediate return.
Public Const INFINITE = &HFFFFFFFF   ' Infinite timeout

' WaitForSingleObject rtn vals
Public Const STATUS_WAIT_0 = &H0
Public Const STATUS_ABANDONED_WAIT_0 = &H80
Public Const STATUS_TIMEOUT = &H102

Public Const WAIT_FAILED = &HFFFFFFFF
' The state of the specified object is signaled (success)
Public Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)
' Thread went away before the mutex got signaled
Public Const WAIT_ABANDONED = ((STATUS_ABANDONED_WAIT_0) + 0)
' dwMilliseconds timed out
Public Const WAIT_TIMEOUT = STATUS_TIMEOUT

Declare Function CloseHandle Lib "kernel32" _
                            (ByVal hObject As Long) As Long
Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)

Declare Function ResumeThread Lib "kernel32" _
                            (ByVal hThread As Long) As Long
Declare Function GetExitCodeThread Lib "kernel32" _
                            (ByVal hThread As Long, _
                            lpExitCode As Long) As Long
Public Const STATUS_PENDING = &H103
Public Const STILL_ACTIVE = STATUS_PENDING
'

Sub main()
  Call RegServer("comctl32.ocx", False)
  Stop
  Call RegServer("comctl32.ocx")
End Sub

' Registers or unregisters the specified COM server.
'   sServerPath  - server's path, either explicit, or relative if the system can find it
'   fRegister       - optional flag indicating what operation to perform:
'                         True (defualt) registers the server, False unregisters it.

' Returns True on success, False otherwise.

Public Function RegServer(sServerPath As String, _
                                       Optional fRegister = True) As Boolean
  
  Dim hMod As Long               ' module handle
  Dim lpfn As Long                  ' reg/unreg function address
  Dim sCmd As String             ' msgbox string
  Dim lpThreadID As Long        ' unused, receives the thread ID
  Dim hThread As Long            ' thread handle
  Dim fSuccess As Boolean     ' if things worked
  Dim dwExitCode As Long      ' thread's exit code if it doesn't finish

  ' Load the server into memory
  hMod = LoadLibrary(sServerPath)
  
  ' Get the specified function's address and our msgbox string.
  If fRegister Then
    lpfn = GetProcAddress(hMod, "DllRegisterServer")
    sCmd = "register"
  Else
    lpfn = GetProcAddress(hMod, "DllUnregisterServer")
    sCmd = "unregister"
  End If

  ' If we got a function address...
  If lpfn Then
    
    ' Create an alive thread and execute the function.
    hThread = CreateThread(ByVal 0, 0, ByVal lpfn, ByVal 0, 0, lpThreadID)
    
    ' If we got the thread handle...
    If hThread Then
      
      ' Wait 10 secs for the thread to finish (the function may take a while...)
      fSuccess = (WaitForSingleObject(hThread, 10000) = WAIT_OBJECT_0)
      
      ' If it didn't finish in 10 seconds...
      If Not fSuccess Then
        ' Something unlikely happened, lose the thread.
        Call GetExitCodeThread(hThread, dwExitCode)
        Call ExitThread(dwExitCode)
      End If
      
      ' Lose the thread handle
      Call CloseHandle(hThread)
    
    End If   ' hThread
  End If   ' lpfn

  ' Free the server if we loaded it.
  If hMod Then Call FreeLibrary(hMod)

  If fSuccess Then
    MsgBox "Successfully " & sCmd & "ed " & sServerPath   ' past tense
    RegServer = True
  Else
    MsgBox "Failed To " & sCmd & " " & sServerPath, vbExclamation
  End If

End Function;