自我回答:我已经编写了一些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
