Find the Product Name, Product Code and More for an Installed MSI

Occasionally we need to find the Product Name, Product Code and more for an installed MSI. It’s also handy to find the Install Source so we can see where i was installed from.

There are various ways to achieve this such as querying the registry or WMI, but the fastest way to do this is to use the Windows Installer object like so:

cls
$Installer = New-Object -ComObject WindowsInstaller.Installer; 
$InstalledProducts = @()
foreach($context in @(7,3)) { #per-machine 7 or per-user 3
$InstallerProducts = $Installer.ProductsEx("", "", $context); 
$InstalledProducts += ForEach($Product in $InstallerProducts)
{
[PSCustomObject]@{
ProductCode = $Product.ProductCode(); 
LocalPackage = try { $Product.InstallProperty("LocalPackage") } catch [System.Runtime.InteropServices.COMException] { "Not Found"  }; 
VersionString = try { $Product.InstallProperty("VersionString") } catch [System.Runtime.InteropServices.COMException] { "Not Found"  }; 
Publisher = try { $Product.InstallProperty("Publisher") } catch [System.Runtime.InteropServices.COMException] { "Not Found"  };
ProductName = try { $Product.InstallProperty("ProductName") } catch [System.Runtime.InteropServices.COMException] { "Not Found"  };
InstallSource = try { $Product.InstallProperty("InstallSource") } catch [System.Runtime.InteropServices.COMException] { "Not Found"  };
InstallDate = try { $Product.InstallProperty("InstallDate").substring(0,4) + "-" + $Product.InstallProperty("InstallDate").substring(2,2) + "-" + $Product.InstallProperty("InstallDate").substring(4,2) } catch [System.Runtime.InteropServices.COMException] { "Not Found"  };
Context = $(if ($context -eq 7) { "Machine" } else { "User" })
}        
} 
}
$InstalledProducts

Extract an EXE from the binary table and run it from a VBScript Custom Action

Somebody over at ITNinja recently asked how they could run an executable stored in the binary table, from a VBScript Custom Action. Here’s an example I knocked up which describes how to extract an EXE from the binary table and run it from a VBScript Custom Action. I basically streamed notepad.exe into the binary table, and gave it a name of ‘notepad’. In this Custom Action, I extract it to the %temp% folder and run it from there. Note that there is no cleanup of the extraction afterwards. Also note that because this uses the Session object, it can only be executed in the Immediate context. So more consideration would be required (and probably a separate Custom Action) to execute the extracted EXE in a deferred context.

Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : tempFolder = oFSO.GetSpecialFolder(2) 
Dim outputFile : outputFile = tempFolder & "\notepad.exe"
extractFromBinary "notepad", outputFile
If oFSO.fileExists(outputFile) Then 
Dim objShell : Set objShell = CreateObject("WScript.Shell") 
objShell.Run (outputFile) 
Set objShell = Nothing
End If
Function extractFromBinary(ByVal binaryName, ByVal binaryOutputFile)
Const msiReadStreamInteger = 0 
Const msiReadStreamBytes = 1 
Const msiReadStreamAnsi = 2  
Const msiReadStreamDirect = 3
Dim binaryView : Set binaryView = Session.Database.OpenView("SELECT * FROM Binary WHERE Name = '" & binaryName & "'")  
binaryView.Execute
Dim binaryRecord : Set binaryRecord = binaryView.Fetch  
Dim binaryData : binaryData = binaryRecord.ReadStream(2, binaryRecord.DataSize(2), msiReadStreamAnsi)  
Set binaryRecord = Nothing  
Dim binaryStream : Set binaryStream = oFSO.CreateTextFile(binaryOutputFile, True)  
binaryStream.Write binaryData  
binaryStream.Close 
Set binaryStream = Nothing
End Function
Set oFSO = Nothing

Below is an updated version that extracts from the binary table using msiReadStreamDirect (as a binary string), converts the string to binary and outputs it using ADODB.Stream . It may resolve locale-specific issues with the aforementioned approach.

Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : tempFolder = oFSO.GetSpecialFolder(2) 
Dim outputFile : outputFile = tempFolder & "\notepad.exe"
extractFromBinary "notepad", outputFile
If oFSO.fileExists(outputFile) Then 
Dim objShell : Set objShell = CreateObject("WScript.Shell") 
objShell.Run (outputFile) 
Set objShell = Nothing
End If
Function MultiByteToBinary(MultiByte)
'obtained from http://www.motobit.com
'MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
'Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
Set RS = Nothing
MultiByteToBinary = Binary
End Function
Function SaveBinaryData(FileName, ByteArray)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
'Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save binary data.
BinaryStream.Type = adTypeBinary
'Open the stream And write binary data To the object
BinaryStream.Open
BinaryStream.Write ByteArray
'Save binary data To disk
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
Set BinaryStream = Nothing
End Function
Function extractFromBinary(ByVal binaryName, ByVal binaryOutputFile)
Const msiReadStreamInteger = 0 
Const msiReadStreamBytes = 1 
Const msiReadStreamAnsi = 2  
Const msiReadStreamDirect = 3
Dim binaryView : Set binaryView = Session.Database.OpenView("SELECT * FROM Binary WHERE Name = '" & binaryName & "'")  
binaryView.Execute
Dim binaryRecord : Set binaryRecord = binaryView.Fetch  
Dim binaryData : binaryData = binaryRecord.ReadStream(2, binaryRecord.DataSize(2), msiReadStreamDirect)  
Set binaryRecord = Nothing  
'convert to string of byte pairs to binary
binaryData = MultiByteToBinary(binaryData)
'save binary data
SaveBinaryData binaryOutputFile, binaryData
End Function
Set oFSO = Nothing

