Windows Installer

CustomActions

VBS RunAsLoggedOnUser


PSAppDeployToolkit beinhaltet die Funktion Execute-ProcessAsUser (Zeile 4649 ff.), die während bzw. kurz vor Abschluss der Installation (die im System Context abläuft) ein Prozess (.exe) im User-Context startet. Hierzu wird ein Scheduler-Task erstellt. Für Umgebungen, die kein PSAppDeployToolkit als Installations-Wrapper verwenden, ist diese CA möglicherweise eine Hilfe.


'ScriptName:    CA_RunAsLoggedOnUser.vbs
'Arguments:     via property table.
'Purpose:       Designed for use as CustomAction within the manufacturer
'               MSI/MST (x64 or x32).
'
'Description:   Create a scheduler task for running executables as user.
'               during the installation (system account).
'
'How to use:    1) import this script into the binary table of the MSI
'                  and give this a name (e.g. VBS_RunAsLoggedOnUser).
'               2) create CustomAction:
'                        Action = CA_RunAsLoggedOnUser
'                        Type = 4166 <-- if x64
'                        Type = 3142 <-- if x32 = deferred CA (CustomActionData)
'                        Type = 70
'                        Source = VBS_RunAsLoggedOnUser
'               3) set InstallExecuteSequence:
'                        Action = CA_RunAsLoggedOnUser
'                        Condition = none
'                        Sequence = must after CostFinalize action (1050)!!
'               4) Set property (table):
'                        SCHEDULERCMD = Path and file name of the executable (e.g. 'C:\Windows\notepad.exe'
'                        SCHEDULERCMDPARAM = Parameter if necessary (doesn't matter if not set).
'                        SCHEDULERNAME = The Name (URI) from the scheduler task.
'               5) Finalize: set four CustomActions:
'                        Action = CA_CreateScheduler
'                        Type = 3170
'                        Source = SystemFolder
'                        Target = schtasks.exe /CREATE /F /TN [SCHEDULERNAME] /XML C:\Windows\Temp\CA_[SCHEDULERNAME].xml
'                        set InstallExecuteSequence:
'                            Action = CA_CreateScheduler
'                            Condition = Not REMOVE
'                            Sequence = must between InstallInitialize and InstallFinalize action ( 1500-6500)!!
'
'                        Action = CA_RunScheduler
'                        Type = 3170
'                        Source = SystemFolder
'                        Target = schtasks.exe /RUN /I /TN [SCHEDULERNAME]
'                        set InstallExecuteSequence:
'                            Action = CA_RunScheduler
'                            Condition = Not REMOVE
'                            Sequence = must between InstallInitialize and InstallFinalize action ( 1500-6500)!!
'
'                        Action = CA_EndScheduler
'                        Type = 3170
'                        Source = SystemFolder
'                        Target = schtasks.exe /END /TN [SCHEDULERNAME]
'                        set InstallExecuteSequence:
'                            Action = CA_EndScheduler
'                            Condition = REMOVE˜="ALL"
'                            Sequence = must between InstallInitialize and InstallFinalize action ( 1500-6500)!!
'
'                        Action = CA_DeleteScheduler
'                        Type = 3170
'                        Source = SystemFolder
'                        Target = schtasks.exe /DELETE /TN [SCHEDULERNAME] /F
'                        set InstallExecuteSequence:
'                            Action = CA_DeleteScheduler
'                            Condition = REMOVE˜="ALL"
'                            Sequence = must between InstallInitialize and InstallFinalize action ( 1500-6500)!!
'
'                6) deferred CA:
'                        Action = CA_RunAsLoggedOnUser_Deferred
'                        Type = 51
'                        Source = CA_RunAsLoggedOnUser
'                        Target = [SCHEDULERCMD];[SCHEDULERCMDPARAM];[SCHEDULERNAME]
'                        set InstallExecuteSequence:
'                            Action = CA_RunAsLoggedOnUser_Deferred
'                            Condition = NOT REMOVE˜="ALL"
'                            Sequence = must before the CA_RunAsLoggedOnUser ( 1500-6500)!!
'
'    Licence :    MIT - and a post card would be fine ;)
'    Status:      complete
'    Author:      Ralf Mühlberg [r.muehlberg@gmx.net]
' ----------------------------------------------------------------------
'

Option Explicit

