Dienst wird durch Leerlauf beendet
Update: Siehe ersten Antwortpost.
Hi, ich habe gerade einige Probleme mit einem Dienst, der zwei Threads beherbergt. Der Sinn ist, dass der Dienst im Hintergrund läuft, während der Thread darauf wartet, dass über Sockets Anfragen hereinkommen, die dann über einen zweiten Thread beantwortet werden. Dazu ein wenig Code: Service/Dienst:
Delphi-Quellcode:
Warte-Thread:
procedure TsrvMain.ServiceCreate(Sender: TObject);
begin // TCP-Server erzeugen FTCPDaemon := TTCPDaemon.Create; end; procedure TsrvMain.ServiceExecute(Sender: TService); begin // TCP-Server starten (FIXME: Testweise auskommentiert) // FTCPDaemon.Execute; end; procedure TsrvMain.ServiceDestroy(Sender: TObject); begin // Und weg damit FTCPDaemon.Free; end;
Delphi-Quellcode:
Antwort-Thread:
constructor TTCPDaemon.Create;
begin inherited Create(false); FSock := TTCPBlockSocket.Create; FreeOnTerminate := true; end; destructor TTCPDaemon.Destroy; begin FSock.Free; inherited; end; procedure TTCPDaemon.Execute; var ClientSocket: TSocket; begin inherited; FSock.CreateSocket; FSock.SetLinger(true,10); FSock.Bind('0.0.0.0', '1308'); FSock.Listen; repeat if self.Terminated then Break; if FSock.CanRead(500) then begin ClientSocket := FSock.Accept; if FSock.LastError = 0 then TTCPReplyThread.Create(ClientSocket); end; until false; end;
Delphi-Quellcode:
Der Client sendet alle 5 Sekunden entsprechende Anfragen an den Server, auf dem der Dienst läuft. Bisher hat das immer wunderbar funktioniert, nur seitdem ich die Threads in einem Dienst laufen lassen will, funktioniert es nicht mehr so richtig. :?
constructor TTCPReplyThread.Create(HSock: TSocket);
begin inherited Create(false); FSock := TTCPBlockSocket.Create; FSock.Socket := HSock; FreeOnTerminate := true; end; destructor TTCPReplyThread.Destroy; begin FSock.Free; inherited; end; procedure TTCPReplyThread.Execute; var s: string; TunesApp: IiTunes; begin inherited; FSock.GetSins; repeat if self.Terminated then break; s := LowerCase(FSock.RecvPacket(5000)); if FSock.LastError <> 0 then break; CoInitialize(nil); TunesApp := CoiTunesApp.Create; try { Hier wird auf "s" reagiert und entsprechend mit FSock.SendString(); eine Antwort geschickt. Bspw.:} if s = IDS_CURRENT_TRACKNAME then begin if (TunesApp <> nil) and (TunesApp.CurrentTrack <> nil) then FSock.SendString(TunesApp.CurrentTrack.Name); end; finally TunesApp := nil; CoUninitialize; end; if FSock.LastError <> 0 then break; until false; end; Problem ist, dass mir gelegentlich (meist beim dritten oder vierten Mal) Zugriffsverletzungen um die Ohren gehauen werden. :gruebel: Gibt es dafür irgendeinen sinnigen Grund? Chris |
Re: Probleme mit zwei Threads und einem Dienst
Hi nochmal,
okay. Habe jetzt das Problem gefunden: der Dienst beendet sich selber. Ich nehme an, weil er meint, sich im Leerlauf zu befinden, obwohl der Thread noch weiter ackern sollte. Nehme ich das FTCPDaemon.Free; heraus gibt es keine AV mehr, sondern der Thread geht einfach so zu Ende. Ich habe deswegen in mein OnExecute-Ereignis des Dienstes folgende Schleife rein geschrieben:
Delphi-Quellcode:
Hilft aber auch nicht. :?
while not Terminated do
begin ServiceThread.ProcessRequests(true); end; Chris |
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:25 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz