registerdll.bas

guan yu pai ke xi tong de ruan jian

Attribute VB_Name = "RegisterDLL"
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function Register_DLL_OCX(ByVal sDllPath As String, Optional bRegister As Boolean = True) As Boolean
    '**********************************************************
    '*      描述 :  注册/反注册控件(ocx /dll)                 *
    '*      输入 :  sDllPath---->DLL/OCX 的全名.              *
    '*              bRegister---> 注册为true , 注销为false. *
    '*      输出 : 如成功返回true,失败返回False.              *
    '**********************************************************
    Dim lLibAddress As Long '用于保存Activex控件载入后的句柄。
    Dim lProcAddress As Long '用于保存Activex控件注册/注销函数指针。
    Dim sRegister As String '用于保存要取得的注册/注销函数名称。
    RegisterServer = False
    On Error GoTo ExitFunc
    '确认所注册的组件实际存在.只有实际存在的才可以进行注册.
    If Len(sDllPath) > 0 And Len(Dir(sDllPath)) > 0 Then
        If bRegister Then '确定注册/注销函数名.(每一个Activex控件都有这样的函数)
            sRegister = "DllRegisterServer"
        Else
            sRegister = "DllUnregisterServer"
        End If
        '先将Activex控件载入内存.
        lLibAddress = LoadLibraryA(sDllPath)
        If lLibAddress Then
            '获取Activex控件DllRegisterServer(注册)/DllUnregisterServer(注销)函数地址指针。
            lProcAddress = GetProcAddress(lLibAddress, sRegister)
            If lProcAddress Then
                '调用函数进行注册/注销。
                If CallWindowProc(lProcAddress, 0&, ByVal 0&, ByVal 0&, ByVal 0&) = 0 Then
                    Register_DLL_OCX = True
                Else
                    Register_DLL_OCX = False
                End If
            End If
        End If
        '释放资源。
        FreeLibrary lLibAddress
    End If
ExitFunc:
    RegisterServer = False
End Function