Public Const ERROR_SUCCESS = 0
Public Const ERROR_FAILED = 1
Public Const msiMessageTypeInfo = &H04000000

Public Const HKEY_LOCAL_MACHINE = &h80000002
Public Const HKEY_USERS = &H80000003

Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2

Public Const KEY_QUERY_VALUE = &H0001
Public Const KEY_SET_VALUE = &H0002

Public Const ForReading = 1
Public Const ForWriting = 2
Public Const TristateUseDefault = -2
Public Const OverwriteExisting = True

Dim objFSO, objXMLFile, classDomainUser
Dim strCmdline, strCmdlineParam, strURI
Dim objArgs, ArrArgs, strDelim

Set classDomainUser = New EnumDomainUser

WriteLog " *** ----------- *** :: ......................................................."
WriteLog " *** Information *** :: Execute CustomAction 'RunAsLoggedOnUser' (VBScript) ..."
WriteLog " *** ----------- *** :: ......................................................."
WriteLog ""

GetCurrentLoggedOnUser
If classDomainUser.cSID <> "" Then
    ' well done
Else
    WriteLog " *** Information *** :: Unable to received the information about the current LoggedOn user."
    GetLastLoggedOnUser
    If classDomainUser.cSID <> "" Then
        ' well done
    Else
        WriteLog " !!! FAILED !!! :: Unable to received the information about the last LoggedOn user."
        WriteLog " !!! FAILED !!! :: CustomAction 'CA_RunAsLoggedOnUser' FAILED !!!"
        WriteLog ""
    End If
End If

If classDomainUser.cSID <> "" Then
    WriteLog " *** Information *** ::            DomainUser = " & classDomainUser.cDomainUser
    WriteLog " *** Information *** :: DomainUserProfilePath = " & classDomainUser.cDomainUserProfilePath
    WriteLog " *** Information *** ::         DomainUserSID = " & classDomainUser.cSID
    WriteLog ""
End If

Set classDomainUser = Nothing

objArgs = Session.Property("CustomActionData")
If objArgs <> "" Then
    strDelim = ";"
    ArrArgs = Split(objArgs, strDelim)
         strCmdline = ArrArgs(0)
    strCmdlineParam = ArrArgs(1)
             strURI = ArrArgs(2)
End If

If strCmdline <> "" AND strURI <> "" Then 
    ReturnToSender = WriteSchedulerXML(strCmdline, strCmdlineParam, strURI)
    If ReturnToSender <> 0 Then
        WriteLog " !!! FAILED !!! :: could not create the XML file for the scheduler task. Failed with ErrorCode " & ReturnToSender
        WriteLog ""
    Else
        WriteLog " *** Information *** :: the XML file for the scheduler task was created successfully."
        WriteLog " *** Information *** :: about the scheduler task ::"
        WriteLog " *** Information *** :: Command Line = " & strCmdline
        WriteLog " *** Information *** ::    Parameter = " & strCmdlineParam
        WriteLog " *** Information *** ::          URI = " & strURI
        WriteLog ""
    End If
Else
        WriteLog " !!! FAILED !!! :: could not create the XML file for the scheduler task. Missing commandline and / or URI !!!"
        WriteLog ""
End If
' --------------------------------------------

