Prevent Delphi Service from not responding

Question

my problem is the following: I implemented a Windows Service with Delphi Tokyo but imho this is no version problem rather than a design problem. I use the following code to pause my service and be responsive in that state.

procedure TMyService.ServiceExecute(Sender: TService);
begin
    while not Terminated do
    begin
      MyProductiveFunction;
      Delay(10000);
    end;
end;

procedure TMyService.Delay(Milliseconds: integer);
var
  Tick: DWord;
  Event: THandle;
begin
  LogOnLevel(clogger, CAS_LOGGER.Debug, '', ['Delay', 'ENTER', 'Delayed for ' + Milliseconds.ToString]);
  Event := CreateEvent(nil, False, False, nil);
  try
    Tick := GetTickCount + DWord(Milliseconds);
    while (Milliseconds > 0) and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <>
      WAIT_TIMEOUT) do
    begin
      ServiceThread.ProcessRequests(False);
      if Terminated then
        exit;
      Milliseconds := Tick - GetTickCount;
    end;
  finally
    CloseHandle(Event);
  end;
end;

The Function I run sometimes is very time consuming. When I try to Stop the Service while it is in the Delay procedure it stops and everything is fine. But when I try to stop the Service while running "MyProductiveFunction" it will say Service is not responding and after that there is no other way to terminate the Service than killing it by Taskmanager. Is there a better way to implement that so the Service will be responding independently from its actual state?

Do not use Service.OnExecute! spawn a new thread in Service.OnStart and terminate that thread in Service.OnStop. Look here if you want a code skeleton. — whosrdaddy
And signal that thread to pause its work in the Service.OnPause event, and resume the work in the Service.OnContinue event. — Remy Lebeau
Also, your Event is completely useless, since nobody has access to it to signal it. You don't need an Event just to use MsgWaitForMultipleObjects(), you can set its nCount parameter to 0 and pHandles to nil to wait only on the calling thread's message queue. Though, I would suggest using a waitable timer instead of counting ticks manually. — Remy Lebeau

fpiette fpiette · Accepted Answer · 2020-11-05T08:44:24

You have to write MyProductiveFunction like you programmed your Delay function: periodically process requests and terminate the function if the service is asked to terminate.

Instead, you may also create another thread to execute MyProductiveFunction and from the ServiceExecute call ProcessRequest and check for termination. When termination is requested, you have to terminate the other thread. The best is to have this other thread check something shared such a TEvent for terminating, or ServiceExecute may kill/abort that thread.

Prevent Delphi Service from not responding

2 Answers