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
