ftp2.jacobs.com/2015.02.ftp2.jacobs.com.tar/ftp2.jacobs.com/pub/MicrosoftUAG/UAG2010_ClientSetup.msi/Binary.MsiBinary

Text File | 2014-06-26 | 9KB | 241 lines

'================================================================
' Initialize global variables
'================================================================
Option Explicit
On Error Resume Next
'Findout the execution environment MSI or WSH(for debugging)
Dim MsiMode, Test
Err.Clear
Test = Session.Property("ComputerName")
If Err.number = 0 Then
    MsiMode = True
    LogInfo ScriptEngine & " Msi Mode"
Else
    MsiMode = False
    Err.Clear
    LogInfo ScriptEngine & " Cscript Mode"
' Test area - Insert here function names to be executed in debug session
'             running from command prompt with CSript
End If

'================================================================
' Define constants
'================================================================
Const CustomActionSuccess = 1
Const CustomActionFail    = 2

Const msiOpenDatabaseModeReadOnly = 0
Const msiReadStreamAnsi           = 2   'msiReadStreamBytes fails - ON SOME BYTES ONLY!
Const msiReadStreamBytes          = 1
Const msiReadStreamDirect         = 3


'=========================================================================
Function ExtractBinary()
    On Error Resume Next
    Dim BinaryKey, NewFileName
    BinaryKey = Session.Property("BinaryKey") ' Get BinaryKey to extract
    NewFileName = Session.Property("TempFolder") & Session.Property("ExtractedFileName") '
    ExtractBinary = CustomActionFail 'assume failure
    LogInfo "ExtractBinary(""" & BinaryKey & """, """ & NewFileName & """)"

    '--- Open the database -----------------------------------------------
    LogInfo "Opening """ & NewFileName & """"
    Dim DB
    DB = Session.Property("DATABASE")
    Dim oDB
    Set oDB = session.installer.OpenDatabase(DB, msiOpenDatabaseModeReadOnly)
    If (1 = HandleErr()) Then
        Exit Function
    End If
    LogInfo "Successfully opened """ & NewFileName & """"

    '--- Look for the BINARY ---------------------------------------------
    LogInfo "Looking for the binary """ & BinaryKey & """"
    Dim oView, oRec
    Set oView = oDB.OpenView("SELECT `Data` FROM `Binary` WHERE `Name`='" & BinaryKey & "'")
    oView.Execute
    Set oRec = oView.Fetch
    If oRec Is Nothing Then
        LogInfo "ExtractBinary(): Could not find the binary """ & BinaryKey & """"
        Exit Function
    End If
    LogInfo "Found the binary """ & BinaryKey & """"

    '--- Extract the Binary ----------------------------------------------
    LogInfo "Extracting the binary """ & BinaryKey & """"
    Dim FileSize, FileContents, OutStream
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adSaveCreateOverWrite = 2

    FileSize = oRec.DataSize(1)
    FileContents = oRec.ReadStream(1, FileSize, msiReadStreamDirect)
    oView.Close
    Redim ByteArray(FileSize)
    Set OutStream = CreateObject("ADODB.Stream")
    OutStream.Type = adTypeBinary
    OutStream.Open
    'Temporary stream to convert variant bytes from String() to Byte() type.
    With CreateObject("ADODB.Stream")
        .Type = adTypeText
        .Open
        .WriteText FileContents
        .Position = 2
        .CopyTo OutStream
        .Close
    End With

    OutStream.SaveToFile NewFileName, adSaveCreateOverWrite
    OutStream.Close

    If  (1 = HandleErr()) Then
        LogInfo "ExtractBinary(): Tried to extract the binary """ & BinaryKey & """"
    End If
    Set oRec  = Nothing
    Set oView = Nothing
    Set OutStream = Nothing
    If  (1 = HandleErr()) Then
        LogInfo "ExtractBinary(): Failed creating the file """ & NewFileName & """"
    End If
    LogInfo "Successfully created the file """ & NewFileName & """"
    '--- Finished -----------------------------------------------------
    LogInfo "Binary """ & BinaryKey & """ extracted!"
    ExtractBinary = CustomActionSuccess
End Function


Function CleanUp()
    On Error Resume Next
    CleanUp = CustomActionFail 'assume failure

    Dim objFS ,FolderPath, FilePath
    Set objFS = CreateObject("Scripting.FileSystemObject")

    '-- Remove extracted CAB file ----------------
    FilePath = Session.Property("TempFolder") & "ClientSetup.cab"
    If (objFS.FileExists(FilePath)) Then
        objFS.DeleteFile FilePath, true
        If  (1 = HandleErr()) Then
            LogInfo "CleanUp(): Failed deleting the file """ & FilePath & """"
        Else
            LogInfo "Successfully deleted the file """ & FilePath & """"
        End If
    End If

    '-- Remove extract.exe file ----------------
    FilePath = Session.Property("TempFolder") & "extract.exe"
    If (objFS.FileExists(FilePath)) Then
        objFS.DeleteFile FilePath, true
        If  (1 = HandleErr()) Then
            LogInfo "CleanUp(): Failed deleting the file """ & FilePath & """"
        Else
            LogInfo "Successfully deleted the file """ & FilePath & """"
        End If
    End If

'    '-- Remove folder of extracted setup files ----------------
'    FolderPath = Session.Property("TempFolder") & "ClientSetup"
'    If (objFS.FolderExists(FolderPath)) Then
'        objFS.DeleteFolder FolderPath, true
'        If  (1 = HandleErr()) Then
'            LogInfo "CleanUp(): Failed deleting the folder """ & FolderPath & """"
'        Else
'            LogInfo "Successfully deleted the folder """ & FolderPath & """"
'        End If
'    End If

    CleanUp = CustomActionSuccess

End Function

'================================================================
' Execute Quietly a command line passed via property
'================================================================
Function QuietExec()
    On Error Resume Next
    Dim objShell, strCommand, intResult

    QuietExec = CustomActionFail 'assume failure

    strCommand = Session.Property("CommandLine")
    LogInfo "Running: " & strCommand
    Set objShell = CreateObject ("WSCript.shell")
    If (1 = Err.Number <> 0) Then
            HandleErr
        Exit Function
    End If
    intResult = objShell.run(strCommand,7,True)
        If  (1 = HandleErr()) Then
            ReportError "Error Trying To run command: " & strCommand
        Exit Function
    End If
    If (intResult <> 0) Then
        ReportError "Command proccess failed."
        Exit Function
    End If
    QuietExec = CustomActionSuccess
    LogInfo "Command successfully completed."
    Set objShell = Nothing
End Function


'================================================================
' Log and error handling functions
'================================================================

'================================================================
'Write string message to log/window
'================================================================
Function LogInfo(sMsg)
    On Error Resume Next
    Dim sRec
    If MsiMode Then
        Set sRec = Session.Installer.CreateRecord(1)
        sRec.StringData(0) = "CA:   " & sMsg
        LogInfo = Session.Message(&H04000000, sRec)
    Else
        Wscript.Echo sMsg
    End If
End Function

'================================================================
'Check for error condition. Print err info
'================================================================
Function HandleError(bClear)
    On Error Resume Next
    If Err.number = 0 Then
        HandleError = 0
    Else
        HandleError = 1
        LogInfo "Error # " & Hex(Err.Number) & _
                " Description: " & Err.Description & _
                " Source: " & Err.Source
        If bclear Then 'Clear error state in enabled
            Err.Clear
        End If
    End If
End Function

'================================================================
'Check error condition and clear
'================================================================
Function HandleErr()
    HandleErr = HandleError(True)
End Function

'================================================================
'Check error condition and keep unchanged
'================================================================
Function HandleErrUnchanged()
    HandleErrUnchanged = HandleError(False)
End Function
'================================================================
' Write string message to log/window,
' Check error condition and clear
'================================================================
Function ReportError(strMsg)
        ReportError = HandleErr()
        LogInfo strMsg
End Function