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