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.