Hiya,
I'm trying to write a traceroute function for Delphi, and have been trying
several pieces of code to get it working.
It seems any writing to TIdICMPClient's TTL property (which I had to decend
to use),
cause the ping to time out.
This is despite the fact that if you look at the
packets using Ethereal, the pings return rapidly with 'TTL expired'!
Yet by using OnReply in aforementioned class I just get a timeout. I don't
get it at all. I've even tried several different hosts to ping.
If I don't write to TTL, the ping comes back as normal, but this is the echo
destination ping, which is of no use to me in building a trace table.
So, I started using TIdTraceRoute. This comes back with hostname '' and ip
address = 0.0.0.0 for every hop, with FReplyStatus=rsTimeout.
What's going on!?
PS, I'm using windows 2003 server and delphi 2006.
Code:
type
TIdIcmpClientAccess = class(TIdIcmpClient);
TMainForm = class(TForm)
ICMP: TIdIcmpClient;
...
procedure TMainForm.GoClick(Sender: TObject);
var Trace: TIdTraceRoute;
begin
FDestIP := GStack.ResolveHost('www.google.com'); // For example
Trace:=TIdTraceRoute.Create(self);
Trace.OnReply:=ICMPReply;
Trace.Host:=FDestIP;
Trace.Trace;
// ----------------------
// Or alternatively:
TIdIcmpClientAccess(ICMP).TTL := 1;
icmp.Host:=FDestIP;
icmp.Ping;
end;
procedure TMainForm.ICMPReply(ASender: TComponent; const AReplyStatus:
TReplyStatus);
begin
Reply := AReplyStatus;
Inc(ReplyId);
showmessage('"'+AReplyStatus.HostName+'" '+AReplyStatus.FromIpAddress);
ProcessResponse; // Goes on to check Reply.ReplyStatusType. This
always returns rsTimeOut, never rsTTLExceeded.
end;
