CustomActions
VBS RunAsLoggedOnUser
PSAppDeployToolkit includes the function Execute-ProcessAsUser (line 4649 ff.), which executes a process (.exe) in the user context during or just before the installation (which runs in the system context) starts a process (.exe) in the user context. starts. A scheduler task is created for this purpose. For environments that do not use the PSAppDeployToolkit as an installation wrapper, this CA may be of help.
'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