Delphi XE2 Il servizio non si arresta correttamente

Question

Ho creato alcuni servizi in Delphi 7 e non ho avuto questo problema. Ora che ho avviato una nuova app di servizio in XE2, non si arresterà correttamente. Non so se è qualcosa che sto facendo male o se potrebbe essere un bug nei servizi XE2.

La procedura di esecuzione assomiglia a questo:

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; 

ho mai un'eccezione, come si può vedere annoto alcuna eccezione. PostLog salva in un file INI, che funziona bene. Ora uso i componenti ADO, quindi uso CoInitialize() e CoUninitialize. Si connette al DB e fa il suo lavoro correttamente. Il problema si verifica solo quando interrompo questo servizio. Finestre mi dà il seguente messaggio:

Poi il servizio continua. Devo fermarlo una seconda volta. La seconda volta che si ferma, ma con il seguente messaggio:

Il file di registro indica che il servizio ha fatto con successo gratuito (OnDestroy evento è stato registrato), ma non ha mai smesso di successo (OnStop non è mai stato registrato).

Nel mio codice precedente, ho due procedure Startup e Cleanup. Questi semplicemente creare/distruggere e inizializzare/annullare l'inizializzazione mie cose necessarie ...

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

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

Come potete vedere, ho un thread in esecuzione secondario. Questo servizio ha in realtà numerosi thread in esecuzione in questo modo e il thread del servizio principale registra solo gli eventi da ciascun thread. Ogni thread ha responsabilità diverse. I thread stanno riportando correttamente, e sono anche stati terminati correttamente.

Che cosa potrebbe causare questo arresto anomalo? Se il mio codice inserito non espone nulla, allora posso postare più di codice in seguito - semplicemente a 'convertire' a causa della denominazione interna, ecc

EDIT

Ho appena iniziato a progetto nuovo servizio Delphi XE2 e hanno lo stesso problema. Questo è tutto il mio codice qui sotto:

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. 

Answer 1

un'occhiata al codice sorgente per il metodo Execute:

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; 

come si può vedere se non si assegna un metodo OnExecute, Delphi elaborare le richieste di SCM (Avvio, arresto, ...) fino a quando il servizio non viene arrestato. Quando si effettua un loop nel Service.Execute è necessario elaborare autonomamente le richieste SCM chiamando lo ProcessRequests(False). Una buona abitudine non è quella di utilizzare Service.execute e avviare il workthread nell'evento Service.OnStart e terminarlo/liberarlo nell'evento Service.OnStop.

Come detto nei commenti, un altro problema si trova nella parte FUpdateThread.Terminate. David Heffernan era perfetto per il commento Free/WaitFor. Assicurarsi di terminare il thread in modo corretto utilizzando gli oggetti di sincronizzazione.