用Delphi如何实现Trace命令(100分送上)

Question

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';
    
implementationend.//主菜单
unit MainForm;interfaceuses
  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;

Answer 1

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.

Answer 2

关注，用delphi的调试器看行不