vb com 组建注册 （注册ActiveX说明）

注册ActiveX说明



vb编写的程序过分依赖与 环境所以  注册ActiveX是很有必要的
如 调用VB编写的COM组件 必须注册 vb的COM组件
不然 VB编写的程序在自己的计算机能用 在别人的计算机上就出错


'vb源代码
Private Const NOERROR As Long = 0
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) 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
Private Function RegisterActiveX(ByVal FileName As String, _
                    Optional ByVal UnRegister As Boolean = False) As Long
    '注册ActiveX:
    'FileName:      文件名
    'UnRegister:    True表示反注册 False表示注册
    '返回值:
    '0 注册成功 一般这两个函数的返回值都是0，否则就是非主流。。。
    '1 不是PE文件
    '2 找不到函数地址
    '其他 函数的调用返回值
    Dim hModule         As Long 'HMODULE
    Dim hProcAddress    As Long 'PROCADDR
    hModule = LoadLibrary(FileName)
    If hModule = 0 Then RegisterActiveX = 1: Exit Function '不是合法的PE文件
    If UnRegister Then
        hProcAddress = GetProcAddress(hModule, ByVal "DllUnregisterServer")
    Else
        hProcAddress = GetProcAddress(hModule, ByVal "DllRegisterServer")
    End If
    If hProcAddress = 0 Then
        '没有找到函数地址
        FreeLibrary hModule '释放
        RegisterActiveX = 2
        Exit Function
    End If
    RegisterActiveX = CallWindowProc(hProcAddress, 0, 0, 0, 0)
    FreeLibrary hModule '释放
End Function
Private Sub Command1_Click()
'遇到错误，直接执行下一行。
On Error Resume Next
    Dim lRet As Long
    sFile = Text1.Text
    lRet = RegisterActiveX(sFile)
    Select Case lRet
        Case NOERROR
            MsgBox "注册成功！"
        Case 1
            MsgBox "无法加载文件" & sFile
        Case 2
            MsgBox "已经加载" & sFile & "但没有找到函数输入点。"
        Case Else
            MsgBox "未知错误！"
    End Select
End Sub



Private Sub Form_Load()
Text1.Text = "C:\MeiLei_MGNX\Main_Program\application\*.dll"
End Sub



_____________________________________________________________________________ _

中磊UG二次开发教程 梅雷著 qq1821117007
学UG就上UG网 http://www.9sug.com/