怎样用delphi实现dos的tracert功能？(300分)

怎样用delphi实现dos的tracert功能？(200)
不用 WinExec(PChar('Command.com /C tracert -d '+Edit1.Text+' >'+Temp),SW_HIDE);
用delphi实现ping的时候，怎样返回ttl值？(100)

不是很懂你的意思，要返回ttl你直接记录到文件，或memo中，再分析一下不就行了？

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
IPOpt:TIPOptionInformation;
FIPAddressWORD;
pReqData,pRevDataChar;
pIPEIcmpEchoReply;
FSize: DWORD;
MyString:string;
FTimeOutWORD;
BufferSizeWORD;
i,x,a:Integer;
y,z:string;
begin
if (Edit1.Text<>'') or (Edit2.Text <> '') then
begin
x:=0;
y:='5000';
if FindComputer(Edit1.Text)=False then
Memo2.Lines.Add('Unknown host name...')
else
begin
Memo2.Text := '';
Memo2.Lines.Add('Pinging '+Edit1.Text+' ['+GetIp(Edit1.Text)+']'+' with 32 byte of data:');
for i:=1 to 4 do
begin
FIPAddress:=inet_addr(pchar(Getip(Edit1.text)));
FSize :=40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := '--------------------------------';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL :=64;
FTimeOut := 1000;
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut);
try
try
if pReqData^ = pIPE^.Options.OptionsData^ then
begin
Memo2.Lines.Add('Reply from '+GetIp(Edit1.Text)+':'+' bytes='+IntToStr(pIPE^.DataSize)+ ' time='+IntToStr(pIPE^.RTT)+' TTL='+IntToStr(IPOpt.TTL));
a:=a+StrToInt(IntToStr(pIPE^.RTT));
x:=x+1;
if y>=IntToStr(pIPE^.RTT) then
y:=IntToStr(pIPE^.RTT);
if z<=IntToStr(pIPE^.RTT) then
z:=IntToStr(pIPE^.RTT);
end;
except
Memo2.Lines.Add('Request time out');
end;
finally
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;
Memo2.Lines.Add('Ping statistics for '+GetIp(Edit1.Text)+':');
Memo2.Lines.Add(' Packets: Send = 4, Received = '+IntToStr(x)+','+' Lost = '+IntToStr(4-x)+' ('+IntToStr((4-x)*100 div 4 )+'% loss),');
Memo2.Lines.Add('Approximate round trip times in milli-seconds:');
if x<>0 then
Memo2.Lines.Add(' Minimum = '+y+'ms, Maximum = '+z+'ms, Average = '+IntToStr(a div x)+'ms')
else
Memo2.Lines.Add(' Minimum = 0ms, Maximum = 0ms, Average = 0ms');
end;
end
else
showmessage('ÇëÊäÈëIpµØÖ·');
end;

哈,刘兄,你可以先自己调试,若有问题我有源代码.你要的话发给你.

//工程文件
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
dwErrorWORD; //GetLastError for this replier
Address:in_addr; //The IP address of the replier
RTTWORD; //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;DestAddrWORD;
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(dwAddrWORD;dwPingsPerHostWORD);
function Ping(dwAddrWORD;TimeOut:Word;var htsr:THostTraceSingleReply;nTTL:Byte):boolean;
end;


var
TraceRouteForm: TTraceRouteForm;

implementation

{$R *.DFM}
procedure TTraceRouteForm.btnTracertClick(Sender: TObject);
var
WSAData:TWSAData;
dwAddrWORD;
hphostent;
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(dwAddrWORD;dwPingsPerHostWORD);
var
dwTimeOut : DWORD;
nHops : Byte;
nPings : Byte;
bReachedHost : Boolean;
i,j : Byte;
htrr : THostTraceMultiReply;
htsr : THostTraceSingleReply;
totalRTT : DWORD;
bPingError : Boolean;
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(dwAddrWORD;TimeOut:Word;var htsr:THostTraceSingleReply;nTTL:Byte):boolean;
var
IPOpt:TIPOptionInformation;// IP Options for packet to send
pReqData,pRevDataChar;
pIPEIcmpEchoReply;// ICMP Echo reply buffer
FSize: DWORD;
BufferSizeWORD;
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.

又是一堆代码！哎~~~

dadabox
你的200分有了。
第二个问题呢？

