Hallo,

Der Titel drückt so ziemlich das aus, was ich machen möchten.
Vorab das Ziel. Ich habe eine List verschiedener IP's, die laufend angepingt werden sollen. Das Pingen selbst übernimmt je IP ein Thread. Die Ergebnisse werden an den Mainthread übergeben, dieser übergibt sie dann zur Speicherung an unterschiedliche Objekte. Soweit funktioniert alles.
Da aber nicht immer alle IP's angepingt werden (aber immer mehr als eine) werden also im laufenden Betrieb mehrere PingThreads erzeugt und auch wieder beendet. (Da fangen die Probleme an).
Um das zu realisieren habe ich mir eine TOjectliste erzeugt. Diese hält Objekt welche den Thread und weitere Rahmeninformationen beinhaltet. (Klassen weiter unten).

Wird soll nun eine Thread beendet werden, so sucht die ObjectListe in welchem Object dieser Thread steckt, beendet ihn und entfernt das Object. Soll ein neuer Pingthread gestartet werden, so wird von der ObjectListe ein Object erzeugt, in dem dann der Thread gestartet wird. Soweit meine Vorstellung.
Funktioniert auch alles, bis auf das beenden.

Hier die der PingThread:

zusammenfalten · markieren

Delphi-Quellcode:

unit th_ping;

interface

uses System.Classes, OverbyteIcsWndControl, OverbyteIcsPing;

type
  TPingSuccess=procedure(Sender: TObject; IPAddr: string) of object;
  TPingError=procedure(Sender: TObject; IPAddr: string) of object;
  TThreadStarted=procedure(Sender: TObject; IPAddr: string) of object;
  TThreadEnded=procedure(Sender: TObject; IPAddr: string) of object;

  TThPing=class(TThread)
  private
    FIPAddr: string;
    FPing: TPing;
    FPingSucess: TPingSuccess;
    FPingError: TPingError;
    FThreadStarted: TThreadStarted;
    FThreadEnded: TThreadEnded;
    procedure DoPingSuccess;
    procedure DoPingError;
    procedure DoThreadStarted;
    procedure DoThreadEnded;
    procedure pingEchoReply(Sender, Icmp: TObject; Status: Integer);
  public
    constructor Create(Suspended: Boolean; IPAddr: string);
  published
    property OnPingSuccess: TPingSuccess read FPingSucess write FPingSucess;
    property OnPingError: TPingError read FPingError write FPingError;
    property OnThreadStarted: TThreadStarted read FThreadStarted write FThreadStarted;
    property OnThreadEnded: TThreadEnded read FThreadEnded write FThreadEnded;
  protected
    procedure Execute; override;
  end;

implementation

{ TThPing }

constructor TThPing.Create(Suspended: Boolean; IPAddr: string);
begin
  inherited Create(Suspended);
  Self.FreeOnTerminate:=True;
  self.NameThreadForDebugging('THPing_'+IPAddr);
  FPing:=TPing.Create(nil);
  FIPAddr:=IPAddr;
end;

procedure TThPing.DoPingError;
begin
  if Assigned(FPingError) then
    self.Queue(nil,
    procedure
    begin
      FPingError(Self, FIPAddr);
    end);
end;

procedure TThPing.DoPingSuccess;
begin
  if Assigned(FPingSucess) then
    self.Queue(nil,
    procedure
    begin
      FPingSucess(Self, FIPAddr);
    end);
end;

procedure TThPing.DoThreadEnded;
begin
  if Assigned(FThreadEnded) then
    self.Queue(nil,
    procedure
    begin
      FThreadEnded(Self, FIPAddr);
    end);
end;

procedure TThPing.DoThreadStarted;
begin
  if Assigned(FThreadStarted) then
    self.Queue(nil,
    procedure
    begin
      FThreadStarted(Self, FIPAddr);
    end);
end;

procedure TThPing.Execute;
var
 a: string;
