vb6プロジェクトのOCX参照をプログラムで更新するにはどうすればよいですか？

https://stackoverflow.com/questions/620535

vb6
activex

05-07-2019
|

質問

定期的にバイナリ互換性を破り、合計数十個のActiveX DLLとOCXで構成されるvb6アプリケーション全体を再コンパイルする必要があります。このプロセスを自動化するスクリプトを作成しましたが、問題が発生しました。

OCXがプロジェクト互換性で再コンパイルされると、そのバージョンは増加し、OCXを参照するプロジェクトは、参照が新しいバージョンに更新されるまで再コンパイルされません。これは、プロジェクトが正常に開かれたときに自動的にチェックされ、ユーザーは参照を更新するよう求められますが、スクリプトでそれを行う必要があります。

どうすればいいですか

解決

DLLとOCXを参照するプロジェクトファイル（.vbp）、フォームファイル（.frm）、制御ファイル（.ctl）を編集し、typelibバージョン番号をインクリメントする必要があると思います。

レジストリでコントロール/ DLLの最新のtypelibバージョン番号を見つけます。

これは、ファイルの数によっては痛みになる場合があります。

ハックは、スクリプトを使用してVB6でメインプロジェクトを開き、キーを送信してUpdate Referencesを確認し、プロジェクトを保存することです。

幸運

他のヒント

10年以上維持されている私のプロジェクトは、2ダースのActiveX DLLと6ダースのコントロールの階層で構成されています。同様にスクリプトシステムでコンパイルされています。

あなたがしていることをすることはお勧めしません。

私たちが行うことは次のとおりです

追加などの変更を行う IDEでテストします。
下からコンパイルします最上位階層
新しくコンパイルされたファイルをたとえば、リビジョンディレクトリ 601、602などなど
setup.exeを作成します
セットアップが完了したら、コピーしますリビジョンディレクトリを介して互換性ディレクター。私たちに注意してくださいコンパイルされたバイナリを指すことはありませんプロジェクトディレクトリ内。常にすべてを備えた互換性ディレクトリ DLL。

これが機能する理由は、OLEビューツールを使用してIDLソースを見ると、参照されたコントロールまたはdllが#includeを介してインターフェイスに追加されていることがわかるからです。プロジェクトディレクトリ内のバイナリをポイントすると、レジストリからインクルードが取得され、多くの制約と互換性が得られます。

ただし、バイナリの互換性のために使用されている間に、参照されたDLLがバイナリが存在するディレクトリに存在する場合、VB6はレジストリ内の何かの代わりにそれを使用します。

今、まれに発生する問題が1つあります。この階層を考慮してください

MyUtilityDLL
MyObjectDLL
MyUIDLL
MyEXE

MyUtilityDLLのクラスにプロパティまたはメソッドを追加すると、ラッキーまたは[inref]のような奇妙なエラーの場合、MyUIDLLがコンパイルされず、バイナリ非互換性エラーが発生する場合があります。いずれにせよ、解決策はMyUtilityDLLをコンパイルして、すぐにMyUtilityDLLを互換性ディレクトリにコピーすることです。その後、自動コンパイルの残りは正常に動作します。

このステップを自動ビルドに含めることができます。

多くの場合、プロジェクトはIDEで正常に動作します。これに気付いたら、髪を引き抜くことができます。

同様のことを行っています。つまり、 VB6プロジェクト参照更新ツール（ここからダウンロード）。一般に、使用されているActiveXがバージョン番号やCLSIDなどを変更したときに参照を更新するために使用されます。

ツールはオープンソースであるため、この問題に関心がある人は誰でもVBコードスニペットを借りて、このようなタスクを実装できます。

このツールはVisual Basic 6で記述されており、タイプライブラリからプログラムで情報を抽出できるtlbinf32.dll（TypeLib情報DLL）を使用します。

自己回答：アップグレードをプログラムで行うための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

ライセンス： CC-BY-SA と帰属

所属していません StackOverflow