Finally, i verified the file imported into the Binary table against the file extracted from the Binary table using this simple command line:
fc.exe /b [full_path_file_1] [full_path_file_2]

Rename Single-file Components

Description

This script will rename single-file components to their filename.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Renaming Single-file Components to their File Name"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiViewModifyReplace = 4
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
Dim filenameLength : filenameLength = 0
Dim component : component = ""
Dim filename : filename = ""
Dim tempTable : tempTable = ""	
Dim tempColumn : tempColumn = ""
Dim tempColVal : tempColVal = ""
Dim componentView, componentRec, fileView, fileRec, id, compExistView, compExistRec, tablesRec, tablesView, tempTableRec, tempTableView
If oDatabase.TablePersistent("Component") = 1 AND oDatabase.TablePersistent("File") = 1 And oDatabase.TablePersistent("FeatureComponents") Then
Set componentView = oDatabase.OpenView("SELECT `Component` FROM `Component`")
componentView.Execute
Set componentRec = componentView.Fetch
'component table has records
Do Until componentRec Is Nothing
component = componentRec.StringData(1)
If Not isMSMData(component) Then
Set fileView = oDatabase.OpenView("SELECT `FileName` FROM `File` WHERE `Component_`='" & component & "'")
fileView.Execute
If not fileView.Fetch is nothing and fileView.Fetch is nothing Then  'it has one file
Set fileRec = fileView.Fetch
filename = fileRec.StringData(1)
If InStr(filename,"|") Then
'attempt to get actual filename if there is a sfn equivalent
filename = Split(filename,"|")(1)
End If
filenameLength = Len(filename)
If Not (LCase(filename) = Left(LCase(component),filenameLength)) Then	
If Not IsNumeric(Left(filename,1)) AND Not Instr(filename,"-") > 0 Then						
'if filename doesnt start with a number or contain a '-' we rename
'(otherwise if it does contain one of these it will constantly rename the ocmponent each time you run it)
renameComponent component,filename
End If 
End If					
End If
Set fileView = Nothing
Set fileRec = Nothing
end If
Set componentRec = componentView.Fetch
Loop
Set componentRec= Nothing
Set componentView= Nothing
End If
oDatabase.Commit	
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub
'returns true if tempData contains MSM decoration
Function isMSMData(tempData)
isMSMData = False
Dim Match
Dim regEx : Set regEx = New RegExp
regEx.MultiLine = vbTrue
regEx.global = vbTrue
regEx.Pattern = "[A-Za-z0-9]{8}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{12}"
For Each Match in regEx.Execute(tempData)
isMSMData = True
Next
Set regEx = Nothing
End Function
Function renameComponent(oldComponent,newComponent)
'check component doesnt exist
id = 0		
Do While componentExists(newComponent)	
id = id + 1			
newComponent = newComponent & id
Loop
Set tablesView = oDatabase.OpenView("SELECT `Table`,`Name` FROM `_Columns` WHERE `Name`= 'Component_' OR Name`= 'Component'") 
tablesView.Execute
Set tablesRec = tablesView.Fetch
Do While Not tablesRec Is Nothing
tempTable = tablesRec.StringData(1)
tempColumn = tablesRec.StringData(2)
If oDatabase.TablePersistent(tempTable) = 1 Then 					
Set tempTableView = oDatabase.OpenView("SELECT `" & tempColumn & "` FROM `" & tempTable & "` WHERE `" & tempColumn & "`='" & oldComponent & "'")
tempTableView.Execute
Set tempTableRec = tempTableView.Fetch	
Do Until tempTableRec Is Nothing						
tempTableRec.StringData(1) = newComponent
tempTableView.Modify msiViewModifyReplace, tempTableRec
Set tempTableRec = tempTableView.Fetch
Loop
Set tempTableView = Nothing
Set tempTableRec = Nothing							
End If			
Set tablesRec = tablesView.Fetch
Loop						
Set tablesView = Nothing
Set tablesRec = Nothing
Set tablesView = oDatabase.OpenView("SELECT `Table`,`Column` FROM `_Validation` WHERE `Category`= 'Condition' OR `Category`= 'Formatted' OR `Category`= 'Identifier'") 
tablesView.Execute
Set tablesRec = tablesView.Fetch
Do While Not tablesRec Is Nothing
tempTable = tablesRec.StringData(1)
tempColumn = tablesRec.StringData(2)
If oDatabase.TablePersistent(tempTable) = 1 Then 					
Set tempTableView = oDatabase.OpenView("SELECT `" & tempColumn & "` FROM `" & tempTable & "`")
tempTableView.Execute
Set tempTableRec = tempTableView.Fetch	
Do Until tempTableRec Is Nothing	
tempColVal = tempTableRec.StringData(1)
If InStr(tempColVal,"$" & oldComponent) Then
tempTableRec.StringData(1) = Replace(tempColVal,"$" & oldComponent,"$" & newComponent)
tempTableView.Modify msiViewModifyReplace, tempTableRec						
End If
If InStr(tempColVal,"?" & oldComponent) Then
tempTableRec.StringData(1) = Replace(tempColVal,"?" & oldComponent,"?" & newComponent)
tempTableView.Modify msiViewModifyReplace, tempTableRec						
End If
Set tempTableRec = tempTableView.Fetch
Loop
Set tempTableView = Nothing
Set tempTableRec = Nothing							
End If			
Set tablesRec = tablesView.Fetch
Loop						
Set tablesView = Nothing
Set tablesRec = Nothing
WriteLog "Component: " & oldComponent & " renamed to : " & newComponent
End Function
'used to see if a component exists or Not
Function componentExists(component)
'this function is called initially with '1' as the id.  Then this value gets incrememnetd if the component exists
Set compExistView = oDatabase.OpenView("SELECT `Component` FROM `Component` WHERE `Component`='" & component & "'")
compExistView.Execute
Set compExistRec = compExistView.Fetch
If Not compExistRec is Nothing Then
Set compExistView = Nothing
Set compExistRec = Nothing
componentExists = True			
Else
Set compExistView = Nothing
Set compExistRec = Nothing
componentExists = False
End If	
End Function

 

