How do I programmatically update OCX references in vb6 projects? - vb6

Question

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?

Answer 1

We are doing similar things, i.e. manipulating the references to the used OCXs directly in VB6 .vbp files, in our VB6 Project References Update Tool (download here). Generally it is used to update the references when the used ActiveX change their version numbers, CLSIDs, etc.
The tools is open-source so everyone who is interested in this problem can borrow our VB code snippets to implement tasks like these.
Our tool is written in Visual Basic 6 and uses tlbinf32.dll (the TypeLib Information DLL) that allows you to programmatically extract information from type libraries.

Answer 2

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
Make our changes including additions
and test in the IDE.
We compile from the bottom of the
hierarchy to the top
we copy the newly complied files to
a revision directory for example
601,then 602 etc etc
we create the setup.exe
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.

Answer 3

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

Answer 4

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