Implementing a Windows Installer Validation Engine in VB6
A recent topic in the msi newsgroups has focused around implementing a Windows Installer debugger or validation engine in VB6. Conceptually, this isn't all that tough. The concept focus around a successful implementation of the MsiSetExternalUI method and the companion callback. Basically, the steps would go something like this:
- Figure out exactly which messages you want to get from Windows Installer and calculate the corresponding bitfield
- Implement the callback handler method
- Call MsiSetInternalUI to ensure that no UI will be displayed by Windows Installer
- Call MsiSetExternalUI passing a pointer to the callback method, and the bitfield describing which messages you want to recieve
- Invoke an Installer action by running msiexec with the appropriate options, or using the API/Automation methods
- Handle messages in the callback
- Call MsiSetExternalUI to restore the old handler.
Not so tough, right? Well -- We have to bear in mind that the API's needed to do this were written for C++ programmers and not for VB Programmers. While that is indeed a bummer, it does not stopping us from getting the job done. Instead, it just creates an extra challenge of getting the API declares just right in VB.
To accomplish this, we first need to create a Module in which to implement the MsiCallback.
Option Explicit
Private m_Val As MSIValidator
Private m_OldHandler As Long
'
Const INSTALLLOGMODE_USER = 8
Private Declare Function MsiSetExternalUI Lib "msi.dll" Alias "MsiSetExternalUIA" (ByVal puiHandler As Long, ByVal dwMessageFilter As Long, ByVal pvContext As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal lpString As Long, ByVal lLen As Long) As String
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Public Function SetExtUI(val As MSIValidator)
Set m_Val = val
m_OldHandler = MsiSetExternalUI(ByVal GetAddress(AddressOf MSICallBack), INSTALLLOGMODE_USER, 99999)
End Function
'Simple function to return a long pointer
Private Function GetAddress(ByVal Addr As Long) As Long
GetAddress = Addr
End Function
Public Function UnSetExtUI() As Long
UnSetExtUI = MsiSetExternalUI(m_OldHandler, 0, 0)
End Function
'This is the callback function.
'All wee do is call into the MSIValidator class and let it do what it wants
'NOTE: This should always return 1
Public Function MSICallBack(ByVal pvContext As Long, ByVal iMessageType As Long, ByVal szMessage As Long) As Integer
MSICallBack = m_Val.HandleMessage(ByVal iMessageType, ByVal PtrToVBString(szMessage))
End Function
'Convert a string pointer to a VB string
Public Function PtrToVBString(ByVal lPointer As Long) As String
PtrToVBString = SysAllocStringByteLen(lPointer, lstrlen(lPointer))
End Function
As you can see the Module above is nothing fancy. It holds a member variable which is a reference to our MSIValidator class. When you call SetExtUI, you have to pass a reference to a MSIValidator class which is then stored for later use when messages are recieved.
Next, we need to create the MSIValidator class. This class will be where most of the work is done.
Option Explicit
Public Event OnInfo(iceNumber As Integer, Info As String)
Public Event OnWarning(iceNumber As Integer, Warning As String)
Public Event OnError(iceNumber As Integer, Error As String)
'
Const INSTALLUILEVEL_NONE = 2
'
Private Declare Function MsiSetInternalUI Lib "msi.dll" (ByVal dwUILevel As Long, hwnd As Long) As Long
Private Declare Function MsiOpenPackage Lib "msi.dll" Alias "MsiOpenPackageA" (ByVal szDatabasePath As String, phDatabase As Long) As Integer
Private Declare Function MsiSequence Lib "msi.dll" Alias "MsiSequenceA" (ByVal hDatabase As Long, ByVal szTable As String, ByVal iSequenceMode As Long) As Integer
Private Declare Function MsiCloseHandle Lib "msi.dll" (ByVal hAny As Long) As Integer
'
Public Sub ValidateMSI(MSIFilePath As String, CUBFilePath As String)
'
'Create two Installer instances (might be able to get by with one...)
Dim oWI As Installer
Set oWI = CreateObject("WindowsInstaller.Installer")
Dim oWI2 As Installer
Set oWI2 = CreateObject("WindowsInstaller.Installer")
'
'We need to make a temp copy of the msi to avoid mucking up the original
Dim oFS As New Scripting.FileSystemObject
oFS.CopyFile MSIFilePath, App.Path & "\temp.msi", True
'
'Open both databases
Dim oDB As Database
Set oDB = oWI.OpenDatabase(App.Path & "\temp.msi", 1)
Dim oDB2 As Database
Set oDB2 = oWI2.OpenDatabase(CUBFilePath, 1)
'
'Merge the cub file into our databse and save the changes
oDB.Merge oDB2
oDB.Commit
'
'Now we are going to switch to using the API, so let's clean up first
Set oDB = Nothing
Set oDB2 = Nothing
Set oWI = Nothing
Set oWI2 = Nothing
'
'Ok, let's set the external UI
MSICallBack.SetExtUI Me
'
Dim lRet As Long
Dim lHandle As Long
'Make sure no visible UI appears
lRet = MsiSetInternalUI(INSTALLUILEVEL_NONE, 0)
'Open the package and get a handle
lRet = MsiOpenPackage(App.Path & "\temp.msi", lHandle)
'Run the _ICESequence Table
'****All the magic will happen as soon as we call this method
lRet = MsiSequence(lHandle, "_ICESequence", 0)
'Ok, we are done now. Let's clean up
MsiCloseHandle lHandle
MSICallBack.UnSetExtUI
End Sub
Public Function HandleMessage(ByVal lMsgType As Long, ByVal sMsg As String) As Long
Debug.Print sMsg
'
Dim sData() As String 'Array to hold the tab delimited data
Dim iType As Integer 'The type of message
Dim iICE As Integer 'The ICE which is sending the message
Dim sDesc As String 'The message text
'
Dim i As Long
'
'We really don't want any errors being raised here
On Error Resume Next
'Split the data on the tabs
sData = Split(sMsg, vbTab)
'Grab the data from the array
iType = CInt(sData(1))
iICE = Right(sData(0), 2)
sDesc = sData(2)
'
'Raise our events
Select Case iType
Case 1
RaiseEvent OnError(iICE, sDesc)
Case 2
RaiseEvent OnWarning(iICE, sDesc)
Case 3
RaiseEvent OnInfo(iICE, sDesc)
End Select
'Always return 1
HandleMessage = 1
End Function
Hopefully, the code above is pretty self-explantory. Basically, we make a temp copy of the msi file, merge the .cub file into it, then run the "_ICESequence" table.
Let me close this post with a word of caution. Anytime you are mucking around with API calls from VB, or implementing callback functions, you are treading in dangerous territory. Mistakes are common. Crashes are common. Please don't blame me if you screw up your system or lose some data as a result of toying with this code.