Not a Member Yet,
Click here to Register
How do you like the new design?

ID: 146
Viewed: 3099
Added: Apr 28, 2002
Snippet uploaded by: snippet
Written By: unknown
Demo: Sorry, no demo

User Rated at: 0 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

Reg/UnRegister Components Through Code

Highlight all by clicking in box
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

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_TIMEOUT = &H102

' 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
' dwMilliseconds timed out

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

Highlight All

Sub main()
Call RegServer("comctl32.ocx", False)
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"
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
MsgBox "Failed To " & sCmd & " " & sServerPath, vbExclamation
End If

End Function;

No Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.

Replying to a Comment...

Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2018 All Rights Reserved. Conditions