Registra un OCX con API (o Cancella) !!!!!!!!!!

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