Question

我会定期破坏二进制兼容性，并且需要重新编译整个由几十个ActiveX DLL和OCX组成的vb6应用程序。我编写了一个脚本来自动化这个过程，但是我遇到了一个问题。

当使用项目兼容性重新编译OCX时，其版本会增加，引用OCX的项目在其引用更新为新版本之前不会重新编译。当项目正常打开时会自动检查，并提示用户更新引用，但我需要在脚本中执行此操作。

我该怎么做？

Answer 1

我的项目，维护了十多年，由二十多个ActiveX DLL和六个控件组成。也用脚本系统编译。

我不建议你做你正在做的事情。

我们的工作如下

进行更改，包括添加内容并在IDE中进行测试。
我们从底部编译层次结构到顶部
我们将新编译的文件复制到例如，修订目录 601，然后602等等
我们创建setup.exe
设置完成后，我们复制将修订目录放入我们的兼容性总监。请注意我们从不指向编译的二进制文件在项目目录中。永远一个包含所有的compability目录 DLLs。

这样做的原因是，如果您使用OLE视图工具查看IDL源，您会发现任何引用的控件或dll都通过#include添加到接口。如果你指向项目目录中的二进制文件，则从注册表中选择include，这可能会导致很多严重性和兼容性。

但是，如果在用于二进制兼容性的二进制文件存在的目录中存在引用的DLL，VB6将使用它而不是注册表中的任何内容。

现在有一个问题，你不经常得到。考虑这个heirarchy

MyUtilityDLL
MyObjectDLL
MyUIDLL
MyEXE

如果在MyUtilityDLL中向某个类添加属性或方法，MyUIDLL可能无法编译，如果您幸运或者像[inref]这样的奇怪错误，则会出现二进制不兼容错误。在任何情况下，解决方案是编译MyUtilityDLL，然后立即将MyUtilityDLL复制到兼容性目录中。然后剩下的自动编译工作正常。

您可能希望在自动构建中包含此步骤。

请注意，在许多情况下，项目在IDE中可以正常工作。如果你现在意识到这一点，你可能会把你的头发拉出来。

Answer 2

我们正在做类似的事情，即在VB6 Project References Update Tool（download here）中直接在VB6 .vbp文件中操作对使用过的OCX的引用。通常，当使用的ActiveX更改其版本号，CLSID等时，它用于更新引用。

这些工具是开源的，所以对这个问题感兴趣的人都可以借用我们的VB代码片段来实现这些任务。

我们的工具是用Visual Basic 6编写的，它使用tlbinf32.dll（TypeLib信息DLL），它允许您以编程方式从类型库中提取信息。

Answer 3

我想您必须编辑项目文件（.vbp），表单文件（.frm）和引用DLL和OCX的控制文件（.ctl）并增加typelib版本号。

您可以在注册表中找到控件/ DLL的最新typelib版本号。

根据您拥有的文件数量，这可能很麻烦。

黑客将使用您的脚本使用VB6打开主项目并发送密钥以确认更新引用，然后保存项目。

祝你好运

Answer 4

自我回答：我已经编写了一些vb6代码来以编程方式进行升级。它没有经过广泛测试，在这里和那里可能存在一些错误，但我确实成功地使用了它。

