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?

Answer 1

Thanks for your Support.

I used the code skeleton from Remys post here:

Delphi Windows Service Design

Works great. Thx to that great community and thx to Remy