Question

我运行一项简单的服务。我可以启动它并使用SCM停止它。我还需要服务在条件成立时自行停止。

问题1 ：使用SCM时服务停止。我点击＆＃34;停止服务＆＃34;，服务几乎立即停止。但是我注意到exe停止在windows任务列表中大约10秒钟。这是正常行为吗？

问题2 ：我通过在下面的代码示例中递增变量来模拟我需要服务来停止自身的情况。在这种情况下，服务永远不会停止。我必须杀死Windows任务管理器中的任务才能阻止它。

我尝试了几件事没有成功。

当我使用SCM停止服务时，ServiceStop调用线程Kill方法，因此线程停止并且服务可以轻轻停止。

当服务想要自行停止时，将从线程本身内测试条件。线程停止，但不是服务。所以我想我必须打电话给DoShutDown告诉它必须停止的服务。但它并没有停止。无论是否有DoShutDown调用，服务都会继续。

我做错了什么？

unit TestSvc;

interface

uses
 System.SyncObjs
,SysUtils
,Windows
,SvcMgr
,Classes
;


Type
  TSvcTh =  class(TThread)
  private
    FEvent : TEvent;  
    FInterval : Cardinal; 
    vi_dbg : byte;
  protected
    procedure Execute; override;
    procedure DoTimer; 
  public
    procedure Kill;
    Constructor Create();
    Destructor Destroy; override;
end;

type
  TMyService = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    SelfStop : Boolean;
    Svc : TSvcTh;
  public
    function GetServiceController: TServiceController; override;
  end;
  var MyService: TMyService;




implementation

procedure ServiceController(CtrlCode: DWord); stdcall;
const sname='ServiceController';
begin
  MyService.Controller(CtrlCode);
end;
function TMyService.GetServiceController: TServiceController;
const sname='TMyService.GetServiceController';
begin
  Result := ServiceController;
end;
procedure TMyService.ServiceCreate(Sender: TObject);
const sname='TMyService.ServiceCreate';
begin
  try
    Name := SvcName;
  except
    on e: exception do begin
    end;
  end;
end;


procedure TMyService.ServiceShutdown(Sender: TService);
const sname='TMyService.ServiceShutdown';
var Stopped : boolean;
begin
  ServiceStop(Self, Stopped);
end;

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
const sname='TMyService.ServiceStart';
begin
    SelfStop := false;
    Started := false;
    try
      Dbg(sname + ' ******* STARTING THREAD');
      Svc := TSvcTh.Create;
      Dbg(sname + '******* THREAD STARTED');
      Started := true;
    except
       on e : exception do begin
         Dbg(sname + '============== EXCEPTION =============>' + e.Message);
       end;
    end;
end;

procedure TMyService.ServiceStop(Sender: TService; var Stopped: Boolean);
const sname='TMyService.ServiceStop';
begin
  try

    Stopped := True;

    if not SelfStop then begin
      Dbg(sname + '*** Stop using service controller');
      Svc.Kill;
      Svc.WaitFor;
      Svc.Free;
      Svc := nil;
    end
    else begin
      dbg(sname + ' *** Stop by the service itself ') ;
    end;

  except
    on E : Exception do
    begin
      dbg(sname + ' Exception ! ' + e.Message);
    end;
  end;
  Dbg(sname + '*** END');
end;

procedure TSvcTh.DoTimer;
const sname = 'TSvcTh.DoTimer';
begin
  try
    inc(vi_dbg);
    Dbg(sname + '******* DoTimer');
  except
    on e : exception do begin
      Dbg(sname +' ============== EXCEPTION =============>' + e.Message);
    end;
  end;
end;

procedure TSvcTh.Execute;
const sname = 'TSvcTh.Execute';
begin
  while not Terminated do begin
      try
        case FEvent.WaitFor(FInterval) of
         wrSignaled : begin // Triggered when we stop the service using service controller
          Terminate;
         end;
         wrTimeout : begin
          if not Servicemni.SelfStop then begin
             DoTimer; 
             if vi_dbg > 5 then begin
                MyService.SelfStop := true; // Testing auto stop
                terminate;
             end;
          end;
         end;
        end;
      except
         on e : exception do begin
          Dbg(sname + ' ============== EXCEPTION =============>' + e.Message);
         end;
      end;
  end;


  if MyService.SelfStop then begin
    MyService.DoShutdown;
  end;

  Dbg(sname + ' ARRET ... ' + StrLog(MyService.Terminated));
  if MyService.SelfStop then begin
    MyService.ReportStatus;
  end;


end;

Constructor TSvcTh.Create();
const sname = 'TSvcTh.Create';
begin
  FEvent := TEvent.Create(nil, False, False, '');
  FInterval := heartbeat;
  vi_dbg := 0;
  inherited Create(False);
end;
destructor TSvcTh.Destroy;
const sname = 'TSvcTh.Destroy';
begin
  try
    if assigned(FEvent) then begin
      FreeAndNil(FEvent);
    end;
  except
    on e:exception do begin
      Dbg(sname + '==========================> EXCEPTION : '+ e.Message);
    end;
  end;
  inherited;
