regunreg.bas

OCX DLL注册工具 OCX DLL注册工具

Attribute VB_Name = "Module1"
Option Explicit

Global menum As STATUS

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 Any, 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)

Public Enum REGISTER_FUNCTIONS

    DllRegisterServer = 1

    DllUnRegisterServer = 2

End Enum

Public Enum STATUS

    [File Could Not Be Loaded Into Memory Space] = 1

    [Not A Valid ActiveX Component] = 2

    [ActiveX Component Registration Failed] = 3

    [ActiveX Component Registered Successfully] = 4

    [ActiveX Component UnRegistered Successfully] = 5

End Enum

Public Function RegisterComponent(ByVal FileName$, ByVal RegFunction As REGISTER_FUNCTIONS) As STATUS

    Dim lngLib&, lngProcAddress&, lpThreadID&, fSuccess&, dwExitCode&, hThread&

    If FileName = "" Then Exit Function

    lngLib = LoadLibraryRegister(FileName)

    If lngLib = 0 Then

        RegisterComponent = [File Could Not Be Loaded Into Memory Space]

        Exit Function

    End If

    Select Case RegFunction

    Case REGISTER_FUNCTIONS.DllRegisterServer

        lngProcAddress = GetProcAddressRegister(lngLib, "DllRegisterServer")

    Case REGISTER_FUNCTIONS.DllUnRegisterServer

        lngProcAddress = GetProcAddressRegister(lngLib, "DllUnregisterServer")

    Case Else

    End Select

    If lngProcAddress = 0 Then

        RegisterComponent = [Not A Valid ActiveX Component]

        If lngLib Then Call FreeLibraryRegister(lngLib)

        Exit Function

    Else

        hThread = CreateThreadForRegister(ByVal 0&, 0&, ByVal lngProcAddress, ByVal 0&, 0&, lpThreadID)

        If hThread Then

            fSuccess = (WaitForSingleObject(hThread, 10000) = WAIT_OBJECT_0)

            If Not fSuccess Then

                Call GetExitCodeThread(hThread, dwExitCode)

                Call ExitThread(dwExitCode)

                RegisterComponent = [ActiveX Component Registration Failed]

                If lngLib Then Call FreeLibraryRegister(lngLib)

                Exit Function

            Else

                If RegFunction = DllRegisterServer Then

                    RegisterComponent = [ActiveX Component Registered Successfully]

                ElseIf RegFunction = DllUnRegisterServer Then

                    RegisterComponent = [ActiveX Component UnRegistered Successfully]

                End If

            End If

            Call CloseHandle(hThread)

            If lngLib Then Call FreeLibraryRegister(lngLib)

        End If

    End If

End Function