Forum > Windows

TDaemon hangs on OnExecute, bug? (Windows 64bit)

<< < (2/2)

MaartenJB:

--- Quote from: GetMem on January 06, 2022, 01:51:47 pm ---Because you have more fine control over it, but OK I got your point.

--- End quote ---

Yes I agree, this one is probably the way to go ...\lazarus\fpc\3.2.0\source\packages\fcl-extra\examples\daemon.pp

I was looking at the file dates of the examples, and the double one seems way more recent, and wanted to give that a go.

RandomPascal:
I will share my fresh experience with creating a Windows service:

* Do no use LazDaemon package, use daemon.pp from fcl-extra as a starting point.
* Override DoTerminate() of your thread doing the work, to make thread's OnTerminate() execute. Otherwise OnTerminate never executes.
* Do not use sleep(), use RTLeventWaitFor(FThreadRTLEvent, WaitMiliseconds) instead. This will not (kind of) "freeze"  Windows.
Problem not solved yet: After stopping the service, exe stays in memory, I have to kill it/restart Windows
UPDATE: It looks like Application.Terminate at the end of BOTH TdaMyDaemon.Stop and TdaMyDaemon.Shutdown solves problem of the executable in the memory after stopping the service.


Thread example:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---implementation  { TMyThread } constructor TMyThread.Create(AConfigFile: String; ALog: TEventLog; ATerminate : TNotifyEvent);begin  FConfigFile:=AConfigFile;  FLog:=Alog;  OnTerminate:=ATerminate;  FreeOnTerminate:=false;  FThreadRTLEvent := RTLEventCreate;  Inherited Create(True);end; destructor TMyThread.Destroy;begin  RTLeventDestroy(FThreadRTLEvent);  inherited Destroy;end; procedure TMyThread.DoLog(EventType: TEventType; Msg : String);begin  If Assigned(FLog) then    FLog.Log(EventType, Msg);end; procedure TMyThread.DoTerminate;begin  //inherited DoTerminate; we do not need to call inherited in service?  if (FDebug) then begin    DoLog(etDebug,'TMyThread.DoTerminate');  end;  if Assigned(OnTerminate) then begin    OnTerminate(Self);  end;end; procedure TMyThread.Execute;Var  T : TDateTime;begin  try  T:=Now;   Repeat    T:=Now+EncodeTime(0,FSyncEveryMins,0,0);    Repeat      If Not Terminated then         RTLeventWaitFor(FThreadRTLEvent, 200);    Until (Now>=T) or Terminated;    If Not Terminated then       DoWork;//Do actual work here  Until Terminated;  if (FDebug) then    DoLog(etDebug,'TMyThread.Terminated OnTerminate '+BoolToStr(Assigned(Self.OnTerminate),true));  except   On E : Exception do     DoLog(etError,'TMyThread.Execute err: '+E.Message);  end; end; end.  
Daemon application:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---Program SomeDaemon;   {...}TdaMyDaemon = Class(TCustomDaemon)  Private    MyThread : TMyThread;    FLog : TEventLog;    procedure StartLog;    Procedure ThreadStopped (Sender : TObject);  public   FTermRTLEvent: PRTLEvent;   function LoadSettings: boolean;    constructor Create(AOwner: TComponent);override;    destructor Destroy;override;    Function Start : Boolean; override;    Function Stop : Boolean; override;    Function ShutDown : Boolean; override;    Function Install : Boolean; override;    Function UnInstall: boolean; override;  end; constructor TdaMyDaemon.Create(AOwner: TComponent);  begin    FMyThread:=nil;    inherited.Create(AOwner);    FTermRTLEvent := RTLEventCreate;  end; destructor TdaMyDaemon.Destroy;begin   RTLeventDestroy(FTermRTLEvent);   inherited Destroy;end; function TdaMyDaemon.Start: Boolean;  var    OK: boolean;  begin    Result:=inherited Start;    StartLog;    OK:=LoadSettings;    If OK then begin      if not (Assigned(FMyThread)) then begin        FMyThread:=TMyThread.Create(FConfigFile,FLog,@ThreadStopped);        if Assigned(FMyThread.FatalException) then            raise FMyThread.FatalException;      end;      FMyThread.Start;    end else begin      Application.Log(etError,'cannot create MyThread, check settings');    end;    Result:=OK;end; function TdaMyDaemon.Stop: Boolean;var  OK: boolean;  I: integer;begin  Result:=inherited Stop;  Application.Log(etDebug,' TdaMyDaemon.Stop: Assigned(FMyThread)='+BoolToStr(Assigned(FMyThread),true));  If (Assigned(FMyThread)) then    begin      Application.Log(etDebug,' TdaMyDaemon.Stop: Assigned(FMyThread.OnTerminate)='+BoolToStr(Assigned(FMyThread.OnTerminate),true));      FMyThread.Terminate;    I:=0;    // Wait at most 10 seconds.    While (FMyThread<>Nil) and (I<10000) do      begin      //Sleep(100);  //causes temporary hang?      RTLeventWaitFor(FTermRTLEvent, 100);      inc(i);      ReportStatus;      end;    // Let the thread die silently. Not sure about this.    {    If (FMyThread<>Nil) then      FMyThread.OnTerminate:=Nil;      }    end;  OK:=FMyThread=Nil;  Application.Log(etInfo,'DaemonStop: OK='+BoolToStr(OK,true));  Application.Terminate;//Not sure about this. I hoped this solves: exe stays is memory after stopping the service.end; procedure TdaMyDaemon.ThreadStopped(Sender: TObject);begin  Application.Log(etInfo, 'Thread Stopped');  if (Assigned(FMyThread)) then    begin      FreeAndNil(FMyThread);      Application.Log(etDebug, 'Thread freed');    end;end;  

Navigation

[0] Message Index

[*] Previous page

Go to full version