delphiserviceconsolecreateprocessasuser

My Application goes to Service Session (instead of console)


I write a service and want to run an application (with GUI) from it. So I write a procedure like below. my application start but still in service session! and so i can't see it's GUI.
Any help please.

Procedure RunAppFromService(Path, FileName: string);
var
  zPath          : array[0..512] of char;
  zAppName          : array[0..512] of char;
  StartupInfo       : TStartupInfo;
  ProcessInfo       : TProcessInformation;
begin { WinExecAndWait32V2 }
  StrPCopy(zPath, Path);
  StrPCopy(zAppName, FileName);

  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.lpDesktop := PChar('winsta0\Default');
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;

  FillChar(ProcessInfo, Sizeof(ProcessInfo), #0);

  CreateProcessAsUser(0, nil,
    zAppName, { pointer to command line string }
    nil, { pointer to process security attributes }
    nil, { pointer to thread security attributes }
    false, { handle inheritance flag }
    CREATE_NEW_CONSOLE or { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil, { pointer to new environment block }
    zPath, { pointer to current directory name }
    StartupInfo, { pointer to STARTUPINFO }
    ProcessInfo); { pointer to PROCESS_INF }
end;

Solution

  • You need to call WTSQueryUserToken with WtsGetActiveConsoleSessionID to get the current active user token then pass it to CreateEnvironmentBlock and CreateProcessAsUserW.

    function WTSQueryUserToken(SessionId: ULONG; var phToken: THandle): BOOL; stdcall; external 'Wtsapi32.dll';
    function CreateEnvironmentBlock(var lpEnvironment: Pointer;
      hToken: THandle;
      bInherit: BOOL): BOOL;
        stdcall; external 'Userenv.dll';
    function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall; external 'Userenv.dll';
    
    function RunAppFromService(const Path, FileName: string): Boolean;
    var
      zPath          : array[0..512] of char;
      zAppName          : array[0..512] of char;
      StartupInfo       : TStartupInfo;
      ProcessInfo       : TProcessInformation;
      hUserToken        : THandle;
      p                 : Pointer;
    begin { WinExecAndWait32V2 }
      Result := False;
      StrPCopy(zPath, Path);
      StrPCopy(zAppName, FileName);
    
      if NOT WTSQueryUserToken(WtsGetActiveConsoleSessionID, hUserToken) then exit;
    
      if CreateEnvironmentBlock(P, hUserToken, True) then
      begin
          ZeroMemory(@StartupInfo, sizeof(StartupInfo));
          StartupInfo.lpDesktop   := ('winsta0\default');
          StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
          StartupInfo.wShowWindow := Visibility;
          if CreateProcessAsUserW(
                hUserToken,
                nil,
                zAppName,
                nil,
                nil,
                False,
                CREATE_UNICODE_ENVIRONMENT,
                P,
                zPath,
                StartupInfo,
                ProcessInfo) then
          begin
            Result := True;
          end;
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
          DestroyEnvironmentBlock(P);
      end;
      if hUserToken <> INVALID_HANDLE_VALUE then
        CloseHandle(hUserToken);
    end;
    

    Update as per Remy's comment and advice

    Note : WTSQueryUserToken() only works if the service is running in the SYSTEM account.

    type
      WTS_INFO_CLASS = (
        WTSInitialProgram,
        WTSApplicationName,
        WTSWorkingDirectory,
        WTSOEMId,
        WTSSessionId,
        WTSUserName,
        WTSWinStationName,
        WTSDomainName,
        WTSConnectState,
        WTSClientBuildNumber,
        WTSClientName,
        WTSClientDirectory,
        WTSClientProductId,
        WTSClientHardwareId,
        WTSClientAddress,
        WTSClientDisplay,
        WTSClientProtocolType,
        WTSIdleTime,
        WTSLogonTime,
        WTSIncomingBytes,
        WTSOutgoingBytes,
        WTSIncomingFrames,
        WTSOutgoingFrames,
        WTSClientInfo,
        WTSSessionInfo,
        WTSSessionInfoEx,
        WTSConfigInfo,
        WTSValidationInfo,
        WTSSessionAddressV4,
        WTSIsRemoteSession
      );
      WTS_CONNECTSTATE_CLASS = (
        WTSActive,
        WTSConnected,
        WTSConnectQuery,
        WTSShadow,
        WTSDisconnected,
        WTSIdle,
        WTSListen,
        WTSReset,
        WTSDown,
        WTSInit
      );
    
      PWTS_SESSION_INFO = ^WTS_SESSION_INFO;
      WTS_SESSION_INFO = record
        SessionId: DWORD;
        pWinStationName: LPTSTR;
        State: WTS_CONNECTSTATE_CLASS;
      end;
    
    ........
    
    function WTSEnumerateSessions(hServer: THandle; Reserved: DWORD; Version: DWORD; var ppSessionInfo: PWTS_SESSION_INFO; var pCount: DWORD): BOOL; stdcall; external 'Wtsapi32.dll' name {$IFDEF UNICODE}'WTSEnumerateSessionsW'{$ELSE}'WTSEnumerateSessionsA'{$ENDIF};
    
    procedure WTSFreeMemory(pMemory: Pointer); stdcall; external 'Wtsapi32.dll';
    
    function WTSQueryUserToken(SessionId: ULONG; var phToken: THandle): BOOL; stdcall; external 'Wtsapi32.dll';
    
    function CreateEnvironmentBlock(var lpEnvironment: Pointer;
                                      hToken: THandle;
                                      bInherit: BOOL): BOOL;
                                      stdcall; external 'Userenv.dll';
    
    function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall; external 'Userenv.dll';
    
    function RunAppFromService(const Path, FileName: string): Boolean;
    const
      WTS_CURRENT_SERVER_HANDLE: THandle = 0;
    var
      zPath             : array[0..512] of char;
      zAppName          : array[0..512] of char;
      StartupInfo       : TStartupInfo;
      ProcessInfo       : TProcessInformation;
      hUserToken        : THandle;
      p                 : Pointer;
      Sessions, Session : PWTS_SESSION_INFO;
      NumSessions       : DWORD;
      I                 : Integer;
    begin { WinExecAndWait32V2 }
      Result := False;
      StrPCopy(zPath, Path);
      StrPCopy(zAppName, FileName);
      if not WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, 0, 1, Sessions, NumSessions) then
        exit;;
      try
        if NumSessions > 0 then
        begin
          Session := Sessions;
          for I := 0 to NumSessions-1 do
          begin
            if Session.State = WTSActive then
            begin
              if WTSQueryUserToken(Session.SessionId, hUserToken) then begin
                  if CreateEnvironmentBlock(P, hUserToken, True) then
                  begin
                      ZeroMemory(@StartupInfo, sizeof(StartupInfo));
                      StartupInfo.lpDesktop   := ('winsta0\default');
                      StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
                      StartupInfo.wShowWindow := Visibility;
                      if CreateProcessAsUserW(
                            hUserToken,
                            nil,
                            zAppName,
                            nil,
                            nil,
                            False,
                            CREATE_UNICODE_ENVIRONMENT,
                            P,
                            zPath,
                            StartupInfo,
                            ProcessInfo) then
                      begin
                        Result := True;
                      end;
                      CloseHandle(ProcessInfo.hProcess);
                      CloseHandle(ProcessInfo.hThread);
                      DestroyEnvironmentBlock(P);
                  end;
                  if hUserToken <> INVALID_HANDLE_VALUE then
                    CloseHandle(hUserToken);
              end;
            end;
            Inc(Session);
          end;
        end;
      finally
        WTSFreeMemory(Sessions);
      end;
    end;