StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>Whilst you can debug a Delphi service there are a number of hoops that you need to jump through to make it work. I never bother and simply ensure that my services can run either as a service or as a standard app. When I want to debug I run as a standard app and so sidestep all the headaches.</p> <p>I've hacked out all the code into a single file for the purpose of this answer, but you'd want to structure it a bit differently.</p> <pre><code>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. </code></pre> <p>To use this you need to create a new class, inherited from <code>TMyService</code>, and implement <code>Initialise</code> and <code>CreateRunner</code>. <code>CreateRunner</code> is the key. In my services this creates an object which in turn opens a listening socket ready for clients to communicate over.</p> <p>The standard app code is pretty basic. It doesn't even have a mechanism to terminate—it runs inside a <code>while True</code> loop. That doesn't matter for my debugging needs.</p>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload