How do I integrate UAC into my VB6 program? - visual-studio

I need some code that will add the admin rights icon to command buttons and display the prompt when such buttons are clicked. How can I do this in VB6? Some actions require admin rights because they replace files and stuff where Windows Vista/7 don't allow the program normal access to the files.

Here's a VB6 example of ShellExecuteEx that will allow you to optionally execute any process with admin permissions. You can drop this into a module or class.
Option Explicit
Private Const SEE_MASK_DEFAULT = &H0
Public Enum EShellShowConstants
essSW_HIDE = 0
essSW_SHOWNORMAL = 1
essSW_SHOWMINIMIZED = 2
essSW_MAXIMIZE = 3
essSW_SHOWMAXIMIZED = 3
essSW_SHOWNOACTIVATE = 4
essSW_SHOW = 5
essSW_MINIMIZE = 6
essSW_SHOWMINNOACTIVE = 7
essSW_SHOWNA = 8
essSW_RESTORE = 9
essSW_SHOWDEFAULT = 10
End Enum
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long 'Optional
lpClass As String 'Optional
hkeyClass As Long 'Optional
dwHotKey As Long 'Optional
hIcon As Long 'Optional
hProcess As Long 'Optional
End Type
Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpSEI As SHELLEXECUTEINFO) As Long
Public Function ExecuteProcess(ByVal FilePath As String, ByVal hWndOwner As Long, ShellShowType As EShellShowConstants, Optional EXEParameters As String = "", Optional LaunchElevated As Boolean = False) As Boolean
Dim SEI As SHELLEXECUTEINFO
On Error GoTo Err
'Fill the SEI structure
With SEI
.cbSize = Len(SEI) ' Bytes of the structure
.fMask = SEE_MASK_DEFAULT ' Check MSDN for more info on Mask
.lpFile = FilePath ' Program Path
.nShow = ShellShowType ' How the program will be displayed
.lpDirectory = PathGetFolder(FilePath)
.lpParameters = EXEParameters ' Each parameter must be separated by space. If the lpFile member specifies a document file, lpParameters should be NULL.
.hwnd = hWndOwner ' Owner window handle
' Determine launch type (would recommend checking for Vista or greater here also)
If LaunchElevated = True Then ' And m_OpSys.IsVistaOrGreater = True
.lpVerb = "runas"
Else
.lpVerb = "Open"
End If
End With
ExecuteProcess = ShellExecuteEx(SEI) ' Execute the program, return success or failure
Exit Function
Err:
' TODO: Log Error
ExecuteProcess = False
End Function
Private Function PathGetFolder(psPath As String) As String
On Error Resume Next
Dim lPos As Long
lPos = InStrRev(psPath, "\")
PathGetFolder = Left$(psPath, lPos - 1)
End Function

Code examples can really run on, but here is a trivial one showing the "second instance of me" approach.
The program has a startup static module with a few public functions including an "elevated operation" handler, and a Form with just one CommandButton on it:
Module1.bas
Option Explicit
Private Const BCM_SETSHIELD As Long = &H160C&
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function IsUserAnAdmin Lib "shell32" () As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Declare Function ShellExecute Lib "shell32" _
Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As VbAppWinStyle) As Long
Private mblnIsElevated As Boolean
Public Function IsElevated() As Boolean
IsElevated = mblnIsElevated
End Function
Public Sub OperationRequiringElevation(ByRef Params As Variant)
MsgBox "Insert logic here for: " & vbNewLine _
& Join(Params, vbNewLine)
End Sub
Public Sub RequestOperation( _
ByVal hWnd As Long, _
ByVal Focus As VbAppWinStyle, _
ByRef Params As Variant)
ShellExecute hWnd, "runas", App.EXEName & ".exe", _
Join(Params, " "), CurDir$(), Focus
End Sub
Public Sub SetShield(ByVal hWnd As Long)
SendMessage hWnd, BCM_SETSHIELD, 0&, 1&
End Sub
Private Sub Main()
If Len(Command$()) > 0 Then
'Assume we've been run elevated to execute an operation
'specified as a set of space-delimited strings.
OperationRequiringElevation Split(Command$(), " ")
Else
mblnIsElevated = IsUserAnAdmin()
InitCommonControls
Form1.Show
End If
End Sub
Form1.frm
Option Explicit
Private Sub Command1_Click()
Dim Params As Variant
Params = Array("ReplaceFile", "abc", "123")
If IsElevated() Then
OperationRequiringElevation Params
Else
RequestOperation hWnd, vbHide, Params
End If
End Sub
Private Sub Form_Load()
If Not IsElevated() Then
SetShield Command1.hWnd
End If
End Sub
The application has a simple "asInvoker" manifest selecting the Common Controls 6.0 assembly.

