My Application goes to Service Session (instead of console) - delphi

Question

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;

Answer 1

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;