Einzelnen Beitrag anzeigen

CalganX

Registriert seit: 21. Jul 2002
Ort: Bonn
5.403 Beiträge
 
Turbo Delphi für Win32
 
#1

Dienst wird durch Leerlauf beendet

  Alt 10. Apr 2007, 14:28
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:
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;
Warte-Thread:
Delphi-Quellcode:
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;
Antwort-Thread:
Delphi-Quellcode:
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;
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.
Problem ist, dass mir gelegentlich (meist beim dritten oder vierten Mal) Zugriffsverletzungen um die Ohren gehauen werden.

Gibt es dafür irgendeinen sinnigen Grund?

Chris
  Mit Zitat antworten Zitat