Delphi Tokyo Service createprocess only at boot

Question

I have a service script for Windows in Delphi Tokyo. The service starts at system startup and creates the process x correctly. Start a timer that cyclically checks if the process is started or not and if it is not, it tries to start it but fails with error code 1008.

function TMyservice.CreaProcessoComeUtenteX(const FileName, Params: string;
  WindowState: Word): Boolean;
var
  SessionID: DWORD;
  UserToken: THandle;
  CmdLine: PChar;
  si: _STARTUPINFOW;
  pi: _PROCESS_INFORMATION;
  ExitCode: Cardinal;
begin
  SessionId:= WtsGetActiveConsoleSessionID;
  if SessionID = $FFFFFFFF then
  begin
    ADDLOG('Exit from CreaProcessoComeUtenteX '+IntToStr(SessionID));
    Result := false;
    Exit;
  end;
  if WTSQueryUserToken(SessionID, UserToken) then
  begin    
    CmdLine:= PWideChar(FileName+Params);
    ZeroMemory(@si, SizeOf(si));
    si.cb := SizeOf(si);
    SI.lpDesktop := PChar('winsta0\Default');
    SI.dwFlags := STARTF_USESHOWWINDOW;
    if WindowState = 1 then
      SI.wShowWindow := SW_SHOWNORMAL;
    if WindowState = 0 then
      SI.wShowWindow := SW_MINIMIZE;
    ZeroMemory(@pi, SizeOf(pi));
    try

      CreateProcessAsUser(UserToken, nil, CmdLine, nil, nil, False,
      0, nil, nil, si, pi);

      ADDLOG(' Create process Ok');
      result := true;
    except on E: Exception do
      begin
        // Log exception ...
        result := false;
        ADDLOG('Err proc: '+ E.Message);
      end;
    end;
    CloseHandle(UserToken);
  end else
  begin
    // Log GetLastError ...
    Result := false;
    ADDLOG('QToken: '+IntToStr(GetLastError));
  end;
end;

This code impersonate current user

function TInfBabeleDS.ConnectAs(const lpszUsername,
  lpszPassword: string): Boolean;
var
  hToken       : THandle;
begin
  Result := LogonUser(PChar(lpszUsername), nil, PChar(lpszPassword), LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hToken);
  if Result then
    Result := ImpersonateLoggedOnUser(hToken)
  else
  RaiseLastOSError;
end;

Remy Lebeau · Accepted Answer · 2019-06-22T21:43:41.497

0

Error code 1008 is ERROR_NO_TOKEN, which means WTSQueryUserToken() was called on a session ID that has no user logged in.

WTSGetActiveConsoleSessionID() is not always the best session to use, especially at system startup, if your service tries to start the process before any users have logged in yet. The session ID that is attached to the local physical monitor/keyboard/mouse is not guaranteed to have a user logged in at any given time, if ever.

In cases like this, use WTSEnumerateSessions() instead to find sessions that actually have a user logged in.

Also, you are not doing any error handling on CreateProcessAsUser(). It does not raise an exception on error, like your code is expecting. Your try..except is useless.

edited Jun 22 '19 at 21:43

answered Jun 22 '19 at 21:37

Remy Lebeau

555,201
31
458
770

I tried to impersonate the user but instead of error 1008 it returned error 5 access denied. I add the code used to the question. But how would you rewrite the function to start a process? – Daniele Jun 23 '19 at 06:34
@Daniele this is not an impersonation issue, so get rid of that code (it is flawed, anyway). Did you even try the `WTSEnumerateSessions()` suggestion I gave? – Remy Lebeau Jun 23 '19 at 07:48
The strange thing is that without impersonation it now works again and without using the suggested function which I have not studied how to implement. But I guess your suggestion works so I accept the answer. – Daniele Jun 24 '19 at 06:27

Delphi Tokyo Service createprocess only at boot

1 Answers1