Board index » delphi » TIdIcmpClient TThread

2006-09-15 05:15:34 PM
delphi91
Hello!
I have a TThread class that impelments TIdIcmpClient to ping ip addresses
but it raises an EAccessviolaiton when i have more then tree instances of
the class two works fine.
Im running delphi 2006.
here are the code
unit Ping;
interface
uses Classes, IdRawBase, IdRawClient, IdIcmpClient, IdComponent, ExtCtrls,
IdGlobal, SysUtils, dialogs{, UGlobals};
type
TPing = class(TThread)
private
{ Private declarations }
Reply, ThreadPause, PingInProgress : Boolean;
IdIcmpClient1 : TIdIcmpClient;
AMCIndex, Interval : Integer;
Str : String;
procedure OnReply(ASender: TComponent; const AReplyStatus:
TReplyStatus);
procedure OnDo;
procedure OnDoSome;
protected
FOnPingReply : TNotifyEvent;
FOnDoSomething : ESomethingEvent;
procedure DoPingReply(Sender : TObject);
procedure DoSomething(Sender : TObject; Str : String);
procedure Execute; override;
procedure DoTerminate; override;
public
constructor Create(CreateSuspended : boolean);
procedure SetPingReply(Reply : Boolean);
procedure SetIP(IP : String);
procedure SetPort(Port : Integer);
procedure OnTerminateSelf(Sender : TObject);
property OnPingReply : TNotifyEvent read FOnPingReply write
FOnPingReply; //
property OnDoSomething : ESomethingEvent read FOnDoSomething write
FOnDoSomething; //type ESomethingEvent = procedure(Sender : TObject; Text :
String) of object; in UGlobals used to trigger a event to write text to a
memo on a form
end;
implementation
{ Important: Methods and properties of objects in visual components can only
be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TPing.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TPing }
//uses USettings;
procedure TPing.OnTerminateSelf;
begin
if Assigned(IdIcmpClient1) then begin
IdIcmpClient1.OnReply := nil;
IdIcmpClient1.Free;
end;
end;
constructor TPing.Create(CreateSuspended : boolean);
begin
Inherited Create(CreateSuspended);
IdIcmpClient1 := TIdIcmpClient.Create(nil);
IdIcmpClient1.OnReply := OnReply;
IdIcmpClient1.IPVersion := Id_IPv4;
IdIcmpClient1.PacketSize := 32;
//IdIcmpClient1.Protocol := 1;
IdIcmpClient1.ReceiveTimeout := 1000;
IdIcmpClient1.IPVersion := ID_IPv4;
//IdIcmpClient1.ProtocolIPv6 := 58;
//IdIcmpClient1.Tag := 0;
Interval := 1000;
ThreadPause := true;
Reply := false;
OnPingReply := DoPingReply;
PingInProgress := false;
FreeOnTerminate := false;
OnTerminate := OnTerminateSelf;
end;
procedure TPing.DoPingReply(Sender : TObject);
begin
if not Terminated then begin
if Assigned(OnPIngReply) then
OnPingReply(Self);
end;
end;
procedure TPing.DoSomething(Sender : TObject; Str : String);
begin
if not Terminated then begin
if Assigned(OnDoSomething) then
OnDoSomething(Self, Str);
end;
end;
procedure TPing.DoTerminate;
begin
Inherited;
end;
procedure TPing.SetPingReply(Reply : Boolean);
begin
if not Terminated then begin
Reply := Reply;
PingInProgress := Reply;
ThreadPause := Reply
end;
end;
procedure TPing.SetIP(IP : String);
begin
if not Terminated then
IdIcmpClient1.Host := IP;
end;
procedure TPing.SetPort(Port : Integer);
begin
if not Terminated then
IdIcmpClient1.Port := Port;
end;
procedure TPing.OnDo;
begin
if not Terminated then
DoPingReply(Self)
end;
procedure TPing.OnDoSome;
begin
if not Terminated then
DoSomething(self,Str);
end;
procedure TPing.OnReply(ASender: TComponent; const AReplyStatus:
TReplyStatus);
begin
if not Terminated then begin
if AReplyStatus.Msg = 'Echo' then begin
Reply := true;
AReplyStatus.Msg := '';
ThreadPause := true;
try
Str := 'Echo from ip: '+IdIcmpClient1.Host +', Time: '
+TimeToStr(Now);
except
Str := 'Echo from ip: '+IdIcmpClient1.Host;
end;
Synchronize(OnDoSome);
Synchronize(OnDo);
end else begin
Reply := false;
Str := 'No Echo, Time: ' +TimeToStr(Now);;
Synchronize(OnDoSome);
end;
PingInProgress := false;
end;
// CS.Leave;
end;
procedure TPing.Execute;
begin
{ Place thread code here }
while not Terminated do begin
//CS.Enter;
try
if not PingInProgress then begin
PingInProgress := true;
IdIcmpClient1.Ping;
try
Str := 'Ping: '+IdIcmpClient1.Host+', Time: ' +TimeToStr(Now);
except
Str := 'Echo from ip: '+IdIcmpClient1.Host
end;
Synchronize(OnDoSome);
end;
except
begin
try
Str := 'Ping Error, Time: ' +TimeToStr(Now);
except
Str := 'Echo from ip: '+IdIcmpClient1.Host;
end;
Synchronize(OnDoSome);
//CS.Leave;
Break;
end;
end;
Sleep(Interval);
end;
end;
end.
 

