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
– David Heffernan, Commented Feb 13, 2012 at 17:18
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
– whosrdaddy, Commented Feb 13, 2012 at 17:50
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 Dodge, Commented Feb 13, 2012 at 18:49
@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
– David Heffernan, Commented Feb 13, 2012 at 19:38

whosrdaddy · Accepted Answer · 2012-02-13 20:35:13Z

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.

+1 I recommend that you swap around the two points in this answer. The ProcessRequests is the key and it should come first.

Collectives™ on Stack Overflow

Delphi XE2 Service not stopping properly

1 Answer 1

1 Comment

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Linked

Related