begin
  inherited;
  FPing.OnEchoReply:=pingEchoReply;
  try
    DoThreadStarted;
    FPing.Address:=FIPAddr;
    while not Terminated do
    begin
      FPing.Ping;
      Sleep(500);
    end;
  finally
    FPing.Free;
    DoThreadEnded;
  end;
end;

procedure TThPing.pingEchoReply(Sender, Icmp: TObject; Status: Integer);
begin
  if Status=1 then DoPingSuccess else DoPingError;
end;

end.

Und hier mal die leicht gekürzte Fassung der Objectlist, welche die Threads hält:

zusammenfalten · markieren

Delphi-Quellcode:

type
  TPingSuccess=procedure(Sender: TObject; IPAddr: string) of object;
  TPingError=procedure(Sender: TObject; IPAddr: string) of object;
  TThreadStarted=procedure(Sender: TObject; IPAddr: string) of object;
  TThreadEnded=procedure(Sender: TObject; IPAddr: string) of object;

  TTh=class
  private
    FIPAddr: string;
    FThread: TThPing;
    FRunning: Boolean;
    procedure SetIPAddr(const Value: string);
    procedure SetThread(const Value: TThPing);
    procedure SetRunning(const Value: Boolean);
  public
    constructor Create;
  published
    property IPAddr: string read FIPAddr write SetIPAddr;
    property Thread: TThPing read FThread write SetThread;
    property Running: Boolean read FRunning write SetRunning;
  end;

  TThList=class(TObjectList<TTh>)
  private
    FPingSuccess: TPingSuccess;
    FPingError: TPingError;
    procedure ThreadStarted(Sender: TObject; IPAddr: string);
    procedure ThreadEnded(Sender: TObject; IPAddr: string);
  published
    property OnPingSuccess: TPingSuccess read FPingSuccess write FPingSuccess;
    property OnPingError: TPingError read FPingError write FPingError;
  published
    function IndexOfIPAddr(value: string): Integer;
    procedure AddItem(IPAddr: string);
    procedure Del(IPAddr: string);
    procedure RemoveAll;
  end;

implementation

{ TTh }

constructor TTh.Create;
begin
  inherited;
  Self.FRunning:=False;
end;

procedure TTh.SetIPAddr(const Value: string);
begin
  FIPAddr := Value;
end;

procedure TTh.SetRunning(const Value: Boolean);
begin
  FRunning := Value;
end;

procedure TTh.SetThread(const Value: TThPing);
begin
  FThread := Value;
end;

{ TThList }

procedure TThList.AddItem(IPAddr: string);
var
  th: TTh;
begin
  th:=TTh.Create;
  th.IPAddr:=IPAddr;
  th.Thread:=TThPing.Create(True, IPAddr);
  if Assigned(FPingSuccess) then th.Thread.OnPingSuccess:=FPingSuccess;
  if Assigned(FPingError) then th.Thread.OnPingError:=FPingError;
  th.Thread.OnThreadStarted:=ThreadStarted;
  th.Thread.OnThreadEnded:=ThreadEnded;
  th.Thread.Resume;
  self.Add(th);
end;

procedure TThList.Del(IPAddr: string);
var
  th: TTh;
begin
  if IndexOfIPAddr(IPAddr)>-1 then
  begin
    if self[IndexOfIPAddr(IPAddr)].Thread<>nil then
    begin
      self[IndexOfIPAddr(IPAddr)].Thread.Terminate;
      while self[IndexOfIPAddr(IPAddr)].Running do
        Sleep(50);
      self[IndexOfIPAddr(IPAddr)].Thread:=nil;
    end;
    self.Remove(self[IndexOfIPAddr(IPAddr)]);
  end;
end;

function TThList.IndexOfIPAddr(value: string): Integer;
var
  i: Integer;
begin
  Result:=-1;
  for i:=0 to self.Count-1 do
    if self[i].IPAddr=value then
    begin
      Result:=i;
      Break;
    end;
end;

procedure TThList.RemoveAll;
var
  i: Integer;
