求控件自动注册实例!

真主

求控件自动注册实例!

如smartday的档案管理中的控件注册

[此贴子已经被作者于2005-9-17 15:36:15编辑过]

wu8313

试试这两段代码：1、Function AutoRegFile(FileName As String)

Dim reged As Boolean

Dim RegFile1 As String

Dim RegFile2 As String

Dim BeReg As String

Dim RetVal

BeReg = CurrentProject.Path & "\" & FileName

RegFile1 = Environ("windir") & "\system\regsvr32.exe "

RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

       If Dir(RegFile1) <> "" Then

            RegFile1 = RegFile1 & "/s" & " " & BeReg

            RetVal = Shell(RegFile1, 1)

        Else

            RegFile2 = RegFile2 & "/s" & " " & BeReg

            RetVal = Shell(RegFile2, 1)

        End If

Else

        MsgBox "找不到regsvr32.exe文件，你可能无法使用本软件！", vbCritical, "无法自动注册控件"

End If

End Function

使用方法：

把控件跟mdb文件放在同一个目录里,然后在程序中使用以下语句注册

AutoRegFile "控件名称"

-----------------------------------------------------------2、Function RegOCX(BeReg As String)

    Dim RegFile1 As String

    Dim RegFile2 As String

    Dim RetVal

    RegFile1 = Environ("windir") & "\system\regsvr32.exe "

    RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

    If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

        If Dir(RegFile1) <> "" Then

            RegFile1 = RegFile1 & "/s" & BeReg

            RetVal = Shell(RegFile1, 1)

        Else

            RegFile2 = RegFile2 & "/s" & BeReg

            RetVal = Shell(RegFile2, 1)

        End If

    Else

        MsgBox "找不到regsvr32.exe文件，无法完成自动注册，您需要手动注册" & BeReg & "这个控件", vbCritical, "无法自动注册控件"

    End If

End Function

------------------------------------------------

真主

试了,不成功!请指点

smartday

呵呵，我已经在用，可以的

smartday

下面是我用的代码：

Private Sub Form_Open(Cancel As Integer)

  '关闭自定义的工具栏

    DoCmd.ShowToolbar "档案管理", acToolbarNo

    DoCmd.ShowToolbar "档案管理报表工具", acToolbarNo

    '检测后台数据库链接

    Dim hdk As String

    Dim cat As ADOX.Catalog

    Dim tdf As ADOX.Table

    If CheckLinks = False Then    '如果连接错误

        hdk = CurrentProject.Path & "\date\档案管理_date.mdb"

        Set cat = New ADOX.Catalog

        Set cat.ActiveConnection = CurrentProject.Connection

        Set tdf = cat.Tables("user")

        tdf.Properties("jet oledb:link datasource") = hdk

    End If

    '窗体打开后自动注册控件

    AutoRegFile "CALENDAR.OCX"

    AutoRegFile "ctlstbar.ocx"

    AutoRegFile "flash.ocx"

End Sub



