【发布时间】：2018-03-25 14:41:52
【问题描述】：
我运行一个简单的服务。 我可以使用 SCM 启动和停止它。我还需要服务在条件变为真时自行停止。
问题 1：当我使用 SCM 时服务停止。我点击“停止服务”，服务几乎瞬间停止。但是我注意到 exe 在停止之前会在 Windows 任务列表中停留大约 10 秒。这是正常行为吗？
问题 2：我模拟了一种情况，我需要通过在下面的代码示例中增加一个变量来停止服务。在这种情况下，服务永远不会停止。我必须在 Windows 任务管理器中终止该任务才能停止它。
我尝试了几件事但没有成功。
当我使用单片机停止服务时，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（不终止它），则服务结束。但它似乎不是很优雅。而且我不知道为什么需要它。事实上，服务似乎无论如何都创建了一个线程“ServiceExecute”。但是，如果我不编写此方法，则永远不会调用 ProcessRequest，并且当 Svc 线程结束时，“ServiceExecute”永远不会结束。此外，服务结束后，该进程仍会在 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
【问题讨论】：
-
为什么每个 proc 声明中的这些 const 从未使用过，并且从未设置过停止的变量。如果确实如此，我会感到惊讶
-
你说的是 sname 常量吗？仅用于调试目的。在日志中获取 proc 名称的唯一方法。代码已简化，以便在此处发布。我没有删除常量。就这样。已设置停止的变量，而不是读取。我猜它是由 SCM 使用的。
-
了解我认为您也应该将它们从问题中删除。顺便说一句，函数的名称显示在调用堆栈窗口中，所以我认为你不需要这个
-
我的理解是：如果我尝试从线程调用 StopService ，服务永远不会退出，因为它正在等待线程结束而线程正在等待服务结束，所以 . ..我不明白的是：为什么当我终止线程时服务不会自行终止。因为在这种情况下，服务已经无关紧要了。我是否需要明确终止其他线程？哪一个 ？如何 ？在哪里？
-
谢谢。但我认为在 Windows 关闭时会调用 ServiceShutdown。事实上，当我终止我的线程时，不会调用 ServiceShutDown。
标签： multithreading delphi service