Set Arbitrary Keypaths

Description:

This script will set arbitrary keypaths for components with no keypath.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Assigning Arbitrary Keypaths"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
Dim keypathView, keypathRec, blnKeypathSet, tempView, tempRec
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
If oDatabase.TablePersistent("Component") = 1 Then
'find all components which do not have Keypaths
Set keypathView = oDatabase.OpenView("SELECT `Component`,`ComponentId`, `Attributes` FROM `Component` WHERE `KeyPath` IS Null")
keypathView.Execute
Set keypathRec = keypathView.Fetch
Do Until keypathRec Is Nothing
'initiate this to false
blnKeypathSet = False	
If oDatabase.TablePersistent("File") = 1 Then
'Check file table			
Set Tempview = oDatabase.OpenView("SELECT `File`,`Component_` FROM `File` WHERE `Component_`='" & keypathRec.StringData(1) & "'")
Tempview.Execute
Set tempRec  = Tempview.Fetch
If Not tempRec Is Nothing Then
WriteLog "Setting keypath of component: " & keypathRec.StringData(1) & " to: " & tempRec.StringData(1)
'set file as keypath
oDatabase.OpenView("UPDATE `Component` SET `KeyPath` = '" & tempRec.StringData(1) & "' WHERE `Component` = '" & keypathRec.StringData(1) & "'").Execute()			
blnKeypathSet = True					
'update component attribute to reflect keypath type
setComponentAttribute keypathRec.StringData(3),"File"
End If
Set Tempview = Nothing
Set tempRec = Nothing
End If
If Not blnKeypathSet Then
If oDatabase.TablePersistent("Registry") = 1 Then 
Set Tempview = oDatabase.OpenView("SELECT `Registry`, `Component_` FROM `Registry` WHERE `Component_`='" & keypathRec.StringData(1) & "'")
Tempview.Execute
Set tempRec = Tempview.fetch
If Not tempRec is Nothing Then	
WriteLog "Setting keypath of component: " & keypathRec.StringData(1) & " to: " & tempRec.StringData(1)
'set reg as keypath
oDatabase.OpenView("UPDATE `Component` SET `KeyPath` = '" & tempRec.StringData(1) & "' WHERE `Component` = '" & keypathRec.StringData(1) & "'").Execute()
blnKeypathSet = True
'update component attribute to reflect keypath type
setComponentAttribute keypathRec.StringData(3),"Registry"				
end If
Set Tempview = Nothing
Set tempRec = Nothing
End If
End If
If Not blnKeypathSet Then
If oDatabase.TablePersistent("ODBCDataSource") = 1 Then
'check ODBCDataSource table 
Set Tempview = oDatabase.OpenView("SELECT `DataSource`, `Component_` FROM `ODBCDataSource` WHERE `Component_`='" & keypathRec.StringData(1) & "'")
Tempview.Execute
Set tempRec = Tempview.fetch
If Not tempRec is Nothing Then
WriteLog "Setting keypath of component: " & keypathRec.StringData(1) & " to: " & tempRec.StringData(1)
'set odbc as keypath
oDatabase.OpenView("UPDATE `Component` SET `KeyPath` = '" & tempRec.StringData(1) & "' WHERE `Component` = '" & keypathRec.StringData(1) & "'").Execute()													
'update component attribute to reflect keypath type
setComponentAttribute keypathRec.StringData(3),"ODBCDataSource"	
end If
Set Tempview = Nothing
Set tempRec = Nothing
End If
End If
Set keypathRec = keypathView.Fetch
Loop
End If
oDatabase.Commit	
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing	
Set keypathRec = Nothing
Set keypathView = Nothing
Set TempRec = Nothing
Set Tempview = Nothing
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub
'check component attribute is set correctly for the type of keypath
Sub setComponentAttribute(ComponentAttribute,keypathType)
'check attributes value for component is correct
Dim decimal : decimal = CInt(ComponentAttribute)
Dim binary : binary = CStr(DecToBin(decimal))
'reset keypath attributes to zero for
'registry
binary = Left(binary,Len(binary)-3) & "0" & Right(binary,2)
'odbcdatasource
binary = Left(binary,Len(binary)-6) & "0" & Right(binary,5)
Select Case keypathType		
Case "Registry"
binary = Left(binary,Len(binary)-3) & "1" & Right(binary,2)
Case "ODBCDataSource"
binary = Left(binary,Len(binary)-6) & "1" & Right(binary,5)
End Select
decimal = BinToDec(binary)
oDatabase.OpenView("UPDATE `Component` SET `Attributes` = '" & decimal & "' WHERE `Component` = '" & keypathRec.StringData(1) & "'").Execute()
End Sub
'funtions used to convert decimal and binary values.  Used so that when we assign arbitrary keypath, the
'components Attribute value must be consistent
Function DecToBin(intDec)
dim strResult
dim intValue
dim intExp
strResult = ""
intValue = intDec
intExp = 32768
while intExp >= 1
if intValue >= intExp then
intValue = intValue - intExp
strResult = strResult & "1"
Else
strResult = strResult & "0"
end If
intExp = intExp / 2
Wend
DecToBin = strResult
End Function
Function BinToDec(strBin)
dim lngResult
dim intIndex
lngResult = 0
for intIndex = len(strBin) To 1 step -1
Dim strDigit : strDigit = mid(strBin, intIndex, 1)
select case strDigit
case "0"
' do nothing
case "1"
lngResult = lngResult + (2 ^ (len(strBin)-intIndex))
case Else
' invalid binary digit, so the whole thing is invalid
lngResult = 0
intIndex = 0 ' stop the loop
end select
next
BinToDec = lngResult
End Function

 

