Script to Fix Square Bracket Handling Bug in WISE for Windows Installer

' This utility analyses Wise for windows installer packages,
' checks for Registry keys which contain square brackets ([ ]) which
' are to be ignored in by the installer and converts them to [\[ ] and [\]]
' This is done by checking against the Property table

'
Option Explicit

Dim databasePath, szTableName, objFS
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1

set objFS = CreateObject( "Scripting.FileSystemObject" )

Dim argNum, argCount:argCount = Wscript.Arguments.Count
If (argCount < 1) Then
    databasePath = InputBox("Please enter the Msi file name including path",,"C:\testing\MYMSI.msi")
    if databasePath = "" then
        Fail "Cancel Selected"
    end if
else
    databasePath = Wscript.Arguments(0)
End If

'    Enter the Table name to update
szTableName = InputBox("Please enter the Table name to check",,"Registry")
if szTableName = "" then
    Fail "Cancel Selected"
end if

if (not objFS.FileExists(databasePath)) then Fail "File does not exist"

' Dump Changes to an excel spreadsheet so it can be analysed
dim objXL, intIndex: intIndex = 2
set objXL = CreateObject( "Excel.Application" )
objXL.Visible = TRUE
objXL.WorkBooks.Add
objXL.Cells(1, 1).Value = "Replacement String"
objXL.Rows(1).Font.Bold = True


' Export the Registry Table
TableImpExp szTableName, "Export"

' Process it to change source
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim InpFile, OutpFile, objRegExp, szLine, szOutputLine, DeleteFile
    Set objRegExp = new RegExp
    objRegExp.pattern = "\[*\]"
    objRegExp.ignorecase = TRUE
   
    Set InpFile = objFS.OpenTextFile("C:\test.txt" , ForReading)
    Set OutpFile = objFS.OpenTextFile("C:\test1.txt" , ForWriting, True)
    While(InpFile.AtEndOfStream <> True)
        szLine = InpFile.readline
        if (objRegExp.Test(szLine)) then
            szOutputLine = FixLine(szLine)
        else
            szOutputLine = szLine
        end if
        OutpFile.WriteLine(szOutputLine)
    Wend
    InpFile.close
    OutpFile.close

' Import the Registry Table
TableImpExp szTableName, "Import"

'Delete the temporary files created
Set DeleteFile = objFS.GetFile("C:\test.txt")
DeleteFile.Delete
Set DeleteFile = objFS.GetFile("C:\test1.txt")
DeleteFile.Delete

wscript.Echo "Operation Complete"
Wscript.Quit 0

'This function parses a line looking for [] combinations and checks property and fixes
Function FixLine(szLine)
dim iLSquareOff,iLSquareCurr,iRSquareOff,iRSquareCurr,szLReplace, szRReplace
dim szLLeave, szRLeave, szProperty, szMatchFound
iLSquareCurr=1:iRSquareCurr=1
szLReplace="[\[]":szRReplace="[\]]"
szLLeave="[":szRLeave="]"
FixLine = ""
do
    iLSquareOff = instr(iLSquareCurr,szLine,"[") + 1
    iRSquareOff = instr(iRSquareCurr,szLine,"]")
    if iRSquareOff=0 then
        Fixline = FixLine & mid(szLine,iRSquareCurr)
        exit do
    end if
    Fixline = FixLine & mid(szLine,iRSquareCurr,(ILSquareOff - IRSquareCurr -1))
'    Need to put a fix in here for cases like [\]] or [\[ ] etc
    szProperty = mid(szLine,iLSquareOff,(IRSquareOff - ILSquareOff))
    szMatchFound = msiPropertyExists(szProperty)
    if (szMatchFound = "") then
        FixLine = FixLine & szLReplace & szProperty & szRReplace
    objXL.Cells(intIndex, 1).Value = szLReplace & szProperty & szRReplace
    intIndex = intIndex + 1
    else
        FixLine = FixLine & szLLeave & szProperty & szRLeave
    end if
    iRSquareOff = iRSquareOff + 1
    ILSquareCurr = ILSquareOff
    IRSquareCurr = IRSquareOff
loop
end function

' This function checks the property table in the MSI database for szProperty
Function msiPropertyExists(szProperty)
' Process SQL statements
Dim query, view, record, message, szFirstChar
    msiPropertyExists="TRUE"
    szFirstChar = mid(szProperty,1,1)
'    Check for special characters in the first position
    if szFirstChar = "!" then Exit Function
    if szFirstChar = "$" then Exit Function
    if szFirstChar = "~" then Exit Function
    if szFirstChar = "#" then Exit Function
    if szFirstChar = "\" then Exit Function
    if szProperty = "SHELLNOOP" then Exit Function
    msiPropertyExists="" ' Set to false after passing the tests above
' Connect to Windows installer object
Dim openMode : openMode = msiOpenDatabaseModeTransact
On Error Resume Next
Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError

' Open database
Dim database : Set database = installer.OpenDatabase(databasePath, openMode) : CheckError

    query = "Select Property FROM Property WHERE Property='" & szProperty & "'"
    Set view = database.OpenView(query) : CheckError
    view.Execute : CheckError
    Set record = view.Fetch
'    Big kludge here but should work. When found record is defined otherwise use ""
    msiPropertyExists=record.StringData(1)   
    If openMode = msiOpenDatabaseModeTransact Then database.Commit

end function

sub TableImpExp(szTable, ImpExp)

' Connect to Windows installer object
Dim openMode : openMode = msiOpenDatabaseModeTransact
On Error Resume Next
Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError

' Open database
Dim database : Set database = installer.OpenDatabase(databasePath, openMode) : CheckError

if ImpExp = "Import" then
' Import the updated table into the database
database.import "C:\", "test1.txt"
end if
if ImpExp = "Export" then
' Export the table to a file
database.export szTable , "C:\", "test.txt"

end if


If openMode = msiOpenDatabaseModeTransact Then database.Commit
end Sub

Sub CheckError
    Dim message, errRec
    If Err = 0 Then Exit Sub
    message = Err.Source & " " & Hex(Err) & ": " & Err.Description
    If Not installer Is Nothing Then
        Set errRec = installer.LastErrorRecord
        If Not errRec Is Nothing Then message = message & vbLf & errRec.FormatText
    End If
    Fail message
End Sub

Sub Fail(message)
    Wscript.Echo message
    Wscript.Quit 2
End Sub