我的应用程序进入服务会话（而不是控制台）

Question

我写了一个服务，想从中运行一个应用程序（带有 GUI）。所以我写了一个如下的程序。我的应用程序启动但仍在服务会话中！所以我看不到它的 GUI。
请帮忙。

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;

Answer 1

您需要致电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;

根据Remy的评论和建议

更新

注意：WTSQueryUserToken() 仅当系统帐户中的服务为运行时才有效。

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;

我的应用程序进入服务会话（而不是控制台）

My Application goes to Service Session (instead of console)

delphi

console

service

createprocessasuser