Option Explicit

Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const KEY_ENUMERATE_SUB_KEYS As Long = 8
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'''Returns the expected major version of a GUID if it exists, and otherwise returns the highest registered major version.
Public Function GetOcxMajorVersion(ByVal guid As String, Optional ByVal expected_version As Long) As Long
    Const BUFFER_SIZE As Long = 255
    Dim reg_key As Long
    Dim ret As Long
    Dim enum_index As Long
    Dim max_version As Long: max_version = -1

    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\TypeLib\{" & guid & "}", 0, KEY_ENUMERATE_SUB_KEYS, reg_key)
    If ret <> 0 Then Err.Raise ret, , "Failed to open registry key."
    Do
        'Store next subkey name in buffer
        Dim buffer As String: buffer = Space(BUFFER_SIZE)
        Dim cur_buffer_size As Long: cur_buffer_size = BUFFER_SIZE
        ret = RegEnumKeyEx(reg_key, enum_index, buffer, cur_buffer_size, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&)
        If ret <> 0 Then Exit Do
        buffer = Left(buffer, cur_buffer_size)

        'Keep most likely version
        buffer = Split(buffer, ".")(0)
        If Not buffer Like "*[!0-9A-B]*" And Len(buffer) < 4 Then
            Dim v As Long: v = CLng("&H" & buffer) 'convert from hex
            If v = expected_version Then
                max_version = v
                Exit Do
            ElseIf max_version < v Then
                max_version = v
            End If
        End If

        enum_index = enum_index + 1
    Loop
    RegCloseKey reg_key

    If max_version = -1 Then Err.Raise -1, , "Failed to enumerate any viable subkeys."
    GetOcxMajorVersion = max_version
End Function

Public Function RemoveFilename(ByVal path As String) As String
    Dim folders() As String: folders = Split(Replace(path, "/", "\"), "\")
    RemoveFilename = Left(path, Len(path) - Len(folders(UBound(folders))))
End Function

'''Changes any invalid OCX references to newer registered version
Public Sub UpdateFileOCXReferences(ByVal path As String)
    Dim file_data As String
    Dim changes_made As Boolean

    'Read
    Dim fn As Long: fn = FreeFile
    Open path For Input As fn
        While Not EOF(fn)
            Dim line As String
            Line Input #fn, line

            'check for ocx reference line
            If LCase(line) Like "object*=*{*-*-*-*-*}[#]*#.#*[#]#*;*.ocx*" Then
                'get guid
                Dim guid_start As Long: guid_start = InStr(line, "{") + 1
                Dim guid_end As Long: guid_end = InStr(line, "}")
                Dim guid As String: guid = Mid(line, guid_start, guid_end - guid_start)

                'get reference major version
                Dim version_start As Long: version_start = InStr(line, "#") + 1
                Dim version_end As Long: version_end = InStr(version_start + 1, line, ".")
                Dim version_text As String: version_text = Mid(line, version_start, version_end - version_start)

                'play it safe
                If Len(guid) <> 32 + 4 Then Err.Raise -1, , "GUID has unexpected length."
                If Len(version_text) > 4 Then Err.Raise -1, , "Major version is larger than expected."
                If guid Like "*[!0-9A-F-]*" Then Err.Raise -1, , "GUID has unexpected characters."
                If version_text Like "*[!0-9]*" Then Err.Raise -1, , "Major version isn't an integer."

                'get registry major version
                Dim ref_version As Long: ref_version = CLng(version_text)
                Dim reg_version As Long: reg_version = GetOcxMajorVersion(guid, ref_version)

                'change line if necessary
                If reg_version < ref_version Then
                    Err.Raise -1, , "Registered version precedes referenced version."
                ElseIf reg_version > ref_version Then
                    line = Left(line, version_start - 1) & CStr(reg_version) & Mid(line, version_end)
                    changes_made = True
                End If
            End If

            file_data = file_data & line & vbNewLine
        Wend
    Close fn

    'Write
    If changes_made Then
        Kill path
        Open path For Binary As fn
            Put fn, , file_data
        Close fn
    End If
End Sub

'''Changes any invalid in included files to newer registered version
Public Sub UpdateSubFileOCXReferences(ByVal path As String)
    Dim folder As String: folder = RemoveFilename(path)
    Dim fn As Long: fn = FreeFile
    Open path For Input As fn
        While Not EOF(fn)
            Dim line As String
            Line Input #fn, line

            If LCase(line) Like "form=*.frm" _
                            Or LCase(line) Like "usercontrol=*.ctl" Then
                Dim file As String: file = folder & Mid(line, InStr(line, "=") + 1)
                If Dir(file) <> "" Then
                    UpdateFileOCXReferences file
                End If
            End If
        Wend
    Close fn
End Sub

如何以编程方式更新vb6项目中的OCX引用？

4 个答案: