Trace 命令可以实现跟踪目的地经过的IP地址.请问Trace如何实现的?
回复人：forgot2000 | 忘记2000年
program TraceRoute;
uses
Forms,
MainForm in 'MainForm.pas' {TraceRouteForm},
ICMP_Define in 'ICMP_Define.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TTraceRouteForm, TraceRouteForm);
Application.Run;
end.
//ICMP_Define.PAS
unit ICMP_Define;
interface
uses winsock;
type
DWORD=LongWord;
THandle=LongWord;
THostTraceMultiReply=record
dwError : DWORD; //GetLastError for this host
Address : in_addr; //The IP address of the replier
minRTT : DWORD; //Minimum round trip time in milliseconds
avgRTT : DWORD; //Average round trip time in milliseconds
maxRTT : DWORD; //Maximum round trip time in milliseconds
end;
THostTraceSingleReply=record
dwError:DWORD; //GetLastError for this replier
Address:in_addr; //The IP address of the replier
RTT:DWORD; //Round Trip time in milliseconds for this replier
end;
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation =
record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply =
record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize:Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation;
end;
const
ULONG_MAX=1024;
function IcmpCreateFile():THandle;stdcall external 'ICMP.dll';
function IcmpCloseHandle(Handle:THandle):Boolean;stdcall external 'ICMP.dll';
function IcmpSendEcho(Handle:THandle;DestAddr:DWORD;
RequestData: Pointer;RequestSize: Word;RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;ReplySize: DWORD;Timeout: DWORD): DWORD;stdcall external 'ICMP.dll';
implementation
end.
//主菜单
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,Winsock,ICMP_Define;
type
TTraceRouteForm = class(TForm)
Label1: TLabel;
edtIP: TEdit;
btnTracert: TButton;
memResult: TMemo;
procedure btnTracertClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Tracert(dwAddr:DWORD;dwPingsPerHost:DWORD);
function Ping(dwAddr:DWORD;TimeOut:Word;var htsr:THostTraceSingleReply;nTTL:Byte):boolean;
end;
var
TraceRouteForm: TTraceRouteForm;
implementation
{$R *.DFM}
procedure TTraceRouteForm.btnTracertClick(Sender: TObject);
var
WSAData:TWSAData;
dwAddr:DWORD;
hp:phostent;
begin
//init winsock dll
if (WSAStartup(MAKEWORD(2,0),WSAData)<>0) then
raise Exception.Create('Winsock Version Error');
ZeroMemory(Addr(dwAddr),sizeof(dwAddr));
//resolve IP
//convert form dotted address
dwAddr:=inet_addr(pchar(edtIP.text));
if (dwAddr=INADDR_NONE) then
begin
hp:=gethostbyname(pchar(edtIP.Text));
if hp=NIL then
begin
memResult.Lines.Add('Failed to resolve host IP');
Exit//Failed to resolve host;
end
else
CopyMemory(Addr(dwAddr),hp.h_addr^,hp.h_length);
end;
memResult.Lines.Add(Format('Resolve Target: %d.%d.%d.%d',[LoByte(LoWord(dwAddr)),
HiByte(LoWord(dwAddr)),
LoByte(HiWord(dwAddr)),
HiByte(HiWord(dwAddr))]));
//trace route
//icmp function must be declared.
Tracert(dwAddr,1);
//release winsock dll
WSACleanUP;
end;
procedure TTraceRouteForm.Tracert(dwAddr:DWORD;dwPingsPerHost:DWORD);
var
dwTimeOut : DWORD;
nHops : Byte;
nPings : Byte;
bReachedHost : Boolean;
i,j : Byte;
htrr : THostTraceMultiReply;
htsr : THostTraceSingleReply;
totalRTT : DWORD;
bPingError : Boolean;
Top
回复人：forgot2000 | 忘记2000年
begin
//set init value
dwTimeOut:=3000;//this value changed according the net condition
nHops:=30;
nPings:=3;
bReachedHost:=false;
//update show.
memResult.Lines.Add(Format('Tracing route to %s '#13#10'over a maximum of %d hpos',
[edtIP.Text,nHops]));
for i:=1 to nHops do
begin
if bReachedHost then
begin
memResult.Lines.Add('Trace Complete');
Break;
end;
htrr.dwError := 0;
htrr.minRTT := ULONG_MAX;
htrr.avgRTT := 0;
htrr.maxRTT := 0;
//Iterate through all the pings for each host
totalRTT := 0;
htsr.Address.S_addr := 0;
htsr.dwError := 0;
bPingError:=false;
for j:=1 to dwPingsPerHost do
begin
if bPingError Then break;
if (Ping(dwAddr,dwTimeOut,htsr,i))then
if (htsr.dwError=0)then
begin
inc(totalRTT,htsr.RTT);//acumulate total time
//Store away the RTT etc
if (htsr.RTT<htrr.minRTT)then htrr.minRTT:=htsr.RTT;
if (htsr.RTT>htrr.maxRTT)then htrr.maxRTT:=htsr.RTT;
end //if (htsr.dwError=0)then
else //if (htsr.dwError=0)then
begin
htrr.dwError:=htsr.dwError;
bPingError:=true;
end
else//if (Ping(dwAddr,dwTimeOut,htsr,i))then
begin//ping failed
memResult.Lines.Add(inttostr(i)+' Ping failed');
end;
end;// for j:=1 to dwPingsPerHost do
htrr.Address := htsr.Address;
if (htrr.dwError = 0)then
htrr.avgRTT := Round(totalRTT / dwPingsPerHost)
else
begin
htrr.minRTT := 0;
htrr.avgRTT := 0;
htrr.maxRTT := 0;
end;
//show trace result here
if htrr.dwError=0 then
begin
memResult.Lines.Add(Format('%d %d ms %d ms %d ms %d.%d.%d.%d'#13#10,
[i,
htrr.minRTT,
htrr.avgRTT,
htrr.maxRTT,
ord(htrr.Address.S_un_b.s_b1),
ord(htrr.Address.S_un_b.s_b2),
ord(htrr.Address.S_un_b.s_b3),
ord(htrr.Address.S_un_b.s_b4)]));
memResult.update;
end
else
memResult.Lines.Add(Format('%d Error:%d',[i,htrr.dwError]));
memResult.Update;
if (dwaddr=htrr.Address.S_addr)then
//reach the final host
bReachedHost:=true;
end;// of for i:=1 to nHops do
end;
function TTraceRouteForm.Ping(dwAddr:DWORD;TimeOut:Word;var htsr:THostTraceSingleReply;nTTL:Byte):boolean;
var
IPOpt:TIPOptionInformation;// IP Options for packet to send
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
FSize: DWORD;
BufferSize:DWORD;
temp:Integer;
hICMP:THandle;
begin
Result:=false;
hICMP:=IcmpCreateFile();
if hICMP=INVALID_HANDLE_VALUE then
begin
//Could not get a valid icmp handle
exit;
end;
FSize := 40; //package size
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
//set up the option structure
ZeroMemory(@IPOpt,SizeOf(TIPOptionInformation));
IPOpt.TTL:=nTTL;
FillChar(pIPE^, SizeOf(pIPE^),0);
pIPE^.Data := pRevData;
GetMem(pReqData,5);//data package size = 5 byte
FillChar(pReqData^,5,65);
temp:=IcmpSendEcho(hICMP, dwAddr, pReqData, 5,
@IPOpt,pIPE, BufferSize, TimeOut);
if temp=0 then
begin
htsr.dwError:=GetLastError();
end
else
begin
//ping success,copy info to return structure;
htsr.Address.S_addr:=pIPE^.Address;
htsr.RTT:=pIPE^.RTT;
Result:=true;
end;
//Free up the memory we allocated
FreeMem(pRevData);
FreeMem(pIPE);
//Close the ICMP handle
IcmpCloseHandle(hIcmp);
end;
procedure TTraceRouteForm.FormCreate(Sender: TObject);
begin
//update view
MemResult.Font.Color:=clHighlightText;
MemResult.Font.Name:='Terminal';
MemResult.Font.Size:=10;
MemResult.Color:= clNone;
end;
end.