Create Short File Names

Description:

This script will create short file names (8.3 format) for the File table and the IniFile table of a Windows Installer.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Creating Short Filenames"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiViewModifyReplace = 4
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
Dim extension : extension = ""
Dim filename : filename = ""
Dim tempfilename : tempfilename = ""
Dim filenameNoExtension : filenameNoExtension = ""
Dim sfncount : sfncount = 1	'a count which increments the sfn version
Const msiViewModifyUpdate  = 2
Dim fileView, fileRecord, filenameArray, i, fnView, fnRecord, tableRecord, tableView, tableName
Dim ranhexa, ranhexb, ranhexc, ranhexd
Dim sql : sql = "SELECT * FROM _Columns WHERE Name = 'FileName'"	
Set tableView= oDatabase.OpenView(sql) 
tableView.Execute
Set tableRecord = tableView.Fetch
While Not tableRecord Is Nothing
tableName = tableRecord.StringData(1)
If tableName = "File" OR tableName = "IniFile" Then
sql = "SELECT FileName FROM " & tableName	
Set fileView= oDatabase.OpenView(sql) 
fileView.Execute
Set fileRecord = fileView.Fetch
While Not fileRecord Is Nothing
filename = fileRecord.StringData(1)
sfncount = 1
filenameArray = ""
filenameNoExtension = ""
'if the file doesnt have a sfn
If Not InStr(filename,"|") > 0 Then
If InStr(filename,".") > 0 Then 'if there's a period in the filename we get the filename with no extension
filenameArray = Split(filename,".")
For i = 0 To UBound(filenameArray) - 1
filenameNoExtension = filenameNoExtension & filenameArray(i)				
Next
'return 'html', for example
extension = filenameArray(ubound(filenameArray))		
'return exampl~1.htm|examplefile.html 	
Else
filenameNoExtension = filename
extension = ""
End If
If (Len(filenameNoExtension) > 8) Or (Len(filename) > 12) Or (Len(extension) > 3) Then 'it needs to be put in sfn
'replace illegal 8.3 chars with '_'
filenameNoExtension = Replace(filenameNoExtension," ","_")
filenameNoExtension = Replace(filenameNoExtension,"/","_")
filenameNoExtension = Replace(filenameNoExtension,"\","_")
filenameNoExtension = Replace(filenameNoExtension,":","_")
filenameNoExtension = Replace(filenameNoExtension,"*","_")
filenameNoExtension = Replace(filenameNoExtension,"?","_")
filenameNoExtension = Replace(filenameNoExtension,"""","_")
filenameNoExtension = Replace(filenameNoExtension,"[","_")
filenameNoExtension = Replace(filenameNoExtension,"]","_")
filenameNoExtension = Replace(filenameNoExtension,"|","_")
filenameNoExtension = Replace(filenameNoExtension,"=","_")
filenameNoExtension = Replace(filenameNoExtension,",","_")
filenameNoExtension = Replace(filenameNoExtension,".","_")
filenameNoExtension = Replace(filenameNoExtension,";","_")
tempfilename = UCase(CStr(Left(filenameNoExtension,6) & "~" & sfncount & "." & Left(extension,3)))
'we've sorted by the filename column, so we can just compar against the previous row and increment it
Do While sfnExists(tempfilename) And tableName <> "IniFile"
'if the shortfilename entry exists, increment the sfn counter.  Unless we're in the IniFile table, where we can have identical SFN entries
sfncount = sfncount + 1
tempfilename = UCase(CStr(Left(filenameNoExtension,6) & "~" & sfncount & "." & Left(extension,3)))
'if you've exceeded 9, then we need to generate new hex values.
If sfncount > 9 Then					
sfncount = 1 'decrement back to 1 and make some hex values
'get new hex values
ranhexa = Hex(Int((15+1)*Rnd))
ranhexb = Hex(Int((15+1)*Rnd))
ranhexc = Hex(Int((15+1)*Rnd))
ranhexd = Hex(Int((15+1)*Rnd))					
tempfilename = UCase(CStr(Left(filenameNoExtension,2) & ranhexa & ranhexb & ranhexc & ranhexd & "~" & sfncount & "." & Left(extension,3)))
End If										
Loop		
'modify enables us to insert single quotes!
fileRecord.StringData(1) = CStr(tempfilename & "|" & filename)
fileView.Modify msiViewModifyUpdate, fileRecord
WriteLog "Filename: " & filename & " has been modified to: " & 	CStr(tempfilename & "|" & filename) & " in the " & tableName & " table"
End If	
End If	
Set fileRecord = fileView.Fetch
Wend 
Set fileView = Nothing
Set fileRecord = Nothing
End If
Set tableRecord = tableView.Fetch
Wend 
Set tableView = Nothing
Set tableRecord = Nothing
oDatabase.Commit	
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing	
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub
'checks to see if the short file name exists in file table before we add it
Function sfnExists(sfn)
sfnExists = False
sql = "SELECT `FileName` FROM `File`" 
Set fnView= oDatabase.OpenView(sql) 
fnView.Execute
Set fnRecord = fnView.Fetch
Do Until fnRecord Is Nothing
If Left(LCase(fnRecord.StringData(1)),Len(sfn)) = LCase(sfn) Then
sfnExists = True
Set fnView = Nothing
Set fnRecord = Nothing
Exit Function
End If
Set fnRecord = fnView.Fetch	
Loop
Set fnView = Nothing
Set fnRecord = Nothing
End Function

 

Delete Duplicate Registry

Description:

This script will delete duplicate registry entries in the Registry table of a Windows Installer.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Removing Duplicate Registry"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiViewModifyReplace = 4
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
Dim registryView, registryRecord, duplicateView, duplicateRecord, tempRecord
If oDatabase.TablePersistent("Registry") = 1 And oDatabase.TablePersistent("Component") = 1  Then
Set registryView = oDatabase.OpenView("SELECT `Registry`,`Key`,`Name`,`Value`,`Component_` FROM `Registry`")
registryView.Execute
Set registryRecord = registryView.Fetch
Do Until registryRecord Is Nothing
Set duplicateView = oDatabase.OpenView("SELECT `Registry` FROM `Registry` WHERE `Key`=? AND `Name`=? AND `Value`=? AND `Registry` <> ?")
Set tempRecord = oInstaller.CreateRecord(4)    
tempRecord.StringData(1) = registryRecord.StringData(2)    
tempRecord.StringData(2) = registryRecord.StringData(3)
tempRecord.StringData(3) = registryRecord.StringData(4)  
tempRecord.StringData(4) = registryRecord.StringData(1) 		
duplicateView.Execute(tempRecord)
Set tempRecord = Nothing
Set duplicateRecord = duplicateView.Fetch
While not duplicateRecord is Nothing
if not isMSMData(registryRecord.StringData(1)) and not isMSMData(duplicateRecord.StringData(1)) Then
WriteLog "DELETE FROM `Registry` WHERE `Registry` = '" & registryRecord.StringData(1) & "'"
oDatabase.OpenView("DELETE FROM `Registry` WHERE `Registry` = '" & registryRecord.StringData(1) & "'").Execute
Else
WriteLog "Omitted Duplicate Registry in Merge Module: " & registryRecord.StringData(1)
end If
Set duplicateRecord = duplicateView.Fetch
Wend
Set registryRecord = registryView.Fetch
Loop
End If
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing	
Set registryView = Nothing
Set registryRecord = Nothing
Set duplicateView = Nothing
Set duplicateRecord = Nothing
oDatabase.Commit	
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub
'returns true if tempData contains MSM decoration
Function isMSMData(tempData)
isMSMData = False
Dim Match
Dim regEx : Set regEx = New RegExp
regEx.MultiLine = vbTrue
regEx.global = vbTrue
regEx.Pattern = "[A-Za-z0-9]{8}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{12}"
For Each Match in regEx.Execute(tempData)
isMSMData = True
Next
Set regEx = Nothing
End Function

 

Delete Empty Components

Description:

This script will delete empty components from a Windows Installer.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Deleting Empty Components"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
Dim componentsView, componentsRec, tableView, tableRec, dataView, dataRec
Dim emptyComponent : emptyComponent = True
Dim tempComponent : tempComponent = ""
If oDatabase.TablePersistent("Component") = 1 Then
Set componentsView = oDatabase.OpenView("Select `Component` From `Component` ORDER BY `Component`")
componentsView.Execute
Set componentsRec = componentsView.Fetch
Do While Not componentsRec is Nothing
tempComponent = componentsRec.StringData(1)
emptyComponent = True
'list the tables that have 'Component_' (foreign key) columns
Set tableView = oDatabase.OpenView("SELECT `Table` FROM `_Columns` WHERE `Name`= 'Component_' AND `Table` <> 'FeatureComponents'") 
tableView.Execute
Set tableRec = tableView.Fetch
Do While Not tableRec is Nothing
Set dataView = oDatabase.OpenView("SELECT  `Component_` FROM `" & tableRec.StringData(1) & "`  WHERE `Component_`='" & tempComponent & "'")
dataView.Execute
If Not dataView.Fetch is Nothing Then 'this table has a some data belonging to some component
'component contains data
emptyComponent = False
'skip component and move to next
Exit Do
End If
Set tableRec = tableView.Fetch
Loop
If emptyComponent Then
'delete the empty component
oDatabase.OpenView("DELETE FROM `Component` WHERE `Component` = '" & tempComponent & "'").Execute
oDatabase.OpenView("DELETE FROM `FeatureComponents` WHERE `Component_` = '" & tempComponent & "'").Execute
WriteLog "Deleting empty component: " & tempComponent
End If
Set componentsRec = componentsView.Fetch
Loop
Set tableRec = Nothing
Set tableView = Nothing
Set componentsView = Nothing
Set componentsRec = Nothing
Set dataView = Nothing
End If	
oDatabase.Commit
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing	
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub

 

Split INI Files into Separate Components

Description:

This script will split INI files into separate components, as per Windows Installer Best Practices.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Splitting INI Files into Separate Components"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
Dim tableView, tableRec, tempView, tempRec, componentView, componentRec, tempComponent, id, compExistView, compExistRec, createFolderView, createFolderRec
Dim tempinifilename : tempinifilename = ""
Dim tempDir : tempDir = ""
Dim tempfilename : tempfilename = ""
Dim blnMovedComponent : blnMovedComponent = False
If oDatabase.TablePersistent("IniFile") = 1 Then
'select component from the inifile table
Set Tableview = oDatabase.OpenView("SELECT DISTINCT `IniFile`.`Component_`, `FeatureComponents`.`Feature_` FROM `IniFile`, `Component`, `FeatureComponents` WHERE `IniFile`.`Component_` = `Component`.`Component` AND `Component`.`Component` = `FeatureComponents`.`Component_`")
Tableview.Execute
Set TableRec = Tableview.Fetch	
Do While Not TableRec Is Nothing
blnMovedComponent = True
tempfilename = ""
'select all the ini files in this component
Set Tempview = oDatabase.OpenView("SELECT `FileName` FROM `IniFile` WHERE `Component_`='" & TableRec.StringData(1) & "' ORDER BY `FileName`")
Tempview.Execute
Set TempRec = Tempview.Fetch
'component has more than one ini file
Do While Not TempRec Is Nothing
'if we're in same component but different file
If (TempRec.StringData(1) <> tempfilename) And Not blnMovedComponent Then
Set componentView = oDatabase.OpenView("SELECT * FROM `Component` WHERE `Component`='" & TableRec.StringData(1) & "'")
componentView.Execute
Set componentRec = componentView.Fetch
If Not componentRec Is Nothing Then
'we want to name to component the same name as the ini file
tempComponent = tempfilename 
'we get the fir from the Component table (as opposed to the DirProperty column in the inifile table) - more reliable
tempDir = componentRec.StringData(3)
'if its in sfn form, take the long file name for our component
If InStr(tempComponent,"|") > 0 Then
tempComponent = Split(tempComponent,"|")(1)
End If
'comp name cannot start with a number
If IsNumeric(Left(tempComponent,1)) Then
tempComponent = "_" & tempComponent
End If 
'comp cannot contain dashes
tempComponent = Replace(tempComponent,"-","_")
id = 0
'ensure component name is unique
Do While Not getComponent(tempComponent)
If (id > 0) Then
tempComponent = Left(tempComponent,Len(tempComponent)-Len(CStr(id))) 
End If
id = id + 1		
tempComponent = CStr(tempComponent & id)
Loop									
oDatabase.OpenView("INSERT INTO `Component` (`Component`,`ComponentId`,`Directory_`,`Attributes`,`Condition`) VALUES ('"& tempComponent &"','"& returnGuid &"','"& tempDir &"',"& componentRec.StringData(4) &",'"& componentRec.StringData(5) &"')").Execute
oDatabase.OpenView("INSERT INTO `FeatureComponents` (`Feature_`,`Component_`) VALUES ('"& TableRec.StringData(2) &"','"& tempComponent &"')").Execute
'ensure there's an entry in the CreateFolders table
Set createfolderView = oDatabase.OpenView("SELECT `Directory_` FROM `CreateFolder` WHERE `Directory_` = '" & tempDir & "' AND `Component_` = '" & tempComponent & "'")
createfolderView.Execute
Set createfolderRec = createfolderView.Fetch
If createfolderRec Is Nothing Then								
oDatabase.OpenView("INSERT INTO `CreateFolder` (`Directory_`,`Component_`) VALUES ('"& tempDir &"','"& tempComponent &"')").Execute
WScript.Echo "INSERT INTO `CreateFolder` (`Directory_`,`Component_`) VALUES ('"& tempDir &"','"& tempComponent &"')"
End If
Set createfolderRec= Nothing
Set createfolderView= Nothing
'Finally update the inifile table to point to the new component
oDatabase.OpenView("UPDATE `IniFile` SET `Component_` = '" & tempComponent & "' WHERE `FileName` = '"& tempfilename &"'").Execute
WriteLog "Separated INI File: " & tempfilename & " into its own component called: " & tempComponent
End If
End If
Set componentView = Nothing
Set componentRec = Nothing
tempfilename = TempRec.StringData(1)
blnMovedComponent = False
Set TempRec = Tempview.Fetch
Loop
Set TempRec = Nothing
Set Tempview = Nothing
Set TableRec = Tableview.Fetch
Loop
Set TableRec= Nothing
Set TableView= Nothing
End If
oDatabase.Commit	
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing		
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub
'gets random guid	
Function returnGuid()
Dim TypeLib : Set TypeLib = CreateObject("Scriptlet.TypeLib")
Dim tg : tg = TypeLib.Guid
returnGuid = Left(tg, len(tg)-2)
Set TypeLib = Nothing
End Function
'used to see if a component exists or not
Function getComponent(component)
'this function is called initially with '1' as the id.  Then this value gets incrememnetd if the component exists
Set compExistView = oDatabase.OpenView("SELECT `Component` FROM `Component` WHERE `Component`='" & component & "'")
compExistView.Execute
Set compExistRec = compExistView.Fetch
If Not compExistRec is Nothing Then
getComponent = False					
Else
getComponent = True	
End If
Set compExistView = Nothing
Set compExistRec = Nothing
End Function

 

Split PE Files into Separate Components

Description:

This script will split PE files into separate components, as per Windows Installer Best Practices.

Usage

CScript.exe {Script} {MSI}

Script

'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create a name/path for log file
Dim MSIPath : Set MSIPath = fso.GetFile(WScript.Arguments(0))  
Dim logFile : logFile = Left(MSIPath.Path, InStrRev(MSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Splitting PE Files into Separate Components"
WriteLog "Processing: " & MSIPath.Name
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiViewModifyReplace = 4
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
'open the MSI (the first argument supplied to the vbscript)
Dim oDatabase : Set oDatabase = oInstaller.OpenDatabase(WScript.Arguments(0),msiOpenDatabaseModeTransact) 
Dim tempComponent : tempComponent = ""
Dim tempFilename : tempFilename = ""
Dim tempFileKey : tempFileKey = ""	
Dim	tempDirectory : tempDirectory = ""
Dim	tempAttributes : tempAttributes = ""
Dim	tempCondition : tempCondition = ""
Dim	tempFeature : tempFeature = ""
Dim tempKeypath : tempKeypath = ""
Dim tempExtensionArray
Dim TableView, TableRec, fileView, fileRec, tempExtension, id, compExistView, compExistRec
If oDatabase.TablePersistent("Component") = 1 AND oDatabase.TablePersistent("File") = 1 Then 
'select component
Set Tableview = oDatabase.OpenView("SELECT `Component`.`Component`,`Component`.`Directory_`,`Component`.`Attributes`,`Component`.`Condition`,`Component`.`KeyPath`,`FeatureComponents`.`Feature_` FROM `Component`,`FeatureComponents` WHERE `Component`.`Component` = `FeatureComponents`.`Component_`")
Tableview.Execute
Set TableRec = Tableview.Fetch
'component table has records
Do Until TableRec Is Nothing
tempComponent = TableRec.StringData(1)
tempDirectory = TableRec.StringData(2)
tempAttributes = TableRec.StringData(3)
tempCondition = TableRec.StringData(4)
tempKeypath = TableRec.StringData(5)
tempFeature = TableRec.StringData(6)
If Not isMSMData(tempComponent) Then
'select every file in this component except the keypath
Set fileView = oDatabase.OpenView("SELECT `File`,`FileName`,`Version` FROM `File` WHERE `Component_`='" & tempComponent & "' and `File` <> '" & tempKeypath & "'")
fileView.Execute
Set fileRec = fileView.Fetch
Do Until fileRec Is Nothing
tempFileKey = fileRec.StringData(1)
tempFilename = fileRec.StringData(2)
If InStr(tempFilename,"|") Then
'attempt to get actual filename if there is a sfn equivalent
tempFilename = Split(tempFilename,"|")(1)
End If
If InStr(tempFilename,".") > 0 Then
tempExtensionArray = Split(LCase(tempFilename),".")
tempExtension = "." & tempExtensionArray(UBound(tempExtensionArray))
Else
tempExtension = ""
End If			
'If current file is a PE file, separate it into another component
If Len(tempExtension) = 4 And InStr(1,".ica,.lnk,.inf,.ini,.dll,.exe,.ocx,.tlb,.chm,.drv,.hlp,.sys,.ttf,.mdb,.mdf,.ldf,.jar,.dbf,.vbs,.rll",tempExtension)>0 Then
id = 0		
Do While componentExists(tempFilename)	
id = id + 1			
tempFilename = tempFilename & id
Loop
WScript.Echo "tempext: " & tempExtension
WriteLog "Moving File: " & tempFileKey & " into new Component: " & tempFilename
oDatabase.OpenView("INSERT INTO `Component` (`Component`,`ComponentId`,`Directory_`,`Attributes`,`Condition`,`KeyPath`) VALUES ('"& tempFilename &"','"& returnGuid &"','"& tempDirectory &"',"& tempAttributes &",'"& tempCondition &"','"& tempFileKey &"')").Execute
oDatabase.OpenView("UPDATE `File` SET `Component_` = '" & tempFilename & "' WHERE `File` = '"& tempFileKey &"'").Execute
oDatabase.OpenView("INSERT INTO `FeatureComponents` (`Feature_`,`Component_`) VALUES ('"& tempFeature &"','"& tempFilename &"')").Execute
End If
Set fileRec = fileView.Fetch
Loop
Set fileView = Nothing
Set fileRec = Nothing
end If
Set TableRec = Tableview.Fetch
Loop
Set TableRec = Nothing
Set Tableview = Nothing
Set fileRec = Nothing
End If
oDatabase.Commit	
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing	
Set oDatabase = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub
'return a random guid for when we create a new component
Function returnGuid()
Dim TypeLib : Set TypeLib = CreateObject("Scriptlet.TypeLib")
Dim tg : tg = TypeLib.Guid
returnGuid = Left(tg, len(tg)-2)
Set TypeLib = Nothing
End Function
'returns true if tempData contains MSM decoration
Function isMSMData(tempData)
isMSMData = False
Dim Match
Dim regEx : Set regEx = New RegExp
regEx.MultiLine = vbTrue
regEx.global = vbTrue
regEx.Pattern = "[A-Za-z0-9]{8}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{12}"
For Each Match in regEx.Execute(tempData)
isMSMData = True
Next
Set regEx = Nothing
End Function
'used to see if a component exists or Not
Function componentExists(component)
'this function is called initially with '1' as the id.  Then this value gets incrememnetd if the component exists
Set compExistView = oDatabase.OpenView("SELECT `Component` FROM `Component` WHERE `Component`='" & component & "'")
compExistView.Execute
Set compExistRec = compExistView.Fetch
If Not compExistRec is Nothing Then
Set compExistView = Nothing
Set compExistRec = Nothing
componentExists = True			
Else
Set compExistView = Nothing
Set compExistRec = Nothing
componentExists = False
End If	
End Function

 

Merge Multiple Windows Installer Transforms

Description:

This script will merge multiple Windows Installer transforms into one single transform.

Usage:

CScript.exe {Script} {MSI} {Transform 1} {Transform 2} {Transform x..}
(or if transform ordering is not important, drag an MSI and multiple MSTs onto the VBS file)

Script:


'set up log file
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'create 2 constants - one for when we want to just query the MSI (read) and one for when we want to make changes (write)
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
' Adds a row that already exists.
Const msiTransformErrorAddExistingRow = 1 
' Deletes a row that does not exist.
Const msiTransformErrorDeleteNonExistingRow = 2 
' Adds a table that already exists.
Const msiTransformErrorAddExistingTable = 4 
' Deletes a table that does not exist.
Const msiTransformErrorDeleteNonExistingTable = 8 
' Updates a row that does not exist.
Const msiTransformErrorUpdateNonExistingRow = 16 
' Transform and database code pages do not match and neither has a neutral code page.
Const msiTransformErrorChangeCodePage = 32 
' Creates the temporary _TransformView table.
Const msiTransformErrorViewTransform = 256 
Dim errorCondition : errorCondition = msiTransformErrorChangeCodePage + msiTransformErrorUpdateNonExistingRow + msiTransformErrorDeleteNonExistingTable _
+ msiTransformErrorAddExistingTable + msiTransformErrorDeleteNonExistingRow + msiTransformErrorAddExistingRow
'create WindowsInstaller.Installer object
Dim oInstaller : Set oInstaller = CreateObject("WindowsInstaller.Installer")
Dim i
Dim msiname : msiname = ""
'Find MSI name.  This is useful if the order of applying the transform is not important and we want to just drag an MSI and a bunch of MSTs on to the script 
For i = 0 To Wscript.Arguments.Count - 1
If Right(LCase(WScript.Arguments.Item(i)),3) = "msi" Then
msiname = WScript.Arguments.Item(i)
End If
Next
'create a name/path for the transform
Dim originalMSIPath : Set originalMSIPath = fso.GetFile(msiname)  
Dim mergedMSTPath : mergedMSTPath = Left(originalMSIPath.Path, InStrRev(originalMSIPath.Path, ".") - 1) & "_Merged.MST"
'create a name/path for log File
Dim logFile : logFile = Left(originalMSIPath.Path, InStrRev(originalMSIPath.Path, ".") - 1) & ".log"
Dim objLogFile : Set objLogFile = fso.OpenTextFile(logFile, ForAppending, True)
WriteLog "Merging Transforms"
WriteLog "Processing: " & originalMSIPath.Name
'create a temp filename in the same folder as the MSI
Dim TempMSI : TempMSI = originalMSIPath.ParentFolder & "\" & fso.GetTempName
Dim TempMST : TempMST = ""
'create a copy opf the MSI, and call it our temporary name. 
originalMSIPath.Copy (TempMSI)   
'set the file attributes of the temporary MSI
fso.GetFile(TempMSI).Attributes = 0
'open our temp MSI
Dim tempDatabase : Set tempDatabase = oInstaller.OpenDatabase(TempMSI, msiOpenDatabaseModeTransact)
'apply all our transforms
For i = 0 To Wscript.Arguments.Count - 1
If Right(LCase(WScript.Arguments.Item(i)),3) = "mst" Then
TempMST = WScript.Arguments.Item(i)
tempDatabase.ApplyTransform TempMST, errorCondition
tempDatabase.Commit
WriteLog "Applying Transform: " & Right(WScript.Arguments.Item(i), Len(WScript.Arguments.Item(i)) - InStrRev(WScript.Arguments.Item(i), "\"))
End If	
Next
'open our original, un-transformed MSI
Dim originalMSI : Set originalMSI = oInstaller.OpenDatabase(originalMSIPath.Path, 0)
'Get the difference between our currently opened database with transforms applied (tempDatabase) and our original database (originalMSI), and generate
'a transform with the path of 'mergedMSTPath'
tempDatabase.GenerateTransform originalMSI, mergedMSTPath
'Create a summary information stream for the transform
tempDatabase.CreateTransformSummaryInfo originalMSI, mergedMSTPath, 0, 0
Const PID_TITLE = 2
Const PID_SUBJECT = 3
Const PID_AUTHOR = 4
Const PID_KEYWORDS = 5
Const PID_COMMENTS = 6
Const PID_TEMPLATE = 7
Const PID_PAGECOUNT = 14
Dim PID_TITLE_value : PID_TITLE_value = ""
Dim PID_SUBJECT_value : PID_SUBJECT_value = ""
Dim PID_AUTHOR_value : PID_AUTHOR_value = ""
Dim PID_KEYWORDS_value : PID_KEYWORDS_value = ""
Dim PID_COMMENTS_value : PID_COMMENTS_value = ""
Dim PID_TEMPLATE_value : PID_TEMPLATE_value = ""
Dim PID_PAGECOUNT_value : PID_PAGECOUNT_value = ""
'read SIS values from last applied transform
Dim sumInfo  : Set sumInfo = oInstaller.SummaryInformation(TempMST, 0)
PID_TITLE_value = sumInfo.Property(PID_TITLE)
PID_SUBJECT_value = sumInfo.Property(PID_SUBJECT)
PID_AUTHOR_value = sumInfo.Property(PID_AUTHOR)
PID_KEYWORDS_value = sumInfo.Property(PID_KEYWORDS)
PID_COMMENTS_value = sumInfo.Property(PID_COMMENTS)
PID_TEMPLATE_value = sumInfo.Property(PID_TEMPLATE)
PID_PAGECOUNT_value = sumInfo.Property(PID_PAGECOUNT)
Set sumInfo = Nothing
'now set the values of the SIS in the new transform
Set sumInfo = oInstaller.SummaryInformation(mergedMSTPath, 7)
sumInfo.Property(PID_TITLE) = PID_TITLE_value
sumInfo.Property(PID_SUBJECT) = PID_SUBJECT_value
sumInfo.Property(PID_AUTHOR) = PID_AUTHOR_value
sumInfo.Property(PID_KEYWORDS) = PID_KEYWORDS_value
sumInfo.Property(PID_COMMENTS) = PID_COMMENTS_value
sumInfo.Property(PID_TEMPLATE) = PID_TEMPLATE_value
sumInfo.Property(PID_PAGECOUNT) = PID_PAGECOUNT_value
'persist changes
sumInfo.Persist
Set sumInfo = Nothing
'close database
Set tempDatabase = Nothing
Dim File : Set File = fso.GetFile(TempMSI)
'we need to ensure all view and record objects are closed, otherwise the deletion will fail!
File.Delete
Set File = Nothing
WriteLog mergedMSTPath & " was created successfully!"
objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing
Set originalMSI = Nothing
Set oInstaller = Nothing
Sub WriteLog(LogMessage)
WScript.echo Now() & ": " & LogMessage
objLogFile.Writeline(Now() & ": " & LogMessage)
End Sub