KAO!你一定要我把你这300分赚完？：）
//PING的
unit UnitPing;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OutlookBtn, StdCtrls, Winsock;
//////////////////////////////////////////////////////
// TPing Copyright (C) BaoMin 1999 //
// Author's Email:baomin_2000@21cn.com //
// Copyright remains BaoMin, do not remove //
// any Copyright notices. //
//////////////////////////////////////////////////////
type
DWORD=LongWord;
THandle=LongWord;
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;

function IcmpCreateFile():THandle;stdcall external 'ICMP.dll';
function IcmpCloseHandle(Handle:THandle):Boolean;stdcall external 'ICMP.dll';
function IcmpSendEcho(Handle:THandle;DestAddrWORD;
RequestData: Pointer;RequestSize: Word;RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;ReplySize: DWORD;Timeout: DWORD): DWORD;stdcall external 'ICMP.dll';
procedure ValidCheck();
procedure FreeWinsock();
function Ping(IPAddr:String;TimeOut:Word):String;

Const
{ Exception Message }
SInitFailed = 'Winsock version error';
SInvalidAddr = 'Invalid IP Address';
SNoResponse = 'No Response';
STimeOut = 'Request TimeOut';

type
TFormPing = class(TForm)
EditAddr: TEdit;
Label1: TLabel;
BtnPing: TButton;
Label2: TLabel;
MemoResult: TMemo;
procedure BtnPingClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormPing: TFormPing;
hICMP:THandle;
implementation
{$R *.DFM}
procedure ValidCheck();
var
WSAData:TWSAData;
begin
//initiates use of WS2_32.DLL
if (WSAStartup(MAKEWORD(2,0),WSAData)<>0) then
raise Exception.Create(SInitFailed);
hIcmp:=IcmpCreateFile();
if hICMP=INVALID_HANDLE_VALUE then
raise Exception.Create('Create ICMP Failed');
end;
procedure FreeWinsock();
begin
IcmpCloseHandle(hIcmp);
WSACleanUP;
end;

function Ping(IPAddr:String;TimeOut:Word):String;
var
IPOpt:TIPOptionInformation;// IP Options for packet to send
FIPAddressWORD;
pReqData,pRevDataChar;
pIPEIcmpEchoReply;// ICMP Echo reply buffer
FSize: DWORD;
MyString:string;
FTimeOutWORD;
BufferSizeWORD;
temp:Integer;
pIPAddrchar;
begin
//get ip
GetMem(pIPAddr,Length(IPAddr)+1);
ZeroMemory(pIPAddr,Length(IPAddr)+1);
StrPCopy(pIPAddr,IPAddr);
//calc
FIPAddress := inet_addr(pIPAddr);
//free it
FreeMem(pIPAddr);
//valid check
if FIPAddress=INADDR_NONE then
begin
result:=SInvalidAddr;//Exit
exit;
end;
// WSAAsyncGetHostByAddr()
//package size
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
//prepare data
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := 'Ping Digital Data';
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
//max delieve geteway
IPOpt.TTL := 64;
//time out
FTimeOut := TimeOut;
//go!!!
temp:=IcmpSendEcho(hICMP,//dll handle
FIPAddress,//target
pReqData,//data
Length(MyString),//data length
@IPOpt,//addree of ping option
pIPE,//
BufferSize,//pack size
FTimeOut);//timeout value
//check result
if temp=0 then
begin
Result:='Ping Addr:'+IPAddr+' '+SNoResponse;
exit;
end;
if pReqData^ = pIPE^.Options.OptionsData^ then
begin
//show result
Result:=('Reply from:'+PChar(IPAddr) + ' '
+'bytes:'+IntToStr(pIPE^.DataSize) + ' '
+'tims:'+IntToStr(pIPE^.RTT)+ 'ms '
+'TTL:'+intToStr(pIPE^.Options.TTL));
end;
//clear memory
FreeMem(pRevData);
FreeMem(pIPE);
end;

procedure TFormPing.BtnPingClick(Sender: TObject);
var
pingresult:string;
begin
//version check and init
ValidCheck();
//update view
pingresult:=Ping(EditAddr.Text,500);
MemoResult.Lines.add(pingresult);
//clear
FreeWinsock();
end;

procedure TFormPing.FormCreate(Sender: TObject);
begin
//update view
MemoResult.Font.Color:=clHighlightText;
MemoResult.Font.Name:='Terminal';
MemoResult.Font.Size:=10;
MemoResult.Color:= clNone;
end;

end.

我没试，但先发分给你吧。