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

 

Change the Class Context Case

Description:

This script will change the Class context case. For example, Inprocserver32 is replaced by InprocServer32.

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 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 "Modifying Context Case"
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 tempKey : tempKey = ""
Dim currentContext : currentContext = ""
Dim tempKeyArray, tableView, tableRec, originalValue, tempValue

If oDatabase.TablePersistent("Registry") = 1 Then

	Set Tableview = oDatabase.OpenView("SELECT `Key` FROM `Registry`")
	Tableview.Execute
	Set TableRec = Tableview.Fetch

  	While Not TableRec Is Nothing

	   	originalValue = TableRec.StringData(1)
	   	tempValue = originalValue

	   	If (InStr(1,tempValue,"inprocserver",1) > 0) And Not (InStr(1,tempValue,"InprocServer",0) > 0) _
	   	Or (InStr(1,tempValue,"inprochandler",1) > 0) And Not (InStr(1,tempValue,"InprocHandler",0) > 0) _
	   	Or (InStr(1,tempValue,"localserver",1) > 0) And Not (InStr(1,tempValue,"LocalServer",0) > 0) _
	   	Or (InStr(1,tempValue,"toolboxbitmap",1) > 0) And Not (InStr(1,tempValue,"ToolBoxBitmap",0) > 0) Then

	   		tempValue = Replace(tempValue,"inprocserver","InprocServer",1,-1,1)											
			tempValue = Replace(tempValue,"inprochandler","InprocHandler",1,-1,1)
			tempValue = Replace(tempValue,"localserver","LocalServer",1,-1,1)
			tempValue = Replace(tempValue,"toolboxbitmap","ToolBoxBitmap",1,-1,1)

			TableRec.StringData(1) = tempValue
			Tableview.Modify msiViewModifyReplace, TableRec

			WriteLog "Modifying Registry Key: " & originalValue & " and changing to: " & tempValue								
	    End If	

		Set TableRec = Tableview.Fetch
	Wend
End If

If oDatabase.TablePersistent("Class") = 1 Then

	Set Tableview = oDatabase.OpenView("SELECT `Context` FROM `Class`")
	Tableview.Execute
	Set TableRec = Tableview.Fetch

    While Not TableRec Is Nothing

		originalValue = TableRec.StringData(1)
	   	tempValue = originalValue

		If (InStr(1,tempValue,"inprocserver",1) > 0) And Not (InStr(1,tempValue,"InprocServer",0) > 0) _
		Or (InStr(1,tempValue,"inprochandler",1) > 0) And Not (InStr(1,tempValue,"InprocHandler",0) > 0) _
		Or (InStr(1,tempValue,"localserver",1) > 0) And Not (InStr(1,tempValue,"LocalServer",0) > 0) _
		Or (InStr(1,tempValue,"toolboxbitmap",1) > 0) And Not (InStr(1,tempValue,"ToolBoxBitmap",0) > 0) Then

			tempValue = Replace(tempValue,"inprocserver","InprocServer",1,-1,1)											
			tempValue = Replace(tempValue,"inprochandler","InprocHandler",1,-1,1)
			tempValue = Replace(tempValue,"localserver","LocalServer",1,-1,1)
			tempValue = Replace(tempValue,"toolboxbitmap","ToolBoxBitmap",1,-1,1)

			TableRec.StringData(1) = tempValue
			Tableview.Modify msiViewModifyReplace, TableRec	

			WriteLog "Modifying Class Context: " & originalValue & " and changing to: " & tempValue			

		End If				     			
		Set TableRec = Tableview.Fetch
	Wend
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

 

Change GUIDs to Upper Case

Description:

This script will change GUIDs to upper case, as per Windows Installer Best Practises

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 "Make GUIDs upper Case"
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)    

'do regex stuff'

Dim re : Set re = new regexp  'Create the RegExp object
Dim Match
'pattern for guid
re.Pattern = "(\{{1}([0-9a-fA-F]){8}-([0-9a-fA-F]){4}-([0-9a-fA-F]){4}-([0-9a-fA-F]){4}-([0-9a-fA-F]){12}\}{1})"
re.IgnoreCase = true
re.Global = True

Dim guid : guid = ""
Dim valueView, valueRecord
Dim columnValue : columnValue = ""
Dim tableValue : tableValue = ""

Dim sql : sql = "SELECT `Table`,`Column` FROM `_Validation` WHERE `Category` = 'Guid'"

Dim columnView : Set columnView = oDatabase.OpenView(sql)   

'execute the query 
columnView.Execute    'fetch the first row of data (if there is one!) 

Dim columnRecord : Set columnRecord = columnView.Fetch   

