Delphi Windows Service Design

Question

Delphi Windows Service Design

I\'ve never created a windows service but have been reading everything I\'ve found. All the articles or examples I\'ve run across are v

Answer 1

fast answers:

1&3) Yes. As a rule of thumb do not implement the OnExecute service event. Spawn your own thread from the OnStart service event. The thread can be terminated when you receive the OnStop service event.

2) you keep your thread alive like this (execute method):

while not Terminated do
begin
  // do something
end;

4) normally each client connection will live on it's own thread. (ie the TCP server spawns a new thread for each client). Use a well known stack like Indy or ICS. Concerning the HTTP update, you can do this in the spawned client connection thread.

5) yes, be aware that you need elevated rights to do this.

I have made quite a few services in my career and I always use the same skeleton for the service application up till now:

unit u_svc_main;

interface

uses
  // Own units
  u_globals, u_eventlog, u_MyThread, 
  // Third party units
  // Delphi units
  Windows, Messages, Registry, SysUtils, Classes, SvcMgr;

type
  TMyService = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceAfterUninstall(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
    MyThread : TMyThread;
  public
    { Public declarations }
    function GetServiceController: TServiceController; override;
  end;

var MyService : TMyService;

implementation

{$R *.DFM}

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

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

procedure TMyService.ServiceCreate(Sender: TObject);
begin
  DisplayName := 'myservice';
end;

procedure TMyService.ServiceAfterInstall(Sender: TService);
var
  Reg        : TRegistry;
  ImagePath  : string;
begin
  // create needed registry entries after service installation
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    // set service description
    if Reg.OpenKey(STR_REGKEY_SVC,False) then
    begin
      ImagePath := Reg.ReadString(STR_REGVAL_IMAGEPATH);
      Reg.WriteString(STR_REGVAL_DESCRIPTION, STR_INFO_SVC_DESC);
      Reg.CloseKey;
    end;
    // set message resource for eventlog
    if Reg.OpenKey(STR_REGKEY_EVENTMSG, True) then
    begin
      Reg.WriteString(STR_REGVAL_EVENTMESSAGEFILE, ImagePath);
      Reg.WriteInteger(STR_REGVAL_TYPESSUPPORTED, 7);
      Reg.CloseKey;
    end;
    // set installdir
    if ImagePath <> '' then
      if Reg.OpenKey(STR_REGKEY_FULL,True) then
      begin
        Reg.WriteString(STR_REGVAL_INSTALLDIR, ExtractFilePath(ImagePath));
        Reg.CloseKey;
      end;
  finally
    FreeAndNil(Reg);
  end;
end;

procedure TMyService.ServiceAfterUninstall(Sender: TService);
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    // delete self created registry keys
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.DeleteKey(STR_REGKEY_EVENTMSG);
  finally
    FreeAndNil(Reg);
  end;
end;

procedure TMyService.ServiceShutdown(Sender: TService);
var
  Stopped : boolean;
begin
  // is called when windows shuts down
  ServiceStop(Self, Stopped);
end;

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := False;
  try
    MyThread := TMyThread.Create;
    MyThread.Resume;
    NTEventLog.Add(Eventlog_Success, STR_INFO_SVC_STARTED);
    Started := True;
  except
    on E : Exception do
    begin
      // add event in eventlog with reason why the service couldn't start
      NTEventLog.Add(Eventlog_Error_Type, Format(STR_INFO_SVC_STARTFAIL, [E.Message]));
    end;
  end;
end;

procedure TMyService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  try
    Stopped := True; // always stop service, even if we had exceptions, this is to prevent "stuck" service (must reboot then)
    MyThread.Terminate;
    // give MyThread 60 seconds to terminate
    if WaitForSingleObject(MyThread.ThreadEvent, 60000) = WAIT_OBJECT_0 then
    begin
      FreeAndNil(MyThread);
      NTEventLog.Add(Eventlog_Success,STR_INFO_SVC_STOPPED);
    end;
  except
    on E : Exception do
    begin
      // add event in eventlog with reason why the service couldn't stop
      NTEventLog.Add(Eventlog_Error_Type, Format(STR_INFO_SVC_STOPFAIL, [E.Message]));
    end;
  end;
end;

end.