Delphi Windows服务设计

1& 3)是的。根据经验，不要实现OnExecute服务事件。从OnStart服务事件中生成自己的线程。当您收到OnStop服务事件时，线程可以被终止。

2)你保持你的线程如此(执行方法)：

while not Terminated do
begin
  // do something
end;

4)通常每个客户端连接都将自己生成线程。 (即TCP服务器为每个客户端生成一个新线程)。使用一个众所周知的堆栈，如Indy或ICS。关于HTTP更新，您可以在生成的客户端连接线程中执行此操作。

5)是的，请注意，您需要提高这样做的权限。

我在职业生涯中已经做了不少服务，到现在为止，我总是使用同样的服务方式的骨架：

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.