Несмотря на то, что вы можете отлаживать службу Delphi, есть несколько обручей, через которые вам нужно перейти, чтобы она заработала.Я никогда не беспокоюсь и просто гарантирую, что мои сервисы могут работать как сервис или как стандартное приложение.Когда я хочу отладить, я запускаю как стандартное приложение и, таким образом, избегаю всех головных болей.
Я взломал весь код в один файл для целей этого ответа, но вы хотели бы структурироватьэто немного по-другому.
program MyService;
uses
SysUtils, Classes, Windows, Forms, SvcMgr;
type
TMyService = class(TService)
private
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
protected
FDescription: string;
FEventLogSourceName: string;
procedure Initialise; virtual; abstract;
class function CreateRunner: TObject; virtual; abstract;
public
constructor Create(AOwner: TComponent); override;
function GetServiceController: TServiceController; override;
end;
TMyServiceClass = class of TMyService;
{ TMyService }
constructor TMyService.Create(AOwner: TComponent);
begin
inherited;
Initialise;
OnStart := ServiceStart;
OnStop := ServiceStop;
OnPause := ServicePause;
OnExecute := ServiceExecute;
OnContinue := ServiceContinue;
end;
procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
begin
Started := True;
end;
procedure TMyService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Stopped := True;
end;
procedure TMyService.ServiceContinue(Sender: TService; var Continued: Boolean);
begin
ServiceStart(Sender, Continued);
end;
procedure TMyService.ServicePause(Sender: TService; var Paused: Boolean);
begin
ServiceStop(Sender, Paused);
end;
procedure TMyService.ServiceExecute(Sender: TService);
var
Runner: TObject;
begin
Runner := CreateRunner;
Try
while not Terminated do begin
ServiceThread.ProcessRequests(True);
end;
Finally
FreeAndNil(Runner);
End;
end;
var
Service: TMyService;
procedure ServiceController(CtrlCode: DWORD); stdcall;
begin
Service.Controller(CtrlCode);
end;
function TMyService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure RunAsService(ServiceClass: TMyServiceClass; var Service);
var
Application: TServiceApplication;
begin
Application := SvcMgr.Application;
Application.Initialize;
Application.CreateForm(ServiceClass, Service);
Application.Run;
end;
procedure RunAsStandardExecutable(ServiceClass: TMyServiceClass);
var
Application: TApplication;
Runner: TObject;
begin
Application := Forms.Application;
Application.Initialize;
Runner := ServiceClass.CreateRunner;
Try
while True do begin
Try
Application.HandleMessage;
Except
Application.HandleException(Application);
End;
end;
Finally
FreeAndNil(Runner);
End;
end;
procedure ServiceMain(ServiceClass: TMyServiceClass);
begin
if FindCmdLineSwitch('RunAsApp', ['-', '/'], True) then begin
RunAsStandardExecutable(ServiceClass);
end else begin
RunAsService(ServiceClass, Service);
end;
end;
begin
ServiceMain(TMyService);
end.
Чтобы использовать это, вам нужно создать новый класс, унаследованный от TMyService
, и реализовать Initialise
и CreateRunner
.CreateRunner
является ключом.В моих службах это создает объект, который, в свою очередь, открывает прослушивающий сокет, готовый для обмена данными между клиентами.
Стандартный код приложения довольно прост.У него даже нет механизма завершения - он работает внутри цикла while True
.Это не имеет значения для моих потребностей в отладке.