'whilst we've returned a row and therefore columnRecord is not Nothing 
While Not columnRecord Is Nothing      

	columnValue = columnRecord.StringData(2)
	tableValue = columnRecord.StringData(1)

	If oDatabase.TablePersistent(tableValue) = 1 Then

		Set valueView = oDatabase.OpenView("SELECT `" & columnValue & "` FROM `" & tableValue & "`")   

		'execute the query 
		valueView.Execute    'fetch the first row of data (if there is one!) 

		Set valueRecord = valueView.Fetch   

		'whilst we've returned a row and therefore valueRecord is not Nothing 
		While Not valueRecord Is Nothing    			

			guid = valueRecord.StringData(1)

			If guid <> UCase(guid) Then

				valueRecord.StringData(1) = UCase(guid)
		    	valueView.Modify msiViewModifyReplace, valueRecord

		    	WriteLog "Modifying Table: " & tableValue & ", column: " & columnValue & " and changing GUID from: " & guid & " to " & UCase(guid)

	    	End If

			Set valueRecord = valueView.Fetch 
		Wend   

		Set valueRecord = Nothing
	End	If

	Set columnRecord = columnView.Fetch 
Wend   

Set columnRecord = Nothing

Dim originalRegKey : originalRegKey = ""
Dim regkey : regkey = ""
Dim originalRegValue : originalRegValue = ""
Dim regValue : regValue = ""
Dim registryView, registryRecord
Dim Matches

Set registryView = oDatabase.OpenView("SELECT `Registry`, `Key`,`Value` FROM `Registry`")
registryView.Execute
Set registryRecord = registryView.Fetch

While Not registryRecord Is Nothing    

	originalRegKey = registryRecord.StringData(2)
   	regkey = originalRegKey
	'change guids in key column to upper case
	Set Matches =  re.Execute(regkey)

	If Matches.Count > 0 Then

		For Each Match in Matches
		     regkey = replace(regkey,Match.value,UCase(Match.value),1,-1,1)
		Next

		If StrComp(originalRegKey,regkey,0) <> 0 Then	
			registryRecord.StringData(2) = regkey
	    	registryView.Modify msiViewModifyReplace, registryRecord
	    	WriteLog "Modifying Registry Key: " & originalRegKey & " and changing To " & regkey
	    End If

	End If
	Set Matches = Nothing

	originalRegValue = registryRecord.StringData(3)
	regValue = originalRegValue
	'change guids in value column to upper case
	Set Matches =  re.Execute(regValue)	

	If Matches.Count > 0 Then
		For Each Match in Matches
		     regValue = replace(regValue,Match.value,UCase(Match.value),1,-1,1)
		Next

		If StrComp(originalRegValue,regValue,0) <> 0 Then
			registryRecord.StringData(3) = regValue
		    registryView.Modify msiViewModifyReplace, registryRecord	    
		    WriteLog "Modifying Registry Value: " & originalRegValue & " and changing To " & regValue
	    End If

	End If
	Set Matches = Nothing

	Set registryRecord = registryView.Fetch
Wend

Set registryRecord= Nothing
Set registryView= Nothing

oDatabase.commit

objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing	
Set re = Nothing
Set oDatabase = Nothing
Set oInstaller = Nothing 

Sub WriteLog(LogMessage)

	WScript.echo Now() & ": " & LogMessage
    objLogFile.Writeline(Now() & ": " & LogMessage)

End Sub

 

Delete Unused Directories

Description:

This script will delete unused directories in the Directory table which are unused

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 Unused Directories"
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 sql, dirView, dirRecord, directoryView, directoryRecord, execView, tableView, tableRec, directoryParentRec, directoryParentView, tempTable, tempColumn, dirsToDeleteView, dirsToDeleteRec