end;

procedure TSvcTh.Kill;
const sname = 'TSvcTh.Kill';
begin
  try
    FEvent.SetEvent;
  except
    on e:exception do begin
      dbg(sname +  ' ==========================> EXCEPTION : '+ e.Message);
    end;
  end;
end;



end.

更新：

如果我添加一个ServiceExecute方法并修改Svc线程以将SelfStop设置为true（不终止它），则服务结束。但它似乎并不优雅。我无法弄清楚为什么需要它。事实上，该服务似乎创建了一个线程＆＃34; ServiceExecute＆＃34;无论如何。但是，如果我不编写这种方法，则永远不会调用ProcessRequest，并且＆＃34; ServiceExecute＆＃34;当Svc线程结束时永远不会结束。此外，在服务结束后，该过程在Windows任务管理器（来自sysinternals的Process Explorer）中仍然保持大约30秒。

procedure TSvcTh.Execute;
const sname = 'TSvcTh.Execute';
begin
  while not Terminated do begin
      try
        case FEvent.WaitFor(FInterval) of
         wrSignaled : begin // Triggered when we stop the service using service controller
          Terminate;
         end;
         wrTimeout : begin
          DoTimer; 
          if vi_dbg > 5 then begin
            MyService.SelfStop := true; // Testing auto stop
          end;
         end;
        end;
      except
         on e : exception do begin
          Dbg(sname + ' ============== EXCEPTION =============>' + e.Message);
         end;
      end;
  end;
end;

procedure TMyService.ServiceExecute(Sender: TService);
    begin
    while not terminated do begin
      ServiceThread.ProcessRequests(false);
      if SelfStop then begin
        ServiceThread.terminate;
        Svc.Terminate;
        Svc.WaitFor;
        Svc.Free;
        Svc := nil;
      end;
      sleep(1000);      
    end;

更新2：The explication for the delay of 30 seconds for the service to terminate seems to be here

Answer 1

如果线程想要自行终止，它可以调用SCM通知服务需要停止，这反过来将终止线程，如下面的概念证明代码所示。为了使这项工作，我将一个匿名方法传递给Thread构造函数，以避免依赖于服务本身（并且可以在服务之外测试线程代码）。如果您启动该服务并且什么都不做，它将在10秒后自行关闭。

服务代码：

unit Unit1;

interface

uses
  Unit2,
  WinApi.WinSvc,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    { Private declarations }
    MyThread : TMyThread;
    Eventlog : TEventLogger;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;

implementation

{$R *.dfm}

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

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

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
 EventLog := TEventLogger.Create('Service1');
 // call our thread and inject code for premature service shutdown
 MyThread := TMyThread.Create(procedure begin Service1.Controller(SERVICE_CONTROL_STOP) end);
 MyThread.Start;
 EventLog.LogMessage('Started');
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 EventLog.LogMessage('Stop');
 MyThread.Terminate;
 // Give some time to the thread to cleanup, then bailout
 WaitForSingleObject(MyThread.Handle, 5000);
 EventLog.LogMessage('Stopped');
 EventLog.Free;
 Stopped := True;
end;

end.

工作人员主题：

unit Unit2;

interface

uses
  SysUtils,
  Vcl.SvcMgr,
  Windows,
  System.Classes;

type
  TSimpleProcedure = reference to procedure;

  TMyThread = class(TThread)
  private
    { Private declarations }
    ShutDownProc : TSimpleProcedure;
    EventLog     : TEventLogger;
  protected
    procedure Execute; override;
  public
    constructor Create(AShutDownProc: TSimpleProcedure);
    destructor Destroy; override;
  end;

implementation

{ MyThread }
constructor TMyThread.Create(AShutDownProc: TSimpleProcedure);
begin
 inherited Create(True);
 ShutDownProc := AShutDownProc;
end;

procedure TMyThread.Execute;

var
  Count : Integer;
  Running : Boolean;

begin
 EventLog := TEventLogger.Create('MyThread');
 EventLog.LogMessage('Thread Started');
 Count := 0;
 Running := True;
 while not Terminated and Running do
  begin
   EventLog.LogMessage(Format('Count: %d', [Count]));
   Running :=  Count <> 10;
   Inc(Count);
   if Running then
    Sleep(1000); // do some work
  end;
 // if thread wants to stop itself, call service thread shutdown and wait for termination
 if not Running and not Terminated then
  begin
   EventLog.LogMessage(Format('Thread Wants to Stop', [Count]));
   ShutDownProc();
  end;
 EventLog.LogMessage(Format('Thread Await terminate', [Count]));
 // await termination
 while not Terminated do Sleep(10);
 EventLog.LogMessage(Format('Thread Terminated', [Count]));
 EventLog.Free;
end;

end.

Delphi服务无法自行停止

1 个答案: