如何在程序中动态注册控件？

Question

我现在采用用shell调用regsvr32的方法，但无法通过返回值判断是否成功。
有无其他的方法实现

Answer 1

Declare Function DllRegisterServer Lib "ComCtl32.OCX" () As Long
Declare Function DllUnregisterServer Lib "ComCtl32.OCX" () As LongConst ERROR_SUCCESS = &H0'把ComCtl32.OCX换成你想要注册的dll
使用：
注册：
If DllRegisterServer = ERROR_SUCCESS Then
    MsgBox "Registration Successful"'成功
Else
    MsgBox "Registration Unsuccessful"'不成功
End If
反注册：
If DllUnregisterServer = ERROR_SUCCESS Then
    MsgBox "UnRegistration Successful"'成功
Else
    MsgBox "UnRegistration Unsuccessful"'不成功
End If

Answer 2

可是DLL的文件名，我是写在一个配置文件里，运行时提取出来的啊，所以不可能写死在程序中

Answer 3

...
    On Error Resume Next
    Dim m_fComponentInstalled as boolean
    Dim oComponentCheck As stdole.IUnknown    ' Check whether the specified component is installed and registered.
    Set oComponentCheck = CreateObject("COMName.ClassName")
    m_fComponentInstalled = (Err.Number = 0)
    ...

Answer 4

我也是调用regsvr32啊，可是无法知道调用是否成功了（无法根据返回值来进行判断）

Answer 5

没有写注册表权限或者需要注册的文件不存在就不成功，文件不存在我们可以通过程序copy一份，那么是否可以通过判断用户的权限来知道调用是否成功呢？

Answer 6

试试这个:
Private Sub Form_Activate()'注册控件
If Len(App.Path) <> 3 Then           '判断是否为根目录
Shell "Regsvr32.exe " + App.Path + "\ActiveX\控件.dll(或*.OCX) /s"
Else
Shell "Regsvr32.exe " + App.Path + "\ActiveX\控件.dll(或*.OCX) /s"
End IfEnd Sub

Answer 7

我想要的是如何知道上面的shell语句的执行结果是否成功(即控件注册是否成功)?

Answer 8

在使用VB和其它一些Win9X下的编程软件，就要同ActiveX控件打交道，注册
和反注册控件是一件令人很头疼的事情。有时从网上下载了一个控件，但是在使用
时VB总是提示控件没有注册。又或者想删除一个控件却无法从注册中抹去。
    实际上，每一个ActiveX控件都有两个输出函数：DllRegisterServer和
DllUnRegisterServer。顾名思义，通过这两个函数就可以注册和反注册控件了，
下面通过程序说明如何通过编程来注册。
    首先在Form中加入两个CommandButton，不要改变它们的属性。然后在Form中
加入如下代码：
Private Declare Function RegComCtl32 Lib "ComCtl32.OCX" _
        Alias "DllRegisterServer" () As Long
Private Declare Function UnRegComCtl32 Lib "ComCtl32.OCX" _
        Alias "DllUnregisterServer" () As Long
Private Declare Function FormatMessage Lib "kernel32" _
        Alias "FormatMessageA" (ByVal dwFlags As Long, _
        lpSource As Any, ByVal dwMessageId As Long, _
        ByVal dwLanguageId As Long, ByVal lpBuffer _
        As String, ByVal nSize As Long, Arguments As _
        Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As LongConst ERROR_SUCCESS = &H0Private Sub Command1_Click()
    Dim astr As String
    
    '反注册ComCtl32.Ocx
    If RegComCtl32 = ERROR_SUCCESS Then
        MsgBox "注册成功"
    Else
        astr = String$(256, 20)
        FormatMessage FORMAT_MESSAGE_FROM_SYSTEM Or _
            FORMAT_MESSAGE_IGNORE_INSERTS, 0&, GetLastError, _
            0&, astr, Len(astr), ByVal 0
        MsgBox astr
    End If
End SubPrivate Sub Command2_Click()
    Dim astr As String    '反注册ComCtl32.Ocx    
    If UnRegComCtl32 = ERROR_SUCCESS Then
        MsgBox "反注册成功"
    Else
        astr = String$(256, 20)
        FormatMessage FORMAT_MESSAGE_FROM_SYSTEM Or _
            FORMAT_MESSAGE_IGNORE_INSERTS, 0&, GetLastError, _
            0&, astr, Len(astr), ByVal 0
        MsgBox astr
    End If
End Sub
    运行程序，点击Command2反注册ComCtl32.Ocx控件，在VB菜单中选 Project|components
或按Ctrl+T，在控件列表框中可以看到已经没有ComCtl32.Ocx了。再运行程序，点击Command1
重新注册控件。

Answer 9

关键是预先不知道控件的文件名，
所以不能通过类似
Private Declare Function RegComCtl32 Lib "ComCtl32.OCX"       Alias "DllRegisterServer" () As Long
的方法进行注册

Answer 10

'---------------------------------------------------------------------------------
'   组件注册
'---------------------------------------------------------------------------------
Public Function SelfComponent(ByVal szFileName As String, Optional ByVal isRegister As Boolean = True) As Boolean
    Dim hIns As Long, FunProc As Long
    On Error Resume Next
    szFileName = Trim$(szFileName)
    hIns = LoadLibrary(szFileName)              '载入组件库文件
    If hIns = 0 Then                            '如果没有找到当前目录或系统目录里的文件
        If InStr(1, szFileName, "\") > 0 Then
            szFileName = Mid$(szFileName, InStrRev(szFileName, "\") + 1)
        End If
        hIns = LoadLibrary(App.Path & "\" & szFileName)
        If hIns = 0 Then
            hIns = LoadLibrary(SystemDirectory() & "\" & szFileName)
        End If
    End If
    If hIns <> 0 Then
        If isRegister Then                      '载入自注册函数并进行自注册
            FunProc = GetProcAddress(hIns, "DllRegisterServer")         '注册函数名
        Else
            FunProc = GetProcAddress(hIns, "DllUnregisterServer")       '取消注册函数名
        End If
        If FunProc <> 0 Then
            SelfComponent = CBool(CallWindowProc(FunProc, 0, 0, 0, 0) = 0)
        End If
        FreeLibrary hIns
    End If
    Err.Clear
End Function

Answer 11

运行 regsvr32 后 用 createobject 调用它一下，然后捕获错误----如果出错就是注册不成功了！