كيف أقوم بتحديث مراجع OCX برمجياً في مشاريع vb6؟

StackOverflow https://stackoverflow.com/questions/620535

  •  05-07-2019
  •  | 
  •  

سؤال

أقوم بشكل دوري بكسر التوافق الثنائي وأحتاج إلى إعادة ترجمة تطبيق vb6 بأكمله الذي يتكون من عدة عشرات من ملفات ActiveX DLLs وOCXs إجمالاً.لقد قمت بكتابة برنامج نصي لأتمتة هذه العملية، ولكن واجهت مشكلة.

عند إعادة ترجمة OCX مع توافق المشروع، تتم زيادة نسخته، ولن يتم إعادة ترجمة المشاريع التي تشير إلى OCX حتى يتم تحديث مرجعها إلى الإصدار الجديد.يتم التحقق من ذلك تلقائيًا عند فتح المشروع بشكل طبيعي، ويُطلب من المستخدم تحديث المرجع، ولكن يجب أن يتم ذلك في برنامج نصي.

كيف فعلتها؟

هل كانت مفيدة؟

المحلول

وأعتقد سيكون لديك لتحرير ملفات المشروع (.vbp)، ملفات نموذج (.FRM) وملفات التحكم (.ctl) التي تشير إلى دلس وOCXs وزيادة رقم الإصدار typelib.

ويمكنك أن تجد أحدث typelib رقم الإصدار للتحكم / DLL في التسجيل.

وهذا يمكن أن يكون الألم اعتمادا على كيفية العديد من الملفات لديك.

والإختراق سيكون لفتح المشروع الرئيسي مع VB6 باستخدام السيناريو الخاص بك وإرسال مفاتيح لتأكيد تحديث المراجع ثم قم بحفظ المشروع.

وحظا سعيدا

نصائح أخرى

يتكون مشروعي، الذي تمت صيانته على مدار عقد من الزمن، من تسلسل هرمي يتكون من عشرين ملف ActiveX DLL وستة عناصر تحكم.تم تجميعها باستخدام نظام نصي أيضًا.

لا أنصحك بفعل ما تفعله.

ما نقوم به هو على النحو التالي

  1. قم بإجراء تغييراتنا بما في ذلك الإضافات والاختبار في IDE.
  2. نجمع من أسفل التسلسل الهرمي إلى الأعلى
  3. نقوم بنسخ الملفات الممتازة حديثًا إلى دليل مراجعة على سبيل المثال 601 ، ثم 602 إلخ.
  4. نقوم بإنشاء ملف setup.exe
  5. عند الانتهاء من الإعداد ، ننسخ على دليل المراجعة إلى مدير التوافق الخاص بنا.لاحظ أننا لا نشير أبدًا إلى الثنائي المترجم في دليل المشروع.دائما إلى دليل التوليف الذي يحتوي على جميع DLLs.

سبب نجاح ذلك هو أنك إذا نظرت إلى مصدر IDL باستخدام أداة عرض OLE فستجد أن أي عنصر تحكم أو ملفات dll تمت إضافتها إلى الواجهة عبر #include.إذا قمت بالإشارة إلى الملف الثنائي في دليل المشروع الخاص بك، فسيتم التقاط التضمين من السجل مما قد يؤدي إلى الكثير من الغرابة والتوافق.

ومع ذلك، إذا كان ملف DLL المشار إليه موجودًا في الدليل الذي يوجد به الملف الثنائي أثناء استخدامه للتوافق الثنائي، فسيستخدم VB6 ذلك بدلاً من أي شيء موجود في السجل.

الآن هناك مشكلة واحدة سوف تواجهك بشكل غير متكرر.النظر في هذا التسلسل الهرمي

  • MyUtilityDLL
  • MyObjectDLL
  • MyUIDLL
  • MyEXE

إذا قمت بإضافة خاصية أو أسلوب إلى فئة في MyUtilityDLL، فقد لا يقوم MyUIDLL بالتجميع مما يعطي خطأ عدم توافق ثنائي إذا كنت محظوظًا أو خطأ غريبًا مثل [inref].على أية حال، الحل هو ترجمة MyUtilityDLL ثم نسخ MyUtilityDLL على الفور إلى دليل التوافق.ثم ستعمل بقية الترجمة الآلية بشكل جيد.

قد ترغب في تضمين هذه الخطوة في الإنشاء الآلي.

لاحظ أنه في كثير من الحالات ستعمل المشاريع بشكل جيد في IDE.إذا كنت الآن على علم بهذا، فمن الممكن أن تقوم بسحب شعرك.

ونحن نفعل أشياء مماثلة، أي التلاعب إشارات إلى OCXs استخدامها مباشرة في ملفات VB6 .vbp، في <لأ href = "http://10tec.com/vb6-project-references-update/" يختلط = "نوفولو noreferrer"> مشروع VB6 المراجع أداة تحديث ( تحميل هنا ) . عموما يتم استخدامه لتحديث المراجع عند تغيير ActiveX المستخدمة أرقام النسخة الخاصة، CLSIDs، الخ.

والأدوات هي مفتوحة المصدر لكي يتمكن الجميع من يهمه الأمر في هذه المشكلة يمكن أن تقترض لدينا كود VB قصاصات لتنفيذ مهام مثل هذه.

وهو مكتوب لدينا أداة في 6 Visual Basic ثم يستخدم tlbinf32.dll (في DLL معلومات TypeLib) الذي يسمح لك لاستخراج المعلومات برمجيا من مكتبات الأنواع.

والأجوبة الذاتي: لقد كتبت بعض رمز 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
scroll top