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:
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:
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.
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'.