Function AutoRegFile(FileName As String)

    Dim reged As Boolean

    Dim RegFile1 As String

    Dim RegFile2 As String

    Dim BeReg As String, strDtn As String, strDtn1 As String

    Dim ref As Reference

    Dim RetVal

    BeReg = CurrentProject.Path & "\ocx\" & FileName          '控件存放位置，例子中是放在工程当前目录下ocx子目录

    strDtn = Environ("windir") & "\system\" & FileName           '返回系统路径

    strDtn1 = Environ("windir") & "\system32\" & FileName           '返回系统路径

    On Error Resume Next

    RegFile1 = Environ("windir") & "\system\regsvr32.exe "

    RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

    If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

        If Dir(RegFile1) <> "" Then

            FileCopy BeReg, strDtn

            RegFile1 = RegFile1 & "/s" & " " & strDtn

            RetVal = Shell(RegFile1, 1)

            Set ref = References.AddFromFile(Environ("windir") & "\system\" & FileName)

        Else

            FileCopy BeReg, strDtn1

            RegFile2 = RegFile2 & "/s" & " " & strDtn1

            RetVal = Shell(RegFile2, 1)

            Set ref = References.AddFromFile(Environ("windir") & "\system32\" & FileName)    '设置引用

        End If

    Else

        MsgBox "找不到regsvr32.exe文件，你可能无法使用本软件！", vbCritical, "无法自动注册控件"

    End If

End Function

[此贴子已经被作者于2005-9-18 9:24:34编辑过]

真主

这样写,不行,请问什么地方写错

smartday

    BeReg = CurrentProject.Path & "\ocx\" & FileName          '控件存放位置，例子中是放在工程当前目录下ocx子目录

    strDtn = Environ("windir") & "\system\" & FileName           '返回系统路径

    strDtn1 = Environ("windir") & "\system32\" & FileName           '返回系统路径

你这三个变量的赋值搞错了!

strdnt 和 strdtn1这两个变量是分别针对两种不同的情况来存放regsvr32.exe路径的,并不是用来注册OCX,看我给我例程!

[此贴子已经被作者于2005-9-19 18:44:15编辑过]

真主

请帮我看看,谢谢

wu8313

代码改成这样，应该可以注册的了。

-------------------------------

Option Compare Database

Function AutoRegFile(FileName As String)

    Dim reged As Boolean

    Dim RegFile1 As String

    Dim RegFile2 As String

    Dim BeReg As String, strDtn As String, strDtn1 As String

    Dim ref As Reference

    Dim RetVal

    BeReg = CurrentProject.Path & "\ocx\" & "Calendar.ocx"          '控件存放位置，例子中是放在工程当前目录下ocx子目录

    strDtn = Environ("windir") & "\system\" & "Calendar.ocx"           '返回系统路径

    strDtn1 = Environ("windir") & "\system32\" & "Calendar.ocx"           '返回系统路径

    On Error Resume Next

    RegFile1 = Environ("windir") & "\system\regsvr32.exe "

    RegFile2 = Environ("windir") & "\system32\regsvr32.exe "

    If Dir(RegFile1) <> "" Or Dir(RegFile2) <> "" Then

        If Dir(RegFile1) <> "" Then

            FileCopy BeReg, strDtn

            RegFile1 = RegFile1 & "/s" & " " & strDtn

            RetVal = Shell(RegFile1, 1)

            Set ref = References.AddFromFile(Environ("windir") & "\system\" & Calendar.ocx)

          '设置一个对话框来提醒一下注册是否成功  

            MsgBox "注册成功"

            

        Else

            FileCopy BeReg, strDtn1

            RegFile2 = RegFile2 & "/s" & " " & strDtn1

            RetVal = Shell(RegFile2, 1)

            Set ref = References.AddFromFile(Environ("windir") & "\system32\" & Calendar.ocx)    '设置引用

            

            MsgBox "注册成功"

            

        End If

    Else

        MsgBox "找不到regsvr32.exe文件，你可能无法使用本软件！", vbCritical, "无法自动注册控件"

    End If

End Function

-------------------

'用来调用上面的过程

在立即窗口中输入 call regmyocx()  看看会得到怎样的结果。

Sub regmyocx()

AutoRegFile "calendar.ocx"

End Sub

-----------------

解释一下你的原来代码 存在的问题：

在上述代码的蓝色部分，你没有使用 "" 来连接，调用的时候，出现“编译错误：无效的界定符”提示  ，所以认为你的代码出现语法错误而导致编译错误的。后来，看到 蓝色部分 有问题了。

------------------------------

蓝色部分的后两句代码，是用来获得系统文件夹路径的

针对 win98/winme/winxp 的系统文件夹 是 system

针对 winnt /2k  的系统文件夹 是 system32

不同的操作系统 regsvr32.exe(操作系统自带的)  这个文件的位置是不同的，是system 或者 system32 两者之一。

----------------------------------------------

[此贴子已经被作者于2005-9-20 21:05:04编辑过]

smartday

呵呵,讲得够明白的了,应该会用了吧