First, take the code that runs when someone clicks the button, and put it in a separate exe. Change your button-click code to launch the exe using ShellExecute. Second, build external manifests for each new exe and have it specify requireAdministrator. Third, send your buttons the BCM_SETSHIELD message (you will probably have to look up the numerical value of the message ID) to make the shield appear on them.

Move all of the code that requires elevation into external processes.
Send your buttons the BCM_SETSHIELD message to add the shield icon.
Embed manifests into those processes, telling Windows that they require elevation. See below.
In order to force Vista and higher to run a VB6 exe as administrator in UAC, you must embed a manifest xml as a resource inside of it. Steps follow;
Create the manifest file. Name it "YourProgram.exe.manifest" it should contain the following. The important line is the "requestedExecutionLevel". Change the attributes in to match your exe.
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="YourProgram"
type="win32"
>
<description>application description</description>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security
<requestedPrivileges>
<requestedExecutionLevel level="requireAdministrator" uiAccess="false"/>
</requestedPrivileges>
</security>
</trustInfo>
</assembly>
Create a file named "YourProgram.exe.manifest.rc". It should contain the following.
#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define RT_MANIFEST 24 CREATEPROCESS_MANIFEST_RESOURCE_ID
RT_MANIFEST "YourProgram.exe.manifest"
Compile your resource using rc.exe. It is located by default in C:\Program Files\Microsoft Visual Studio\COMMON\MSDev98\Bin. This will create a file called YourProgram.exe.manifest.RES. The syntax is;
rc /r YourProgram.exe.manifest.rc
Add the .RES file to your project. Do this using the Resource Editor Add-In in VB6. The icon on the toolbar looks like green blocks. If you do not have the icon, make sure it is enabled in the addin manager. If it is not in the addin manager, you need to regsvr32 on C:\Program Files\Microsoft Visual Studio\VB98\Wizards\Resedit.dll. Once you've got the resource editor open, click open and select your .RES file.
Compile your project.
To double check that the manifest was embedded properly, you can use a tool called InspectExe. In explorer, go to the properties of the exe, and if the manifest was embedded you should have a manifest tab (.Net assemblies will also have this manifest tab).
Try running your program on Vista or later. If UAC is indeed enabled, it should come up with the prompt right away.

Related

How to start the On-screen keyboard program from within a VB-6 legacy application

