tags:

views:

1110

answers:

3

I periodically break binary compatibility and need to recompile an entire vb6 application composed of several dozen ActiveX DLLs and OCXs in total. I've written a script to automate this process, but I have encountered a problem.

When an OCX is recompiled with project compatibility its version is incremented, and projects referencing the OCX will not recompile until their reference is updated to the new version. This is checked automatically when the project is opened normally, and the user is prompted to update the reference, but I need to do it in a script.

How do I do it?

+1  A: 

I guess you would have to edit the project files (.vbp), Form files (.frm) and the control files (.ctl) that reference the DLLs and OCXs and increment the typelib version number.

You would find latest typelib version number for the control / DLL in the registry.

This could be a pain depending on how many files you have.

A hack would be to open main project with VB6 using your script and send keys to confirm the Update References and then save the project.

Good Luck

DJ
+1  A: 

Self-answer: I have written some vb6 code to do the upgrade programmatically. It is not extensively tested, there are probably a few bugs here and there for corner cases, but I did use it successfully.

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
Strilanc
+1  A: 

My project, maintained over a decade, consists of a hierarchy of two dozen ActiveX DLLs and a half dozen controls. Compiled with a script system as well.

I don't recommend doing what you are doing.

What we do is as follows

  1. Make our changes including additions and test in the IDE.
  2. We compile from the bottom of the hierarchy to the top
  3. we copy the newly complied files to a revision directory for example 601,then 602 etc etc
  4. we create the setup.exe
  5. when the setup is finalized we copy over the revision directory into our compatibility director. Note we never point to the compiled binary in the project directory. Always to a compability directory that has all the DLLs.

The reason this works is that if you look at the IDL source using the OLE View tool you will find that any referenced control or dlls is added to the interface via a #include. If you point to the binary in your project directory then the include is picked up from the registry which can lead to a lot of strangness and compatibility.

However if the referenced DLL is present in the directory that binary exists while being used for binary compatibility, VB6 will use that instead of whatever in the registry.

Now there is one problem that you will get on an infrequent basis. Consider this heirarchy

  • MyUtilityDLL
  • MyObjectDLL
  • MyUIDLL
  • MyEXE

If you ADD a property or method to a class in MyUtilityDLL MyUIDLL may not compile giving a binary incompatibility error if you are lucky or a strange error like [inref]. In any case the solution is to compile MyUtilityDLL and then immediately copy MyUtilityDLL into the compatibility directory. Then the rest of the automated compile will work fine.

You may want to include this step in the automated build.

Note that in many cases the projects will work fine in the IDE. To if you are now aware of this you could be pulling your hair out.

RS Conley
I think I've run into the error you describe at the end of your post. But why does having a compatibility dir make it go away? If you point at the build directory, it's still the same referenced data as when the error happens.
Strilanc
Because the binary compatibility dlls are pulling thier includes from the dlls in the directory instead of using the registry.
RS Conley
It's very dangerous to exposes in public classes of MyUIDLL types from MyUtilityDLL. Just use "As Object" for param type/retval and save yourselves the troubles with [inref] and other bizzare errors. We are using EditTLB from PowerVB to check for External Dependencies and allow only static libraries there (ADODB, etc) nothing that we build (and might break) can be an external typelib for any other project of ours.
wqw