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.