begin
  for i:=Self.Count-1 downto 0 do
  begin
    if self[i].Thread<>nil then
    begin
      self[i].Thread.Terminate;
      while self[i].Running do
        Sleep(50);
      self[i].Thread:=nil;
    end;
    self.Remove(self[i]);
  end;
end;

procedure TThList.ThreadEnded(Sender: TObject; IPAddr: string);
var
  i: Integer;
begin
  for i:=0 to self.Count-1 do
    if self[i].Thread=(Sender as TThPing) then
      self[i].Running:=False;
end;

procedure TThList.ThreadStarted(Sender: TObject; IPAddr: string);
var
  i: Integer;
begin
  for i:=0 to self.Count-1 do
    if self[i].Thread=(Sender as TThPing) then
      self[i].Running:=True;
end;

end.

Im MainThread wird dann per Timer neue Threads erzeugt, bzw. beim Beenden sollen alle Thread beendet werden.

zusammenfalten · markieren

Delphi-Quellcode:

procedure TfrmFBCMain.tmr1Timer(Sender: TObject);
var
  i: Integer;
  th: TTh;
begin
  for i:=0 to Connections.Count-1 do
  begin
    if ThreadList.IndexOfIPAddr(Connections[i].AliveIP)=-1 then
    begin
      ThreadList.AddItem(Connections[i].AliveIP);
    end;
  end;
end;

procedure TfrmFBCMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ThreadList.RemoveAll;
  while ThreadList.Count>0 do
    Sleep(100);
end;

Was anfangs sehr gut funktioniert hat, endet nun beim Beenden im einem Deadlock.
Jetzt werden einige sagen, ja klar, warum verwendest du keine ThreadList, WorkerThread, etc.....

Nun, wenn mir einer das verständlich erklären kann, würde ich's tun. Aus den verschiedenen Postings dazu bin ich nicht wirklich schlauer geworden.

Aber trotzdem müsste oben aufgeführter Code funktionieren.

Wär toll, wenn mir jemand helfen könnte, das Thema besser zu verstehen, und/oder die Fehler oben auszubügeln.
Wie gesagt, das Starten der Threads und die Threads selber laufen bombe. Damit habe ich keine Probleme. Es geht mir um's beenden, also 'RemoveAll'.

zusammenfalten · markieren

Delphi-Quellcode:

Self.Queue(nil,
procedure
begin
  FPingError(Self, FIPAddr);
end);

// implizite Referenzen aufgelöst
Self.Queue(nil,
procedure
begin
  Self.FPingError(Self, Self.FIPAddr);
end);

Queue wird verzögert aufgerufen.

Wenn der Thread hier schon freigegeben wurde, wenn die Methode ausgeführt wird, müsste sowas doch knallen?

Das Thread-Objekt, auf welches Self verweist, gibt es nicht mehr und auf Self.Irgendwas kann man auch nicht mehr zugreifen.

Wie viele IP's hast Du den? 3-5, 30-50, 300-500...

Warum für jede IP einen Thread und den Thread dann auch noch mit einem Sleep(500) ins Nirvana schicken?

Warum nicht ein WaitforSingleObject(500) und beim TimeOut den Ping auslösen...

Oder

2-4 WorkerThreads die immer wenn ein weiterer Ping dran ist einen Worker los schickt?

Dann nur einen Thread die die IP-Liste abarbeitet...

Mavarik

PS.: Sorry das war nicht die Frage...

Knallt nicht. Vielleicht, weil er die Threads nicht beendet.
Die Schleife in RemoveAll läuft auch weiter und hängt im

markieren

Delphi-Quellcode:

      while self[i].Running do
        Sleep(50);

Anzahl der Threads verändert sich aber nicht. Als wenn der Thread auf das Terminate nicht reagiert.

was mir weiterhin auffällt, ich vergebe mit self.NameThreadForDebugging('THPing_'+IPAddr); eine Namen für den Thread. Dieser wird aber wohl nur für den ersten Thread verwendet. Denn in der IDE wird nur ein Thread mit diesem Namen angezeigt, es müsste aber bei allen 11 Thread ein passender Name stehen.

