Problem mit Indy TCP Server (Thread Timeout)

[linobrocken]

Hallo erstmal!

So ich hab da ein Problem mit meiner Server Anwendung:
Im Prinzip funktioniert der Server so, dass wenn ein Client sich Verbindet er in eine Clientliste aufgenommen wird. Dann bleiben die Clients erstmal in einer Wartestellung. So wenn man dann in der Serveranwendung einen entsprechenden verbundenen Client auswählt, wird an den ein "SEND" gesendet, worauf hin der mittels WriteStream() Bilder in einem bestimmten Intervall überträgt. (Also der client macht intern einen Schreenshot packt den in einen Filestream und schickt den mit WriteStream() los, dann macht er wieder einen Screenshot....). Der Server erzeugt für jeden Client ein Form in dem die Bilder, sofern erwünscht angezeigt werden.

So nun möchte ich, das wenn der Client abstürtzt oder sich trennt oder so, er aus der Liste entfernt wird und der Server das Fenster freigibt.Eigentlich hab ich das alles auch soweit fertig nur hab ich das Problem, das wenn ein Client disconnected die Routine ONDisconnect gar nicht immer ausgeführt wird, weil der Server noch in der OnExecute Routine auf irgendetwas wartet.

Delphi-Quellcode:

procedure TFserver.IdTCPServerExecute(AThread: TIdPeerThread);
var
  fs: TFileStream;
  SizeOfIncomingStream: integer;
  J:TJpegimage;
  Client:TClients;
begin
//Client laden
Client:=Pointer(Athread.Data);
 //DatenStrom aus einer Datei erzeugen
   fs := TFileStream.Create(Client.DNS+'.jpeg', fmCreate or fmShareExclusive);
   with AThread.Connection do
    if Connected then
     try
      begin
         SizeOfIncomingStream := ReadInteger; //Größe des Streams empfangen
         ReadStream(fs, SizeOfIncomingStream); //und übergeben
      end;
     finally
       fs.Free;
     //Jpegbild erzeugen
       J:=TJpegimage.Create;
     //WEnn das Tempfile existiert
      if Fileexists(Client.DNS+'.jpeg') then
        begin
        //Wird es geladen und auf dem entsprechenden Form
        //angezeigt
         J.LoadFromFile(Client.DNS+'.jpeg');
         Client.Form.giveimage(J);  //Bild anzeigen
        end;
    end;
   end;
end;

procedure TFserver.IdTCPServerDisconnect(AThread: TIdPeerThread);
var i:integer;
    Client:TClients;
begin
 //Client laden
 Client:=Pointer(Athread.Data);
 // Client informationen löschen
 for i:=0 to Clients.Count-1 do
  if TClients(Clients.Items[i]).DNS=Client.DNS then
   begin
    //Falls ein anzeige Fenster geöffnet ist es schließen
    if TClients(Clients.Items[i]).Form.IMonitor<>nil then
     begin
     //Form Schliessen und freigeben
      TClients(Clients.Items[i]).Form.Close;
      TClients(Clients.Items[i]).Form.Release;
     end;
   end;
 //Aus der Liste löschen
 Clients.Delete(Client.ListLink);
 Client.Free;
 Athread.Data:=nil;
end;

Wenn ich den den Server beende:

Delphi-Quellcode:

procedure TFserver.FormClose(Sender: TObject; var Action: TCloseAction);
 var List:Tlist;
     i:integer;
begin
 List:=idTCPServer.Threads.LockList;
 //an Alle verbundenen Clients disconnect Befehl senden
 for i:=0 to List.Count-1 do
  begin
   TidPeerThread(List.Items[i]).Stop;
   TidPeerThread(List.Items[i]).Connection.Disconnect;
  end;
 //Client liste freigeben
 Clientlist.Free;
 idTCPServer.Threads.UnlockList;
end;

Ich bekomme beim beenden jedesmal die Fehlermeldung "Thread Timeout"

ich weiß nicht ob klar geworden ist wo meine Probleme liegen, vielleicht sieht irgendjemand ja einen offentlsichtlichen Fehler oder so...

Gruß
Pascal

[omata]

Hallo Pascal,

da ich meine FH-Email zur Zeit nicht von zu hause abfragen kann, versuche ich Dir mal auf diesem Wege zu helfen...


Dein System hängt (und wirft dann eine Fehlermeldung), weil die einzelnen Anwendungen (Client/Server) auf einer Maschine laufen und sie nicht die Rechenzeit vom Betriebssystem bekommen, die nötig währen.
Wenn du eine Endlosschleife programmierst zieht sich dein Programm 100% der CPU. Da du hier alle Clients in einer Schleife ansprichst, muss du ihnen dann auch die Gelegenheit geben, die jeweiligen Anweisungen auszuführen. Das heißt du musst dem Betriebssysstem mitteilen, das dein Programm Rechenzeit für andere Anwendungen zur Verfühgung stellt. (also Application.ProzessMessages aufrufen).
Hier bietet sich ein multitaskingfähiges Delay an.

Delphi-Quellcode:

procedure Delay(ms: Integer);
var start:longint;
begin
  start:=abs(GetTickCount) + ms;
  repeat
    Application.ProcessMessages;
  until abs(GetTickCount) > start;
end;

Delphi-Quellcode:

procedure TFserver.FormClose(Sender: TObject; var Action: TCloseAction);
var List:Tlist;
     i:integer;
begin
List:=idTCPServer.Threads.LockList;
//an Alle verbundenen Clients disconnect Befehl senden
for i:=0 to List.Count-1 do
  begin
   TidPeerThread(List.Items[i]).Stop;
   TidPeerThread(List.Items[i]).Connection.Disconnect;
   Delay(10); // ruf hier die neue Prozedur aufrufen
  end;
//Client liste freigeben
Clientlist.Free;
idTCPServer.Threads.UnlockList;
end;

Dann sollte das eigentlich gehen.

MfG
Thorsten

[supermuckl]

ausser dem OnDisconnect gibts noch OnException

die wird auch in den meisten fällen bei einem timeout oder bei einem disconnect der nicht geplant war ausgeführt solange man das nicht schon mit try except getan hat

also OnDisconnect oder OnException..
aber vorsicht.. ich weis nicht ob die nicht sogar beide auslösen könnten und wenn du dann 2 mal einen athread aus der liste entfernen willst gäbe es eine exception.. also aufpassen und das entsprechend verriegeln

[linobrocken]

Also das mit dem Delay hat leider nicht geholfen. Also wenn ich nur einen Client am Server hat funktioniert es ohne Timeout sobald das aber 2 sind bekomme ich wieder nach einer zeit:

"Exception EIdTerminateThreadTimeoutin Modul Pserver.exe...... Zeitüberschreitung beim beenden von Thread"

Ich hab es auch mit Rechnern im Netzwerk probiert und nicht auf einem Rechner.
Das wars leider also nicht...

Gruß Pascal

[linobrocken]

Das mit dem Onexception funktioniert nicht.
1. würde der Client auch gelöscht werden wenn eine Exception die gar nichts mit dem disconnecten zu tun hat auftritt
2. Kommt keine Exception beim disconnected sondern das Ondisconnect wird nicht aus gefürht weil der Server in der Onexecute Routine noch auf irgendwas wartet.

Aber trotzdem Danke...
Gruß
Pascal