"Tobias" <XXXX@XXXXX.COM>writes
TPing = class(TThread)
private
Icmp : TIdIcmpClient;
Interval : Integer;
Str : String;
FOnPingReply : TNotifyEvent;
FOnDoSomething : ESomethingEvent;
procedure DoPingReply;
procedure DoSomething;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended : boolean); override;
destructor Destroy; override;
procedure SetIP(IP : String);
procedure SetPort(Port : Integer);
property OnPingReply : TNotifyEvent read FOnPingReply write
FOnPingReply;
property OnDoSomething : ESomethingEvent read FOnDoSomething write
FOnDoSomething;
end;
constructor TPing.Create(CreateSuspended : boolean);
begin
inherited Create(CreateSuspended);
Icmp := TIdIcmpClient.Create(nil);
Icmp.IPVersion := Id_IPv4;
Icmp.PacketSize := 32;
Icmp.ReceiveTimeout := 1000;
Interval := 1000;
end;
destructor TPing.Destroy;
begin
Icmp.Free;
inherited Destroy;
end;
procedure TPing.DoPingReply;
begin
if (not Terminated) and Assigned(OnPingReply) then
OnPingReply(Self);
end;
procedure TPing.DoSomething;
begin
if (not Terminated) and Assigned(OnDoSomething) then
OnDoSomething(Self, Str);
end;
end;
procedure TPing.SetIP(IP : String);
begin
Icmp.Host := IP;
end;
procedure TPing.SetPort(Port : Integer);
begin
Icmp.Port := Port;
end;
procedure TPing.Execute;
begin
while not Terminated do
begin
try
Icmp.Ping;
if Terminated then
Break;
if Icmp.ReplyStatus.Msg = 'Echo' then
begin
try
Str := 'Echo from ip: ' + Icmp.Host + ', Time: ' +
TimeToStr(Now);
except
Str := 'Echo from ip: ' + Icmp.Host;
end;
if Assigned(OnDoSomething) then
Synchronize(DoSomething);
if Assigned(OnPingReply) then Synchronize(DoPingReply);
end else
begin
try
Str := 'No echo from ip: ' + Icmp.Host + ', Time: '
+ TimeToStr(Now);
except
Str := 'No echo from ip: ' + Icmp.Host;
end;
if Assigned(OnDoSomething) then
Synchronize(DoSomething);
end;
except
try
Str := 'Ping error from ip: ' + Icmp.Host + ', Time: ' +
TimeToStr(Now);
except
Str := 'Ping error from ip: ' + Icmp.Host;
end;
if Assigned(OnDoSomething) then Synchronize(DoSomething);
Break;
end;
Sleep(Interval);
end;
end;
Gambit
 

