1
votes

I am familiar with debugging windows services written in Delphi by using the Attach Process feature. This works very well if the service runs on the same server as the Delphi IDE.

But when it comes to remote debug the service (i.e. it is running on a remote server) it no longer works: the Attach Process doesn't display the service process at all. I thought at first it was a privilege issue but since I can see other user processes but no service process, I believe it isn't.

I noticed that if I run the service in installation mode (e.g. /install) it will show up in the list of processes and I can even debug it. But if it runs as a regular Windows service from the SCM I can't.

Is this a known limitation or something wrong with the remote debug setup? If it's a limitation, is there a practical workaround?

1
Are you running the Remote Debugger as an admin on the remote machine? - Remy Lebeau
It's often shrewd to allow your service to run alternatively as a UI free desktop process to make debugging easier. Obviously that's not useful if you need to debug aspects that only show up running as a session 0 service. - David Heffernan
The remote debugger runs with admin privileges and can see other user processes but not service processes. - AlainB
I've seen suggestions about using compiler directives (e.g. $IFDEF DEBUG) to build a console application / desktop application instead of a service application for debugging purposes. But in this case, I'm not testing the exact same application that is running in real life, hence might not reproduce the same issues. I believe I'm rephrasing what David meant. - AlainB

1 Answers

0
votes

Faced the same problem.

I wrote a service that runs PAServer on behalf of LOCAL_SYSTEM. Immediately in the IDE appeared all the processes.

unit UrsPASImpl;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Vcl.SvcMgr;

type
  TPAServerLauncher = class(TService)
    procedure ServiceStart(Sender: TService; var AStarted: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    FProcHandle: THandle;
    FInWritePipe: THandle;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  PAServerLauncher: TPAServerLauncher;

implementation

uses
  Winapi.Windows,
  System.SysUtils;

{$R *.dfm}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  PAServerLauncher.Controller(CtrlCode);
end;

function TPAServerLauncher.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TPAServerLauncher.ServiceStart(Sender: TService;
  var AStarted: Boolean);
var
  LBasePath: string;
  LProcName: string;
  LInReadPipe: THandle;
  LSecAttr: TSecurityAttributes;
  LStartup: TStartupInfo;
  LProcInfo: TProcessInformation;
begin
  try
    LBasePath := ExtractFilePath(GetModuleName(HInstance));
    LProcName := LBasePath + 'PAServer.exe';

    LSecAttr.nLength := SizeOf(LSecAttr);
    LSecAttr.lpSecurityDescriptor := nil;
    LSecAttr.bInheritHandle := True;

    Win32Check(CreatePipe(LInReadPipe, FInWritePipe, @LSecAttr, 0));
    try
      Win32Check(SetHandleInformation(FInWritePipe, HANDLE_FLAG_INHERIT, 0));

      FillChar(LStartup, SizeOf(LStartup), 0);
      LStartup.cb := SizeOf(LStartup);
      LStartup.dwFlags := STARTF_USESTDHANDLES;
      LStartup.hStdInput := LInReadPipe;

      Win32Check(CreateProcess(
        PChar(LProcName),
        PChar(Format('"%s"', [LProcName])),
        nil,
        nil,
        True,
        0,
        nil,
        PChar(LBasePath),
        LStartup,
        LProcInfo
      ));
    finally
      CloseHandle(LInReadPipe);
    end;
    CloseHandle(LProcInfo.hThread);

    FProcHandle := LProcInfo.hProcess;
    AStarted := True;
  except
    on E: Exception do begin
      LogMessage(E.Message);
      AStarted := False;
      if FInWritePipe <> 0 then begin
        CloseHandle(FInWritePipe);
        FInWritePipe := 0;
      end;
    end;
  end;
end;

procedure TPAServerLauncher.ServiceStop(Sender: TService; var Stopped: Boolean);
const
  CExit: AnsiString = 'q' + sLineBreak;
var
  LWriteCnt: Cardinal;
begin
  if WaitForSingleObject(FProcHandle, 0) = WAIT_TIMEOUT then begin
    Win32Check(WriteFile(FInWritePipe, CExit[1], Length(CExit), LWriteCnt, nil));
    WaitForSingleObject(FProcHandle, INFINITE);
  end;
  CloseHandle(FProcHandle);
  CloseHandle(FInWritePipe);
end;

end.

GitHub project https://github.com/anton-shchyrov/PAServerLauncher