Delphi XE2 Service not stopping properly

Question

I've built a few services in Delphi 7 and did not have this problem. Now that I started a new service app in XE2, it won't stop properly. I don't know if it's something I'm doing wrong or if it might be a bug in the XE2 services.

The execute procedure looks like this:

procedure TMySvc.ServiceExecute(Sender: TService);
begin
  try
    CoInitialize(nil);
    Startup;
    try
      while not Terminated do begin
        DoSomething; //Problem persists even when nothing's here
      end;
    finally
      Cleanup;
      CoUninitialize;
    end;
  except
    on e: exception do begin
      PostLog('EXCEPTION in Execute: '+e.Message);
    end;
  end;
end;

I never have an exception, as you can see I log any exception. PostLog saves to an INI file, which works fine. Now I do use ADO components, so I use CoInitialize() and CoUninitialize. It does connect to the DB and do its job properly. The problem only happens when I stop this service. Windows gives me the following message:

First stop failure

Then the service continues. I have to stop it a second time. The second time it does stop, but with the following message:

Second stop failure

The log file indicates that the service did successfully free (OnDestroy event was logged) but it never successfully stopped (OnStop was never logged).

In my above code, I have two procedures Startup and Cleanup. These simply create/destroy and initialize/uninitialize my necessary things...

procedure TMySvc.Startup;
begin
  FUpdateThread:= TMyUpdateThread.Create;
    FUpdateThread.OnLog:= LogUpdate;
    FUpdateThread.Resume;
end;

procedure TMySvc.Cleanup;
begin
  FUpdateThread.Terminate;
end;

As you can see, I have a secondary thread running. This service actually has numerous threads running like this, and the main service thread is only logging the events from each thread. Each thread has different responsibilities. The threads are reporting properly, and they are also being terminated properly.

What could be causing this stop failure? If my posted code doesn't expose anything, then I can post more code later - just have to 'convert' it because of internal naming, etc.

EDIT

I just started NEW service project in Delphi XE2, and have the same issue. This is all my code below:

unit JDSvc;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, JDSvcMgr;

type
  TJDService = class(TService)
    procedure ServiceExecute(Sender: TService);
  private
    FAfterInstall: TServiceEvent;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  JDService: TJDService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  JDService.Controller(CtrlCode);
end;

function TJDService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TJDService.ServiceExecute(Sender: TService);
begin
  while not Terminated do begin

  end;
end;

end.

Unlikely to be a bug in the Delphi code. Can you cut this down to a minimal reproduction. — David Heffernan
IMHO the TMySvc.Cleanup routine is bound to create problems. You terminate FUpdateThread but you don't know when it is really terminated. Add a WaitFor or use a synchro object to detect termination properly. Look here for more info: eonclash.com/Tutorials/Multithreading/MartinHarvey1.1/Ch5.html — whosrdaddy
I just reproduced the same problem in a NEW XE2 service which has nothing even in it. All I do is add while not Terminated do begin .. end; in the OnExecute event handler. See added code above. — Jerry Dodge
@Jerry This was a good question and you responded well to requests for more info and a smaller example. Upvotes well deserved. Naturally you picked up one downvote but it seems all Delphi questions do. — David Heffernan

whosrdaddy whosrdaddy · Accepted Answer · 2012-02-13T18:20:31

look at the source code for the Execute method:

procedure TServiceThread.Execute;
var
  msg: TMsg;
  Started: Boolean;
begin
  PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
  try
    // Allow initialization of the Application object after
    // StartServiceCtrlDispatcher to prevent conflicts under
    // Windows 2003 Server when registering a class object with OLE.
    if Application.DelayInitialize then
      Application.Initialize;
    FService.Status := csStartPending;
    Started := True;
    if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
    if not Started then Exit;
    try
      FService.Status := csRunning;
      if Assigned(FService.OnExecute) then
        FService.OnExecute(FService)
      else
        ProcessRequests(True);
      ProcessRequests(False);
    except
      on E: Exception do
        FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
    end;
  except
    on E: Exception do
      FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
  end;
end;

as you can see if you don't assign a OnExecute method, Delphi will process SCM requests (Service Start, Stop, ...) until the service is stopped. When you make an loop in the Service.Execute you must to process SCM requests yourself by calling ProcessRequests(False). A good habit is not to use Service.execute and start your workerthread in the Service.OnStart event and terminating/freeing it in the Service.OnStop event.

As told in the comments, another problem lies in the FUpdateThread.Terminate part. David Heffernan was spot on with the Free/WaitFor comment. Make sure you end your thread in correct fashion using synchronisation objects.

Delphi XE2 Service not stopping properly

1 Answers