忙时重启服务

Question

我使用 Delphi XE2 编写了 Windows 服务应用程序。 最近我注意到Windows更新后服务无法启动。日志告诉我服务正忙于睡眠。

我有

procedure TnSoftTestService.TestCheckEverything;
var
  i: Integer;
begin
  for i := 0 to 24 do
  begin
    Sleep(1000);
    LogToFile(IntToStr(ord(nSoftTestService.Status)), TLogMsgType.ltDebug);
  end;
end;

procedure TnSoftTestService.ServiceCreate(Sender: TObject);
begin
  LogToFile('Servisas kuriamas', TLogMsgType.ltDebug);
end;

procedure TnSoftTestService.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  CoInitializeEx(nil, COINIT_MULTITHREADED);
  LogToFile('statring', TLogMsgType.ltWarning);
  Application.CreateForm(TdmMainDataModule, dmMainDataModule);
  dmMainDataModule.svsRysiams.active := True;
end;

procedure TnSoftTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  LogToFile('Servisas stabdomas', TLogMsgType.ltWarning);
end;

dmMainDataModule 包含我连接到并执行 TnSoftTestService.TestCheckEverything; 的 TServerSocket。当它处于循环状态时，我重新启动服务。我在 Windows 服务中收到“服务正在停止”，然后收到“服务正在启动”，但我没有收到 ServiceStart 日志，在睡眠循环后，我收到 ServiceStop 日志，并且服务已完全启动停了下来。如果我不执行TestCheckEverything，我确实会得到它们。我应该把长时间睡眠放在哪里以及如何检测服务正在重新启动？

Answer 1

问题在于testcheckeverything正在阻止tserversocket，因此服务，从及时关闭。当服务需要关闭时，它需要停止循环。例如，您应该在服务的onstop/onshutdown事件中设置标志，并定期使循环查看该标志。

另外，您不应从onstop/onshutdown事件退出，直到服务完全清除了所需的内容，即<<代码> tserversocket 已完全停用。

尝试更多类似的东西：

private
  ShuttingDown: Boolean;

procedure TnSoftTestService.TestCheckEverything;
var
  i: Integer;
begin
  for i := 0 to 24 do
  begin
    if ShuttingDown then Exit;
    Sleep(1000);
    LogToFile(IntToStr(ord(nSoftTestService.Status)), TLogMsgType.ltDebug);
  end;
end;

procedure TnSoftTestService.ServiceCreate(Sender: TObject);
begin
  LogToFile('Servisas kuriamas', TLogMsgType.ltDebug);
end;

procedure TnSoftTestService.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  CoInitializeEx(nil, COINIT_MULTITHREADED);
  LogToFile('starting', TLogMsgType.ltWarning);
  dmMainDataModule := TdmMainDataModule.Create(nil);
  dmMainDataModule.svsRysiams.Active := True;
  Started := True;
end;

procedure TnSoftTestService.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  ServiceShutdown(Sender);
  Stopped := True;
end;

procedure TnSoftTestService.ServiceShutdown(Sender: TService);
begin
  LogToFile('Servisas stabdomas', TLogMsgType.ltWarning);
  ShuttingDown := True;
  dmMainDataModule.svsRysiams.Active := False;
  dmMainDataModule.Free;
  CoUninitializeEx;
end;

另外，请考虑使用tevent而不是sleep（），例如：

private
  ShuttingDown: TEvent;

procedure TnSoftTestService.TestCheckEverything;
var
  i: Integer;
begin
  for i := 0 to 24 do
  begin
    if ShuttingDown.WaitFor(1000) <> wrTimeout then Exit;
    LogToFile(IntToStr(ord(nSoftTestService.Status)), TLogMsgType.ltDebug);
  end;
end;

procedure TnSoftTestService.ServiceCreate(Sender: TObject);
begin
  LogToFile('Servisas kuriamas', TLogMsgType.ltDebug);
  ShuttingDown := TEvent.Create;
end;

procedure TnSoftTestService.ServiceDestroy(Sender: TObject);
begin
  ShuttingDown.Free;
end;

procedure TnSoftTestService.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  CoInitializeEx(nil, COINIT_MULTITHREADED);
  LogToFile('starting', TLogMsgType.ltWarning);
  ShuttingDown.ResetEvent;
  dmMainDataModule := TdmMainDataModule.Create(nil);
  dmMainDataModule.svsRysiams.Active := True;
  Started := True;
end;

procedure TnSoftTestService.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  ServiceShutdown(Sender);
  Stopped := True;
end;

procedure TnSoftTestService.ServiceShutdown(Sender: TService);
begin
  LogToFile('Servisas stabdomas', TLogMsgType.ltWarning);
  ShuttingDown.SetEvent;
  dmMainDataModule.svsRysiams.Active := False;
  dmMainDataModule.Free;
  CoUninitializeEx;
end;