做一个类似Ping的函数，传入一个URL判断是否能Ping通,想用最少的代码，和最简单的方法得到。

Question

做一个类似Ping的函数，传入一个URL判断是否能Ping通,想用最少的代码，和最简单的方法得到。
想应该简单，但我目前不知道该用哪个API来实现，我想3行代码应该就能解决。

Answer 1

好的谢谢了，[email protected]

Answer 2

我错了，我错了，不一定是3行代码实现，能解决就好，关键是提供思路，我打算用TIdDNSResolver
好象不太聪明啊

Answer 3

原来想用控件.
用IdIcmpClient1.Ping试试看

Answer 4

如果用API实现呢，两种方法我都要

Answer 5

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Winsock,
  StdCtrls;
type
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed record
                      TTL: Byte;
                      TOS: Byte;
                      Flags: Byte;
                      OptionsSize: Byte;
                      OptionsData: PChar;
                      end;    PIcmpEchoReply = ^TIcmpEchoReply;
    TIcmpEchoReply = packed record
                  Address: DWORD;
                  Status: DWORD;
                  RTT: DWORD;
                  DataSize: Word;
                  Reserved: Word;
                  Data: Pointer;
                  Options: TIPOptionInformation;
                  end;
    TIcmpCreateFile = function: THandle; stdcall;
    TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
    TIcmpSendEcho = function(IcmpHandle:THandle;
                  DestinationAddress: DWORD;
                  RequestData: Pointer;
                  RequestSize: Word;
                  RequestOptions: PIPOptionInformation;
                  ReplyBuffer: Pointer;
                  ReplySize: DWord;
                  Timeout: DWord
                  ): DWord; stdcall;  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    PingEdit: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    hICMP: THANDLE;
    IcmpCreateFile : TIcmpCreateFile;
    IcmpCloseHandle: TIcmpCloseHandle;
    IcmpSendEcho: TIcmpSendEcho;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
var
  hICMPdll: HMODULE;
begin
  hICMPdll := LoadLibrary('icmp.dll');
  @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
  hICMP := IcmpCreateFile;
  Memo1.Text := '';
  Memo1.Lines.Add('目的IP地址 字节数 返回时间(毫秒)'); 
end;procedure TForm1.Button1Click(Sender: TObject);
var
  IPOpt:TIPOptionInformation;// IP Options for packet to send
  FIPAddress:DWORD;
  pReqData,pRevData:PChar;
  pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
  FSize: DWORD;
  MyString:string;
  FTimeOut:DWORD;
  BufferSize:DWORD;
begin
    if PingEdit.Text <> '' then
    begin
          FIPAddress := inet_addr(PChar(PingEdit.Text));
          FSize := 40;
          BufferSize := SizeOf(TICMPEchoReply) + FSize;
          GetMem(pRevData,FSize);
          GetMem(pIPE,BufferSize);
          FillChar(pIPE^, SizeOf(pIPE^), 0);
          pIPE^.Data := pRevData;
          MyString := 'Hello,World';
          pReqData := PChar(MyString);
          FillChar(IPOpt, Sizeof(IPOpt), 0);
          IPOpt.TTL := 64;
          FTimeOut := 4000;
          try
            IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut);
            if pReqData^ = pIPE^.Options.OptionsData^ then
              Memo1.Lines.Add(PChar(PingEdit.Text) + ' ' + IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));
          except
              Memo1.Lines.Add('Cant resolve host!');
              FreeMem(pRevData);
              FreeMem(pIPE);
              Exit;
          end;
          FreeMem(pRevData);
          FreeMem(pIPE);
    end;
end;
end.  
很多书上都有的

Answer 6

//返回的Ping一个Url所需时间
//需要一个TCPClient组件，再NetFast里面
function TThreadPing.PingHost(Url:String):String;
var
Str:String;
i:Integer;
BefTime,AftTime:TTime;
Hour, Min, Sec, MSec: Word;
S:String;
R:real;begin
R:=0;
Str:=Url; if StrLower(Pchar(Copy(Url,1,3)))='htt' then
  begin
  Str:=Copy(Url,8,Length(Url));
  Str:=Copy(Str,1,Pos('/',Str)-1);
  end
 else
 if StrLower(Pchar(Copy(Url,1,3)))='ftp' then
  begin
  Str:=Copy(Url,7,Length(Url));
  Str:=Copy(Str,1,Length(Str)-Pos(Str,'/'));
  end;
   for i := 1 to 4 do
  with FTCPClient do
  begin
  BefTime:=Now;
  RemoteHost:=Str;
  RemotePort:='80';
  try
  Connect;
    try
    AftTime:=Now;
    DecodeTime(AftTime-BefTime, Hour, Min, Sec, MSec);
    R:=Sec+MsEc/1000;
    finally
    Disconnect;
    end;
  except on E: Exception do
    R:=-1;  end;
  end;result:=Format('%.3f',[R]);
end;

Answer 7

procedure TForm1.Button1Click(Sender: TObject);
var
  buf : String;
begin
  Buf := 'Hello';
  IdIcmpClient1.host := 'pop.163.com';
  IdIcmpClient1.Port := 110;
  IdIcmpClient1.Ping(buf,1000);
  Memo1.Lines.Add('After Ping : ' + buf);
end;procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
  Memo1.Lines.Add( AReplyStatus.FromIpAddress);
end;

Answer 8

楼主, 你指的老兄是指谁?
好, 我补充一下.
我用的是IdIcmpClient1控件来实现Ping的功能.
在窗体上放一个IdIcmpClient1, 一个Memo和一个Button, 
在Button写入以上代码1.进行Ping.
在IdIcmpClient1的OnReply事件中写入第二段代码.(如果有返回, 则加入Memo中)

Answer 9

用TIdICMP
Wnyu(西门吹水) 好

Answer 10

谢谢： Wnyu(西门吹水)。我做好了，我是写了一个单元文件，如下：
unit UMethods;interface
uses
  IdIcmpClient, WinInet;
function ping(const url: string):boolean;implementationfunction ping(const url: string):boolean;
var
  aIdICMPClient: TIdICMPClient;
begin
  Result:= True;
  aIdICMPClient:= TIdICMPClient.Create(nil);
  aIdICMPClient.Host:= url;
  try
    aIdICMPClient.Ping();
  except
    Result:= False;
  end;
  aIdICMPClient.Free;
end;end.