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

Posted on by
Reply

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

Posted on by
Reply

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

Posted on by
Reply

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

Posted on by
Reply

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

Posted on by
Reply

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

Posted on by
Reply

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

Posted on by
12

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

Posted on by
2

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

Posted on by
1

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

Posted on by
Reply

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