If oDatabase.TablePersistent("Directory") = 1 Then

	' alter table to add a temporary column for storing a marker
	Set execView = oDatabase.OpenView("ALTER TABLE `Directory` ADD `InUse` SHORT TEMPORARY HOLD")
	execView.Execute
	'	set all the markers to 0
	Set execView = oDatabase.OpenView("UPDATE `Directory` SET `InUse`=0")
	execView.Execute

	'-- Try all the Directory_ Foreign key tables
	Set tableView = oDatabase.OpenView("SELECT `Table` FROM `_Columns` WHERE `Name`= 'Directory_' ") 'this lists the tables that have 'Directory_' columns
	tableView.Execute
	Set tableRec = tableView.Fetch
	Do While Not tableRec is Nothing
		Set directoryView = oDatabase.OpenView("SELECT DISTINCT `Directory_` FROM `" & tableRec.StringData(1) & "`")
		directoryView.Execute
		Set directoryRecord = directoryView.Fetch
		While not directoryRecord is nothing
			MarkDir(directoryRecord.Stringdata(1))
			Set directoryRecord = directoryView.Fetch
		Wend
		Set tableRec = tableView.Fetch
	Loop

	Set tableView = Nothing
	Set tableRec = Nothing

	Set tableView = oDatabase.OpenView("SELECT `Table`,`Column` FROM `_Validation` WHERE `Column`= 'DestFolder' OR `Column`= 'DirProperty' OR `Column`= 'SourceFolder' OR `Column`= 'ReserveFolder'") 
	tableView.Execute
	Set tableRec = tableView.Fetch
	Do While Not tableRec Is Nothing
		tempTable = tableRec.StringData(1)
		tempColumn = tableRec.StringData(2)

		If oDatabase.TablePersistent(tempTable) = 1 Then
			Set directoryView = oDatabase.OpenView("SELECT DISTINCT `"& tempColumn &"` FROM `" & tempTable & "`")
			directoryView.Execute
			Set directoryRecord = directoryView.Fetch
			While Not directoryRecord is Nothing
				MarkDir(directoryRecord.StringData(1))
				Set directoryRecord = directoryView.Fetch
			Wend
		End If

		Set tableRec = tableView.Fetch

	Loop						

	Set tableView = Nothing
	Set tableRec = Nothing

	Set dirsToDeleteView = oDatabase.OpenView("SELECT `Directory`, `DefaultDir` FROM `Directory` WHERE `InUse`=0 ")
	dirsToDeleteView.Execute
	Set dirsToDeleteRec = dirsToDeleteView.Fetch
	While not dirsToDeleteRec is nothing
		If Left(dirsToDeleteRec.StringData(2), 2) <> ".:" And Not isMSMData(dirsToDeleteRec.StringData(1)) And Not childIsMSMData(dirsToDeleteRec.StringData(1)) Then
			WriteLog "DELETE FROM `Directory` WHERE `Directory`= '" & dirsToDeleteRec.StringData(1) & "'"
			oDatabase.OpenView("DELETE FROM `Directory` WHERE `Directory`= '" & dirsToDeleteRec.StringData(1) & "'").Execute

		End If
		Set dirsToDeleteRec = dirsToDeleteView.Fetch
	Wend

	Set execView = oDatabase.OpenView("ALTER TABLE `Directory` FREE ") '--remove the temporary column
	execView.Execute

End If

objLogFile.Close
Set fso = Nothing
Set objLogFile = Nothing
Set execView = Nothing
Set tableRec = Nothing
Set tableView = Nothing
Set directoryView = Nothing
Set directoryRecord = Nothing
Set dirsToDeleteView = Nothing
Set dirsToDeleteRec = Nothing

oDatabase.Commit	

Set oDatabase = Nothing
Set oInstaller = Nothing

Sub WriteLog(LogMessage)

	WScript.echo Now() & ": " & LogMessage
    objLogFile.Writeline(Now() & ": " & LogMessage)

End Sub

Sub MarkDir(sDirName)  

	Set execView = oDatabase.OpenView("UPDATE `Directory` SET `InUse`=1 WHERE `Directory` = '" & sDirName & "'")
	execView.Execute	' set the marker to 1 to indicate that the directory table entry is in use

	Set directoryParentView = oDatabase.OpenView("SELECT `Directory_Parent` FROM `Directory` WHERE `Directory` = '" & sDirName & "'") '--Done this one, now mark the parent directories
	directoryParentView.Execute
	Set directoryParentRec = directoryParentView.Fetch
	If not directoryParentRec is nothing Then

		MarkDir(directoryParentRec.StringData(1)) '-- recurse up the tree
	End If

	Set execView = Nothing
	Set directoryParentView = Nothing
	Set directoryParentRec = Nothing
End Sub

'this function is used to check child entries in the directory table, to make sure they're not from a merge module before
'the directory gets deleted

Function childIsMSMData(sDirectory)

	childIsMSMData = False

	sql = "SELECT `Directory` FROM `Directory` WHERE `Directory_Parent` = '" & sDirectory & "'" 
	Set dirView= oDatabase.OpenView(sql) 
	dirView.Execute
	Set dirRecord = dirView.Fetch
	Do Until dirRecord Is Nothing

		If isMSMData(dirRecord.StringData(1)) Then
			childIsMSMData = True
			Exit Do
		End If	

		Set dirRecord = dirView.Fetch	
	Loop

	Set dirView = Nothing
	Set dirRecord = Nothing

End Function

'returns true if sData contains MSM decoration
Function isMSMData(sData)
	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(sData)
		isMSMData = True
	Next
	Set regEx = Nothing
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