thx i did a lite change to your code but it did not worke either. My change
(if Icmp.Receive(1000).Msg = 'Echo' then // old ->if
Icmp.ReplyStatus.Msg = 'Echo' then ReplyStatus.Msg is protected)
I get a EAccessViolation at Icmp.Ping.
procedure TPing.Execute;

"Tobias" <XXXX@XXXXX.COM>writes
from protected to public awhile ago.
stepping through the code yet to find the error?
trying to read something that has already been read, so you are going to
wipe out your results.
Gambit
 

I find the error in procedure TIdCustomIcmpClient.InternalPing(const AIP,
ABuffer: String; SequenceID: word);
begin
if SequenceID <>0 then
begin
wSeqNo := SequenceID;
end;
SetLength(FbufIcmp,FPacketSize); //raise EAV read of address 00000000.
if Self.FIPVersion = Id_IPv4 then
begin
SetLength(FbufReceive,FPacketSize+Id_IP_HSIZE);
end
else
begin
SetLength(FbufReceive,FPacketSize+(Id_IPv6_HSIZE*2));
end;
PrepareEchoRequest(ABuffer);
SendEchoRequest(AIP);
GetEchoReply;
Binding.CloseSocket;
DoReply(FReplyStatus);
Inc(wSeqNo); // SG 25/1/02: Only incread sequence number when finished.
end;
"Remy Lebeau (TeamB)" <XXXX@XXXXX.COM>skrev i meddelandet

I solved my problem by do a change in the
TIdCustomIcmpClient.InternalPing(const AIP, ABuffer: String; SequenceID:
word);
and a TCriticalSection in execute method from your code.
This solved my problem i dont now if this is the correct way!
code:
procedure TPing.Execute;
begin
while not Terminated do begin
CS.Enter;
try
Icmp.Ping;
if Terminated then
Break;
if Icmp.ReplyStatus.Msg = 'Echo' then begin
Icmp.ReplyStatus.Msg := '';
try
Str := 'Echo from ip: ' + Icmp.Host + ', Time: ' +
TimeToStr(Now);
except
Str := 'Echo from ip: ' + Icmp.Host;
end;
if Assigned(OnDoSomething) then Synchronize(DoSomething);
if Assigned(OnPingReply) then Synchronize(DoPingReply);
end else begin
try
Str := 'No echo from ip: ' + Icmp.Host + ', Time: ' +
TimeToStr(Now);
except
Str := 'No echo from ip: ' + Icmp.Host;
end;
if Assigned(OnDoSomething) then Synchronize(DoSomething);
end;
except
begin
try
Str := 'Ping error from ip: ' + Icmp.Host + ', Time: ' +
TimeToStr(Now);
except
Str := 'Ping error from ip: ' + Icmp.Host;
end;
if Assigned(OnDoSomething) then Synchronize(DoSomething);
Break;
end;
end;
CS.Leave;
Sleep(Interval);
end;
end;
TIdCustomIcmpClient.InternalPing(const AIP,
ABuffer: String; SequenceID: word);
begin
if SequenceID <>0 then
begin
wSeqNo := SequenceID;
end;
if Lengt(FbufIcmp) <>FPcketSize) then //my change
SetLength(FbufIcmp,FPacketSize); //raise EAV read of address 00000000.
if Self.FIPVersion = Id_IPv4 then
begin
SetLength(FbufReceive,FPacketSize+Id_IP_HSIZE);
end
else
begin
SetLength(FbufReceive,FPacketSize+(Id_IPv6_HSIZE*2));
end;
PrepareEchoRequest(ABuffer);
SendEchoRequest(AIP);
GetEchoReply;
Binding.CloseSocket;
DoReply(FReplyStatus);
Inc(wSeqNo); // SG 25/1/02: Only incread sequence number when finished.
//Tobias