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