'模块名: ActiveX 部件(OCX DLL)注册/反注册
'描 述: 该代码演示怎样在程序中注册和反注册,在regsvr32上自己进行.
Option Explicit

Private Declare Function LoadLibraryRegister _
Lib "KERNEL32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function
FreeLibraryRegister _
Lib "KERNEL32" _
Alias "FreeLibrary" (ByVal hLibModule As Long) As Long

Private Declare Function
CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long

Private Declare Function
GetProcAddressRegister _
Lib "KERNEL32" _
Alias "GetProcAddress" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Private Declare Function
CreateThreadForRegister _
Lib "KERNEL32" _
Alias "CreateThread" (lpThreadAttributes As Long, _
ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, _
ByVal lpparameter As Long, _
ByVal dwCreationFlags As Long, _
lpThreadID
As Long) As Long

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

Private Declare Function
GetExitCodeThread _
Lib "KERNEL32" (ByVal hThread As Long, _
lpExitCode
As Long) As Long

Private Declare Sub
ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)

Private Const STATUS_WAIT_0 = &H0

Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)

Private Const NOERRORS As Long = 0

Private Enum stRegisterStatus
stFileCouldNotBeLoadedIntoMemorySpace =
1
stNotAValidActiveXComponent = 2
stActiveXComponentRegistrationFailed = 3
stActiveXComponentRegistrationSuccessful = 4
stActiveXComponentUnRegisterSuccessful = 5
stActiveXComponentUnRegistrationFailed = 6
stNoFileProvided = 7
End Enum

Public Function
Register(ByVal p_sFileName As String) As Variant
Dim
lLib As Long
Dim
lProcAddress As Long
Dim
lThreadID As Long
Dim
lSuccess As Long
Dim
lExitCode As Long
Dim
lThreadHandle As Long
Dim
lRet As Long

On Error GoTo
ErrorHandler

If lRet = NOERRORS Then
If
p_sFileName = "" Then
lRet = stNoFileProvided
End If
End If

If
lRet = NOERRORS Then
lLib = LoadLibraryRegister(p_sFileName)
If lLib = 0 Then
lRet = stFileCouldNo
tBeLoadedIntoMemorySpace
End If
End If

If
lRet = NOERRORS Then
lProcAddress = GetProcAddressRegister(lLib, "DllRegisterServer")
If lProcAddress = 0 Then
lRet = stNotAValidActiveXComponent
Else
lThreadHandle = CreateThreadForRegister(0, 0, lProcAddress, 0, 0, lThreadID)
If lThreadHandle <> 0 Then
lSuccess = (WaitForSingleObject(lThreadHandle, 10000) = WAIT_OBJECT_0)
If lSuccess = 0 Then
Call
GetExitCodeThread(lThreadHandle, lExitCode)
Call ExitThread(lExitCode)
lRet = stActiveXComponentRegistrationFailed
Else
lRet = stActiveXComponentRegistrationSuccessful
End If
End If
End If
End If

ExitRoutine:

Register = lRet

If lThreadHandle <> 0 Then
Call
CloseHandle(lThreadHandle)
End If

If
lLib <> 0 Then
Call
FreeLibraryRegister(lLib)
End If

Exit Function

ErrorHandler:
lRet = Err.Number
Resume ExitRoutine
End Function

Public Function
UnRegister(ByVal p_sFileName As String) As Variant
Dim
lLib As Long
Dim
lProcAddress As Long
Dim
lThreadID As Long
Dim
lSuccess As Long
Dim
lExitCode As Long
Dim
lThreadHandle As Long
Dim
lRet As Long

On Error GoTo
ErrorHandler

If lRet = NOERRORS Then
If
p_sFileName = "" Then
lRet = stNoFileProvided
End If
End If

If
lRet = NOERRORS Then
lLib = LoadLibraryRegister(p_sFileName)
If lLib = 0 Then
lRet = stFileCouldNotBeLoadedIntoMemorySpace
End If
End If

If
lRet = NOERRORS Then
lProcAddress = GetProcAddressRegister(lLib, "DllUnregisterServer")
If lProcAddress = 0 Then
lRet = stNotAValidActiveXComponent
Else
lThreadHandle = CreateThreadForRegister(0, 0, lProcAddress, 0, 0, lThreadID)
If lThreadHandle <> 0 Then
lSuccess = (WaitForSingleObject(lThreadHandle, 10000) = WAIT_OBJECT_0)
If lSuccess = 0 Then
Call
GetExitCodeThread(lThreadHandle, lExitCode)
Call ExitThread(lExitCode)
lRet = stActiveXComponentUnRegistrationFailed
Else
lRet = stActiveXComponentUnRegisterSuccessful
End If
End If
End If
End If

ExitRoutine:

UnRegister = lRet

If lThreadHandle <> 0 Then
Call
CloseHandle(lThreadHandle)
End If

If
lLib <> 0 Then
Call
FreeLibraryRegister(lLib)
End If

Exit Function

ErrorHandler:
lRet = Err.Number
Resume ExitRoutine
End Function


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!