Search code examples
delphi

How to terminate a Windows service if the thread inside it terminates for an handled exception?


I'm using Delphi Athens and I have a service application. Inside there, I create a sub-thread like this:

procedure TMainSvc.ServiceStart(Sender: TService; var Started: Boolean);
begin
  FMainThread := TMainThread.Create(True);
  FMainThread.FreeOnTerminate := true;
  FMainThread.OnTerminate := MainThread_Terminate;
  FMainThread.Start;
  Started := True;
end;

procedure TMainSvc.MainThread_Terminate(Sender: TObject);
begin  
  //
end;

procedure TMainSvc.ServiceExecute(Sender: TService);
begin
  while not Terminated do
    begin
      ServiceThread.ProcessRequests(false);
      TThread.Sleep(1000);
    end;
end;

The main thread contains something like this:

procedure TMainThread.Execute;
begin
  try
    while not Terminated do
      begin
        // some code
        TThread.Sleep(200);
      end;
  except
    on e: exception do
      begin  
        // error handling
      end;
  end;
end;

So, what's happening is that for some reason inside while cycle I receive an error, so I handle the error and the program will complete the execute function.

What I would like to do, is that the service will stop itself in this situation. Instead, the service will stay active doing nothing inside ServiceExecute.

So I tried setting OnTerminate like this:

procedure TMainSvc.MainThread_Terminate(Sender: TObject);
begin
  MainSvc.DoStop;
end;

and I have set the serviceStop like this:

procedure TMainSvc.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  // FMainThread.Terminate;
  FMainThread.WaitFor;
  Stopped := True;
end;

However the program just stays forever waiting the "WaitFor" procedure.

So my final questions are:

  1. What am I doing wrong?
  2. What should I do to achieve what I need? (in case of errors in the cycle, terminate the service)
  3. Why even if FMainThread terminated (it entered onterminate) if I check inside ServiceStop: FMainThread.Finished, FMainThread.CheckTerminated it seems they are not terminated?

Solution

  • You are waiting on your worker thread inside of its own OnTerminate event handler. That is a guaranteed deadlock, since TThread.WaitFor() will not exit until the thread is fully terminated, but the thread will not fully terminate until the event handler has exited.

    Instead, you need to signal the TService.ServiceThread to terminate itself, eg:

    procedure TMainSvc.MainThread_Terminate(Sender: TObject);
    begin
      ServiceThread.Terminate;
    end;
    

    The alternative is to manually simulate an SCM SERVICE_CONTROL_STOP request by directly calling the service's ServiceController, eg:

    procedure TMainSvc.MainThread_Terminate(Sender: TObject);
    begin
      Controller(SERVICE_CONTROL_STOP);
    end;
    

    Also, you can (and should) get rid of your TService.OnExecute event handler, as you don't actually need it at all. You are not doing anything in it that TService itself wouldn't already do internally when OnExecute is not assigned. So let it handle SCM requests automatically for you.