Restart service while it is busy

Question

I have written windows service application using Delphi XE2. Recently I noticed that service failed to start after Windows update. Logs told me that service was busy doing sleep.

I have

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 contains TServerSocket that i connect to and execute TnSoftTestService.TestCheckEverything;. while it is in a loop, i restart service. I get "Service is stopping" and then "Service is starting" in Windows services, but i get no ServiceStart logs and after sleep loop i get ServiceStop log and service is completely stopped. I do get them if I do not execute TestCheckEverything. Where should I put my long sleep and how do i detect that service is being restarted?

Answer 1

The problem is that TestCheckEverything is blocking the TServerSocket, and thus the service, from shutting down in a timely manner. It needs to stop looping when the service needs to shut down. For example, you should set a flag in the service's OnStop/OnShutdown events, and have the loop look at that flag periodically.

Also, you should not be exiting from the OnStop/OnShutdown events until the service has completely cleaned up what it needs to, ie after the TServerSocket has been fully deactivated.

Try something more like this:

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;

Alternatively, consider using a TEvent instead of Sleep(), eg:

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;