Public Function WriteSchedulerXML(strCmdline, strCmdlineParam, strURI)
Dim objFSO, objXMLFile

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objXMLFile = objFSO.CreateTextFile("C:\Windows\Temp\CA_" & strURI & ".xml", True)
    objXMLFile.WriteLine("<?xml version=" & Chr(34) & "1.0" & Chr(34) & _
                         " encoding=" & Chr(34) & "UTF-16" & Chr(34) & "?>")
    objXMLFile.WriteLine("<Task version=" & Chr(34) & "1.2" & Chr(34) &  _
                         " xmlns=" & Chr(34) & "http://schemas.microsoft.com/windows/2004/02/mit/task" & Chr(34) & ">")
    objXMLFile.WriteLine("  <RegistrationInfo>")
    objXMLFile.WriteLine("    <Date>2019-05-05T12:00:00</Date>")
    objXMLFile.WriteLine("    <Author>" & classDomainUser.cDomain & "\" & classDomainUser.cDomainUser & "</Author>")
    objXMLFile.WriteLine("    <URI>" & strURI & "</URI>")
    objXMLFile.WriteLine("  </RegistrationInfo>")
    objXMLFile.WriteLine("  <Triggers>")
    objXMLFile.WriteLine("    <TimeTrigger>")
    objXMLFile.WriteLine("      <StartBoundary>2019-05-05T12:00:00+01:00</StartBoundary>")
    objXMLFile.WriteLine("      <EndBoundary>2021-05-05T12:00:00+01:00</EndBoundary>")
    objXMLFile.WriteLine("      <Enabled>true</Enabled>")
    objXMLFile.WriteLine("    </TimeTrigger>")
    objXMLFile.WriteLine("  </Triggers>")
    objXMLFile.WriteLine("  <Principals>")
    objXMLFile.WriteLine("    <Principal id=" & Chr(34) & "Author" & Chr(34) & ">")
    objXMLFile.WriteLine("      <UserId>" & classDomainUser.cDomain & "\" & classDomainUser.cDomainUser & "</UserId>")
    objXMLFile.WriteLine("      <LogonType>InteractiveToken</LogonType>")
    objXMLFile.WriteLine("      <RunLevel>LeastPrivilege</RunLevel>")
    objXMLFile.WriteLine("    </Principal>")
    objXMLFile.WriteLine("  </Principals>")
    objXMLFile.WriteLine("  <Settings>")
    objXMLFile.WriteLine("    <MultipleInstancesPolicy>IgnoreNew</MultipleInstancesPolicy>")
    objXMLFile.WriteLine("    <DisallowStartIfOnBatteries>false</DisallowStartIfOnBatteries>")
    objXMLFile.WriteLine("    <StopIfGoingOnBatteries>false</StopIfGoingOnBatteries>")
    objXMLFile.WriteLine("    <AllowHardTerminate>true</AllowHardTerminate>")
    objXMLFile.WriteLine("    <StartWhenAvailable>false</StartWhenAvailable>")
    objXMLFile.WriteLine("    <RunOnlyIfNetworkAvailable>false</RunOnlyIfNetworkAvailable>")
    objXMLFile.WriteLine("    <IdleSettings>")
    objXMLFile.WriteLine("      <StopOnIdleEnd>false</StopOnIdleEnd>")
    objXMLFile.WriteLine("      <RestartOnIdle>false</RestartOnIdle>")
    objXMLFile.WriteLine("    </IdleSettings>")
    objXMLFile.WriteLine("    <AllowStartOnDemand>true</AllowStartOnDemand>")
    objXMLFile.WriteLine("    <Enabled>true</Enabled>")
    objXMLFile.WriteLine("    <Hidden>false</Hidden>")
    objXMLFile.WriteLine("    <RunOnlyIfIdle>false</RunOnlyIfIdle>")
    objXMLFile.WriteLine("    <WakeToRun>false</WakeToRun>")
    objXMLFile.WriteLine("    <ExecutionTimeLimit>PT72H</ExecutionTimeLimit>")
    objXMLFile.WriteLine("    <Priority>7</Priority>")
    objXMLFile.WriteLine("    <RestartOnFailure>")
    objXMLFile.WriteLine("      <Interval>PT5M</Interval>")
    objXMLFile.WriteLine("      <Count>3</Count>")
    objXMLFile.WriteLine("    </RestartOnFailure>")
    objXMLFile.WriteLine("  </Settings>")
    objXMLFile.WriteLine("  <Actions Context=" & Chr(34) & "Author" & Chr(34) & ">")
    objXMLFile.WriteLine("    <Exec>")
    objXMLFile.WriteLine("      <Command>" & strCmdline & "</Command>")
    objXMLFile.WriteLine("        <Arguments>" & strCmdlineParam & "</Arguments>")
    objXMLFile.WriteLine("    </Exec>")
    objXMLFile.WriteLine("  </Actions>")
    objXMLFile.WriteLine("</Task>")
objXMLFile.Close

Set objXMLFile = Nothing
Set objFSO = Nothing

End Function
' --------------------------------------------

Public Function GetCurrentLoggedOnUser()
Dim objReg, strComputer, strKeyPath, arrSubKeys, subkey
Dim UserSID, bHasAccessRight, ergUserDomain, ergUserName, ergUserProfile, strCurrentLoggedOnUser

strComputer = "."
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
strCurrentLoggedOnUser = ERROR_FAILED

Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
    objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
 
    For Each subkey In arrSubKeys
        If Len(subkey) > 10 Then
            objReg.CheckAccess HKEY_USERS, subkey, KEY_QUERY_VALUE, bHasAccessRight
            If bHasAccessRight = True Then
                objReg.CheckAccess HKEY_USERS, subkey, KEY_SET_VALUE, bHasAccessRight
                If bHasAccessRight = True Then
                    UserSID = subkey
                    
                    objReg.GetStringValue HKEY_USERS, UserSID & "\Volatile Environment", "USERDOMAIN", ergUserDomain
                    objReg.GetStringValue HKEY_USERS, UserSID & "\Volatile Environment", "USERNAME", ergUserName
                    objReg.GetStringValue HKEY_USERS, UserSID & "\Volatile Environment", "USERPROFILE", ergUserProfile
                    
                    classDomainUser.cDomain = ergUserDomain
                    classDomainUser.cDomainUser = ergUserName
                    classDomainUser.cDomainUserProfilePath = ergUserProfile
                    classDomainUser.cSID = UserSID
                    
                    strCurrentLoggedOnUser = classDomainUser.cDomain & "\" & classDomainUser.cDomainUser
                    Exit For
                Else
                    strCurrentLoggedOnUser = ERROR_FAILED
                End If
            End If
        End If
    Next
GetCurrentLoggedOnUser = strCurrentLoggedOnUser
Set objReg = Nothing

End Function
' --------------------------------------------

Public Function GetLastLoggedOnUser()
Dim objReg, strComputer, HKLM64_KeyPath, HKLM32_KeyPath, ReturnToSender, arrToParse, strValue, strLastLoggedOnUser

strComputer = "."
HKLM64_KeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
HKLM32_KeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strLastLoggedOnUser = ERROR_FAILED

Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
ReturnToSender = objReg.GetStringValue(HKEY_LOCAL_MACHINE, HKLM64_KeyPath, "LastLoggedOnUser", strValue)
If ReturnToSender <> 0 Then
    ReturnToSender = objReg.GetStringValue(HKEY_LOCAL_MACHINE, HKLM32_KeyPath, "LastLoggedOnUser", strValue)
    If ReturnToSender <> 0 Then
        strLastLoggedOnUser = ERROR_FAILED
    Else
        strLastLoggedOnUser = strValue
        ReturnToSender = objReg.GetStringValue(HKEY_LOCAL_MACHINE, HKLM32_KeyPath, "LastLoggedOnUserSID", strValue)
        classDomainUser.cSID = strValue
    End If
Else
    strLastLoggedOnUser = strValue
    ReturnToSender = objReg.GetStringValue(HKEY_LOCAL_MACHINE, HKLM64_KeyPath, "LastLoggedOnUserSID", strValue)
    classDomainUser.cSID = strValue
End If

If InStr(strLastLoggedOnUser, "\") Then
    arrToParse = split(strLastLoggedOnUser, "\", -1, vbTextCompare)
    classDomainUser.cDomain = arrToParse(0)
    classDomainUser.cDomainUser = arrToParse(1)
End If
GetLastLoggedOnUser = strLastLoggedOnUser
Set objReg = Nothing

End Function
' --------------------------------------------

Public Function WriteLog(strMessage)
Dim MsgRec

Set MsgRec = Session.Installer.CreateRecord(1)

MsgRec.StringData(0) = "VBS_CA LOG (CA_RunAsLoggedOnUser): " & Time & "[1] "
MsgRec.StringData(1) = "  " & strMessage

Session.Message msiMessageTypeInfo, MsgRec

End Function
' --------------------------------------------

Class EnumDomainUser
Private mSID, mDomain, mDomainUser, mDomainUserProfilePath

    Public Property Get cSID
        cSID = mSID
    End Property
    Public Property Let cSID(strSID)
        mSID = strSID
    End Property
    Public Property Get cDomain
        cDomain = mDomain
    End Property
    Public Property Let cDomain(strDomain)
        mDomain = strDomain
    End Property
    Public Property Get cDomainUser
        cDomainUser = mDomainUser
    End Property
    Public Property Let cDomainUser(strDomainUser)
        mDomainUser = strDomainUser
    End Property
    Public Property Get cDomainUserProfilePath
        cDomainUserProfilePath = mDomainUserProfilePath
    End Property
    Public Property Let cDomainUserProfilePath(strDomainUserProfilePath)
        mDomainUserProfilePath = strDomainUserProfilePath
    End Property

End Class