如何使用Delphi 10.2远程调试Windows服务

Question

我熟悉使用Attach Process功能调试用Delphi编写的Windows服务。如果服务在与Delphi IDE相同的服务器上运行，这非常有效。

但是当涉及远程调试服务（即它在远程服务器上运行）时，它不再起作用：Attach Process根本不显示服务进程。我一开始认为这是一个特权问题，但由于我可以看到其他用户进程但没有服务进程，我相信它不是。

我注意到，如果我在安装模式下运行服务（例如/ install），它将显示在进程列表中，我甚至可以调试它。但如果它作为SCM的常规Windows服务运行我不能。

这是远程调试设置的已知限制或错误吗？如果这是一个限制，是否有实用的解决方法？

Answer 1

面临同样的问题。

我写了一个代表LOCAL_SYSTEM运行PAServer的服务。立即在IDE中出现了所有进程。

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项目https://github.com/anton-shchyrov/PAServerLauncher