In dem Zusammenhang ist mir aufgefallen, dass in der IDE unter Thread-Status der NameThreadForDebugging zwar verwendet wird, aber die Thread-ID sich nicht verändert.
Also, wenn ich im Create des Threads einen Haltepunkt setze und die Threads nacheinander erzeugen lasse,
dann ist beim ersten mal: THPing_10.161.207.1(17732)
beim Zweiten Thread: THPing_192.1.1.6(17732) <-- Name geändert, aber ID gleich ??
beim dritten Thread: THPing_192.1.1.6(17732) <-- das gleiche

Es kommen aber Thread-ID's hinzu, nur wird der NameForDebugging immer beim ersten erzeugten Thread geändert.

Erzeugt werden so:

zusammenfalten · markieren

Delphi-Quellcode:

ar
  th: TTh;
begin
  th:=TTh.Create;
  th.IPAddr:=IPAddr;
  th.Thread:=TThPing.Create(True, IPAddr);
  if Assigned(FPingSuccess) then th.Thread.OnPingSuccess:=FPingSuccess;
  if Assigned(FPingError) then th.Thread.OnPingError:=FPingError;
  th.Thread.OnThreadStarted:=ThreadStarted;
  th.Thread.OnThreadEnded:=ThreadEnded;
  th.Thread.Resume;
  self.Add(th);

Zitat von Mavarik:

PS.: Sorry das war nicht die Frage...

Richtig. Ich wollte jetzt nicht über Sinnhaftigkeit diskutieren. Es könnten genauso auch Threads sein, die x Information von x Quellen gleichzeitig abrufen sollten, ohne den Ablauf des Hauptprogramms zu stören. Aber das spielt keine Rolle.

Mir geht es darum, warum das Beenden so derart fehlschlägt.

Du hast FreeOnTerminate=True und

markieren

Delphi-Quellcode:

procedure TThPing.Execute;
begin
  ...
  finally
    FPing.Free;
    DoThreadEnded;
  end;
end;

Der Inhalt von DoThreadEnded wird also nahezu immer erst nach Ende des Threads und nach dessen Freigabe ausgeführt.
Grund: siehe mein letzter Post.

Okay, oben genanntes Verhalten zum TheadNameForDebugging konnte ich durch folgende Änderung korrigieren:
  self.NameThreadForDebugging('THPing_'+IPAddr, self.ThreadID);

Zitat von himitsu:

Du hast FreeOnTerminate=True und

markieren

Delphi-Quellcode:

procedure TThPing.Execute;
begin
  ...
  finally
    FPing.Free;
    DoThreadEnded;
  end;
end;

Der Inhalt von DoThreadEnded wird also nahezu immer erst nach Ende des Threads und nach dessen Freigabe ausgeführt.
Grund: siehe mein letzter Post.

Hm...wenn du mir noch erklären könnte, warum der FreeOnTerminate ausgeführt wird bevor die Execute-Routine abgearbeitet ist?

Hab meinen Fehler gefunden.
Da ich ja die Threads über einen Timer erzeugt habe, aber vergessen habe, ihn vor dem RemoveAll auszuschalten, hat er fleißig nach dem beenden eine Thread mir den gleich mal wieder erzeugt
So kann man sich selber ins Knie schießen

Zitat von Hobbycoder:

So kann man sich selber ins Knie schießen

Du könntest dir ja das Erstellen/Freigeben loggen.
Also mindestens ins Debug-Log der Delphi-IDE. OutputDebugString

Die Erste Zeile in eigenen Threads ist bei mir immer NameThreadForDebugging.
Da findet man seine Threads im Debugger auch schneller, in der großen Thread-Liste.
Mindestens steht da der Name der ThreadProzedurSamtKlassenname, bzw. der aufrufenden Prozedur bei anonymen Threads,
aber du kannst dir hier auch noch einen Create-Zähler und/oder die FIPAddr mit anhängen.