I am trying to 'shell osk.exe' from within my VB-6 application on a Windows 10-32 or Windows 10-64 bit machine.
In the past we have simply used :
Private Sub Command1_Click()
Dim strTemp As String
Dim fso1 As New FileSystemObject
strTemp = fso1.GetSpecialFolder(SystemFolder) & "\osk.exe"
Dim lngReturn As Long
Let lngReturn = ShellExecute(Me.hwnd, "Open", strTemp, vbNullString, "C:\", SW_SHOWNORMAL)
lblReturn.Caption = CStr(lngReturn)
end sub
We have also used the simpler 'shell' command as well; neither work.
And in the past this worked fine. We could also open NotePad, msPaint and some other utilities from within our program. We use an industrial touchscreen PC and for convenience we placed some buttons on our 'settings' page to quickly access these type of helper programs. I do not want to wait on the program, our code has it's own 'touchscreen keyboard'. The users will only use the Windows OSK when they want to perform some work outside of our main application.
For Windows XP all of these programs would open fine. Now for Windows 10, only the OSK.exe program will not start. Looking at the return code, the error returned is a '2'- File Not Found (I assume). But looking in the c:\windows\system32 folder the file 'osk.exe' is there along with mspaint.exe and notepad.exe .
Is there some Windows setting that is hiding the real osk.exe from my program?
Thanks for any suggestions.
On my 64-bit Windows 10, your code behaves as you said. It looks like on 64-bit windows you have to disable WOW 64 redirection:
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" (ByVal Enable As Boolean) As Boolean '// ****Add this****
Private Sub Command1_Click()
Dim fso1 As New FileSystemObject
Dim strTemp As String
strTemp = fso1.GetSpecialFolder(SystemFolder) & "\osk.exe"
Dim lngReturn As Long
Wow64EnableWow64FsRedirection False '// ****Add this****
Let lngReturn = ShellExecute(Me.hwnd, "open", strTemp, vbNullString, "C:\", SW_SHOWNORMAL)
Wow64EnableWow64FsRedirection True '// ****Add this****
lblReturn.Caption = CStr(lngReturn)
End Sub
This code works like a charm on Windows 10 64-bit. Also tested on Windows 10 32-bit...works there as well.

Form type "file" default folder

I have a webform displayed in a WebBrowser control in a Visual Basic application to allow users to upload files to my webserver. Unusually for this type of thing, I know in advance the folder they need to browse to (I want them to upload a file which the VB application has generated) and I would like the Browse dialog box to default to that folder but it seems to default to whichever folder was last used by any application for File / Open.
I've tried using ChDir in VB to set the current folder but that doesn't work.
Is there any way I can persuade the Browse box to default to my desired folder?
First of all, I ought to state that there is no reliable way of doing this. The reason why it is so hard is for security reasons. There is a defaultValue and value property for the INPUT TYPE=FILE element, but if programmers had access to this, this could be used to suck files from the client machine - definitely not a good idea.
In Internet Explorer, the browse file dialogue is actually implemented by a Windows Common Dialog component. However, you have no direct access to this component.
There is no reliable browser-independent way of doing this. And I certainly don't recommend you reverse-engineer the "Last Recently Used" file list for the Common Dialog control (see jac's link). Doing that is very dangerous, since it is an internal-algorithm likely to change. And worse, you are hacking global state to solve a local problem (see Old New Thing blog, ad nauseam).
A solution that doesn't violate global state, but still hacky is to take advantage of the fact we know what the text is on the file upload dialogue. After your document has loaded, you can use a Timer to wait for the dialogue to appear, and at that point, paste the correct directory into the dialogue.
In my sample, I have code where the web browser control sits, and the BrowserHack.bas module.
Form code:
Option Explicit
Private Sub cmdLoadPage_Click()
' Store the default path into the .Tag property.
tmrWaitForDialogue.Tag = "C:\Windows\System32"
' Load URL.
wbMain.Navigate "<URL>"
End Sub
Private Sub Form_Load()
tmrWaitForDialogue.Enabled = False
tmrWaitForDialogue.Interval = 100 ' 10th of a second delay.
End Sub
Private Sub tmrWaitForDialogue_Timer()
If BrowserHack.IsBrowserFileDialogueVisible Then
' We don't want the Timer to fire again.
tmrWaitForDialogue.Enabled = False
' Copy the directory onto the clipboard.
Clipboard.Clear
Clipboard.SetText tmrWaitForDialogue.Tag
' The focus will be on the file path text box in the Open dialogue.
' Use CTL-V to paste the text, and then followed by an Enter character to
' dismiss the dropdown, and another to Open the folder.
SendKeys "^V"
SendKeys "{ENTER}"
SendKeys "{ENTER}"
End If
End Sub
Private Sub wbMain_DocumentComplete(ByVal pDisp As Object, URL As Variant)
tmrWaitForDialogue.Enabled = True
End Sub
BrowserHack:
' Purpose: Code to look for the WebBrowser (Internet Explorer) dialogue which appears when a File Upload control is clicked.
' Notes: Internet Explorer version dependent.
Option Explicit
Private Declare Function EnumThreadWindows Lib "User32.dll" ( _
ByVal dwThreadId As Long, _
ByVal lpfn As Long, _
ByVal lParam As Long _
) As Long
Private Declare Function GetClassName Lib "User32.dll" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "User32.dll" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowVisible Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Const APITRUE As Long = 1 ' Win32 API TRUE value
Private Const APIFALSE As Long = 0 ' Win32 API FALSE value
' This dialogue class is pretty universal.
Private Const m_ksDialogueClass As String = "#32770"
Private Const m_knDialogueClassLen As Long = 6
' This text may well change every time the browser is updated.
Private Const m_ksDialogueText As String = "Choose File to Upload"
Private Const m_knDialogueTextLen As Long = 21
' Buffers to be used for these strings.
Private m_sClassNameBuffer As String
Private m_sWindowNameBuffer As String
' Callback from the EnumThreadWindow() function.
Private Function EnumThreadWndProc( _
ByVal hWnd As Long, _
ByVal lParam As Long _
) As Long
Dim nRet As Long
' Filter out hidden windows.
If IsWindowVisible(hWnd) = APITRUE Then
' Retrieve the class name of the window.
' Note that this function requires you to allocate a buffer *including* the terminating null character.
' Since VB strings *always* are null terminated, we can add one to the string length.
nRet = GetClassName(hWnd, StrPtr(m_sClassNameBuffer), (m_knDialogueClassLen + 1))
' If the classes match, then try for a match on the window's text.
If m_sClassNameBuffer = m_ksDialogueClass Then
' Ditto GetClassName().
nRet = GetWindowText(hWnd, StrPtr(m_sWindowNameBuffer), (m_knDialogueTextLen + 1))
If m_sWindowNameBuffer = m_ksDialogueText Then
' This return value says "stop the enumeration".
' In this case EnumThreadWindow() with also return APIFALSE.
EnumThreadWndProc = APIFALSE
Exit Function
End If
End If
End If
EnumThreadWndProc = APITRUE
End Function
' Purpose: If the browser window is detected
Public Function IsBrowserFileDialogueVisible() As Boolean
' If this is the first time this function has been called, the buffers will not be allocated.
' Do this now.
If LenB(m_sClassNameBuffer) = 0 Then
m_sClassNameBuffer = Space$(m_knDialogueClassLen)
m_sWindowNameBuffer = Space$(m_knDialogueTextLen)
End If
' Enumerate through all windows on this thread. VB apps are single-threaded, and all GUI elements are forced to be on this thread, so this is ok.
If EnumThreadWindows(App.ThreadID, AddressOf EnumThreadWndProc, 0&) = APIFALSE Then
IsBrowserFileDialogueVisible = True
Else
IsBrowserFileDialogueVisible = False
End If
End Function

Load shortcut then close form automatically

i want achieve when shortcut link runs ... the form closes automatically, btw im new to vb coding so any help will be much appreciated, here's my code so far
Private Sub Form_Load()
Set ss = CreateObject("WScript.Shell")
ss.Run Chr(34) & ss.specialfolders("Desktop") & "\app\SOMEGAME.lnk" & Chr(34)
End Sub
Assuming you're using VB6 (which is what your code looks like) you can close your form by calling
Unload Me
at the end of the Form_Load event handler.
However, you don't need to use a form to launch a shortcut - you can add a module to your project (right-click your project, select Add -> Module) and then just call the ShellExecute() function to launch your shortcut like so:
'Declare the ShellExecute() API function
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
'Entry point of your program
Public Sub Main()
Dim sPath As String
sPath = "C:\app\SOMEGAME.lnk"
ShellExecute 0, vbNullString, sPath, vbNullString, "C:\", SW_SHOWNORMAL
End Sub
To make this work, set the Startup Object under Project Properties to Sub Main.
Using this approach, you don't have a form - your program just runs from the command-line (or from its own shortcut). It's generally better not to create / show a form if your program doesn't need it since forms use extra resources.
With that said, you should try using VB.Net or C# to write programs for Windows - VB6 is old technology without support and it can't handle a number of new technologies. If you don't already know VB6 there's little point in learning it now - your time could be put to much better use by learning VB.Net / C#.

File not found when loading dll from vb6

I am declaring and calling a dll function using the following syntax in VB6:
'Declare the function
Private Declare Sub MYFUNC Lib "mylib.dll" ()
'Call the function
MYFUNC
Calling the function results in the error File not found: mylib.dll. This happens when the application is run from the vb6 IDE or from a compiled executable.
The dll is in the working directory, and I have checked that it is found using ProcMon.exe from sysinternals. There are no failed loads, but the Intel Fortran dlls are not loaded (the ProcMon trace seems to stop before then).
I have also tried running the application in WinDbg.exe, and weirdly, it works! There are no failures on this line. The ProcMon trace shows that the Intel Fortran dlls are loaded when the program is run in this way.
The dll is compiled with Fortran Composer XE 2011.
Can anyone offer any help?
When loading DLLs, "file not found" can often be misleading. It may mean that the DLL or a file it depends on is missing - but if that was the case you would have spotted the problem with Process Monitor.
Often, the "file not found" message actually means that the DLL was found, but an error occured when loading it or calling the method.
There are actually three steps to calling a procedure in a DLL:
Locate and load the DLL, running the DllMain method if present.
Locate the procedure in the DLL.
Call the procedure.
Errors can happen at any of these stages. VB6 does all this behind the scenes so you can't tell where the error is happening. However, you can take control of the process using Windows API functions. This should tell you where the error is happening. You can alse set breakpoints and use Process Monitor to examine your program's behaviour at each point which may give you more insights.
The code below shows how you can call a DLL procedure using the Windows API. To run it, put the code into a new module, and set the startup object for your project to "Sub Main".
Option Explicit
' Windows API method declarations
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) _
As Long
Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
As Long
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const MyFunc As String = "MYFUNC"
Const MyDll As String = "mylib.dll"
Sub Main()
' Locate and load the DLL. This will run the DllMain method, if present
Dim dllHandle As Long
dllHandle = LoadLibrary(MyDll)
If dllHandle = 0 Then
MsgBox "Error loading DLL" & vbCrLf & ErrorText(Err.LastDllError)
Exit Sub
End If
' Find the procedure you want to call
Dim procAddress As Long
procAddress = GetProcAddress(dllHandle, MyFunc)
If procAddress = 0 Then
MsgBox "Error getting procedure address" & vbCrLf & ErrorText(Err.LastDllError)
Exit Sub
End If
' Finally, call the procedure
CallWindowProc procAddress, 0&, "Dummy message", ByVal 0&, ByVal 0&
End Sub
' Gets the error message for a Windows error code
Private Function ErrorText(errorCode As Long) As String
Dim errorMessage As String
Dim result As Long
errorMessage = Space$(256)
result = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, errorCode, 0&, errorMessage, Len(errorMessage), 0&)
If result > 0 Then
ErrorText = Left$(errorMessage, result)
Else
ErrorText = "Unknown error"
End If
End Function
The .dll must be in the current "working" directory (or registered), otherwise at run-time the application can't find it.
Do:
MsgBox "The current directory is " & CurDir
And then compare that with what you were expecting. The .dll would need to be in that directory.
My standard first go-to approach to this issue is to break out ProcMon (or FileMon on XP). Setup the filters so that you can see where exactly it's searching for the file. It is possible that it's looking for the file elsewhere or for a different file name.
Private Declare Sub MYFUNC Lib "mylib.dll" ()
Firstly you are declaring a Sub, not a function.
These don't have return values:
(vb6) Sub() == (vc++) void Sub()
(vb6) Func() as string == (vc++) string Func()
The path you have declared is local to the running environment. Thus when running is debug mode using VB6.exe, you'll need to have mylib.dll in the same directory as VB6.exe.
As you are using private declare, you might want to consider a wrapper class for your dll. This allows you to group common dll access together but allowing for reuse. Then methods of the class are used to access the exposed function.
So you can use all the code provided above, copy it into a class
MyClass code:
Option Explicit
'Private Declare Sub MYFUNC Lib "mylib.dll" ()
'<all code above Main()>
Private Sub Class_Initialize()
'initialise objects
End Sub
Private Sub Class_Terminate()
'Set anyObj = Nothing
End Sub
Public Sub ClassMethod()
On Error Goto errClassMethod
'Perhaps look at refactoring the use of msgbox
'<code body from Main() given above>
exit sub
errClassMethod:
'handle any errors
End Sub
'<all code below main>
Apartment threading model loads ALL modules when the application is started. Using a class will only "load" the dll when the class is instantiated. Also results in neater calling code without the surrounding obfuscation of windows API calls: (ie. modMain):
Sub Main()
Dim m_base As MyClass
Set m_base = New MyClass
MyClass.ClassMethod()
End Sub
I tried #roomaroo's answer and it didn't give me specific enough info. Using Dependency Walker helped me resolve it. Also had to chdir, as per #bnadolson

How do I programmatically update OCX references in vb6 projects?

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?
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.
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.
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
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

Resources