Forum > Windows
TDaemon hangs on OnExecute, bug? (Windows 64bit)
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