如何用程序实现Ping（不调用dos命令"ping"）?

Question

如何用程序实现Ping（不调用dos命令"ping"）?
帮忙写一个函数
   IPPing(strIp:String;IntMinSecondTimeOut:Integer):Boolean;
   begin
   ..
   end;
如果成功返回“True”,否则返回“False”;
执行该函数花IntMinSecondTimeOut毫秒。eg:booConnected:=IPPing("202.118.104.10",100).

Answer 1

用indy控件里的TIdIcmpClient控件
unit Main;
interface
uses
  Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  SysUtils, Classes, IdIcmpClient, IdBaseComponent, IdComponent, IdRawBase, IdRawClient;type
  TfrmPing = class(TForm)
    lstReplies: TListBox;
    ICMP: TIdIcmpClient;
    Panel1: TPanel;
    btnPing: TButton;
    edtHost: TEdit;
    procedure btnPingClick(Sender: TObject);
    procedure ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
  private
  public
  end;var
  frmPing: TfrmPing;implementation
{$R *.DFM}procedure TfrmPing.btnPingClick(Sender: TObject);
var
  i: integer;
begin
  ICMP.OnReply := ICMPReply;
  ICMP.ReceiveTimeout := 1000;
  btnPing.Enabled := False; try
    ICMP.Host := edtHost.Text;
    for i := 1 to 4 do begin
      ICMP.Ping;
      Application.ProcessMessages;
      //Sleep(1000);
    end;
  finally btnPing.Enabled := True; end;
end;procedure TfrmPing.ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);
var
  sTime: string;
begin
  // TODO: check for error on ping reply (ReplyStatus.MsgType?)
  if (ReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';  lstReplies.Items.Add(Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
    [ReplyStatus.BytesReceived,
    ReplyStatus.FromIpAddress,
    ReplyStatus.SequenceId,
    ReplyStatus.TimeToLive,
    sTime,
    ReplyStatus.MsRoundTripTime]));
end;
end.

Answer 2

谢谢，我会试试，顺便问一下，有没有api(@winsoket)能用

Answer 3

我编的一个程序 你看看吧！记得给分
unit Unit4;interfaceuses
  Classes,Windows, Messages, SysUtils, Variants,Graphics, Controls, Forms,
  Dialogs,winsock, StdCtrls, ImgList, ComCtrls;
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;
mythread = class(TThread)
  private
    { Private declarations }  protected    procedure Execute; override;
    procedure searchip;
    function fenjie(l:string):string;
    function ping(IP:string):boolean;
    function iptoname(ip:string):string;
  public   //线程里用到的变量放到 public中
     treeview1:TTreeView;   //为线程添加成员对象
    text1:TEdit;
    text2:TEdit;
     hICMP:THANDLE;
    IcmpCreateFile:TIcmpCreateFile;
    IcmpCloseHandle:TIcmpCloseHandle;
    IcmpSendEcho:TIcmpSendEcho;
     criticalsection:Trtlcriticalsection;
    //liujia:Tcriticalsection;
    constructor create(li:boolean);end;implementation{ Important: Methods and properties of objects in VCL or CLX can only be used
  in a method called using Synchronize, for example,      Synchronize(UpdateCaption);  and UpdateCaption could look like,    procedure mythread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }{ mythread }procedure mythread.Execute;
begin
  { Place thread code here }
  synchronize(searchip);
  if terminated then
    exit;
   //synchronize 同步管理VCL管理的资源
end;
constructor mythread.create(li:boolean);
begin
 inherited create(li);
FreeOnTerminate:=false;
end;
function mythread.iptoname(ip:string):string;
var
//:TSockAddrIn;
hostent:PHostEnt;
ii:dword;
begin
//sockaddrin.sin_addr.S_addr:=inet_addr(pchar(ip));
 ii:=inet_addr(pchar(ip));
hostent:=gethostbyaddr(@ii,sizeof(ii),PF_INET);
result:=hostent.h_nameend;
function mythread.fenjie(l:string):string;
var
lei,jia:string;
begin
lei:=l;
jia:='';
jia:=copy(lei,1,pos('.',lei));
//s:=Copy(s, POs('&&', s)+3, Length(s));
lei:=copy(lei,pos('.',lei)+1,length(lei));
jia:=jia+copy(lei,1,pos('.',lei));
lei:=copy(lei,pos('.',lei)+1,length(lei));
jia:=jia+copy(lei,1,pos('.',lei));
result:=jia;
end;
function mythread.ping(IP:string):boolean;
var
ipopt:TIPOptionInformation;
fipaddress:dword;
preqdata,prevdata:pchar;
pipe:picmpechoreply;
fsize:dword;
mystring:string;
ftimeout:dword;
buffersize:dword;
 npkts:dword;
begin
 if ip <>'' then
  begin
   //liujia:=Tcriticalsection.create;
   //liujia.acquire;
   //try
   entercriticalsection(criticalsection);
   fipaddress:=inet_addr(pchar(ip));
   fsize:=40;
   buffersize:=sizeof(TICMPEchoReply)+fsize;
   getmem(prevdata,fsize);
   getmem(pipe,buffersize);
   fillchar(pipe^,sizeof(pipe^),0);
   pipe^.Data:=prevdata;
   mystring:='test test test!!!!!!!';
   preqdata:=pchar(mystring);
   fillchar(ipopt,sizeof(ipopt),0);
   ipopt.TTL:=64;
   ftimeout:=450;
   npkts:=IcmpSendEcho(hicmp,fipaddress,preqdata,length(mystring),@ipopt,pipe,buffersize,ftimeout);
   if npkts=0 then
     ping:=false
    else
      ping:=true;
   //finally
    //liujia.release;
   end;    
   freemem(pipe);
   freemem(prevdata);
   leavecriticalsection(criticalsection);
 //end;
end;
procedure mythread.searchip();
Var
i,a,c,b,n,h,mm:Integer;
treenode1,treenode2:TTreeNode;
haha,o, liujia,zhangrei,tou,wei:string;
begin
//清空所有Item;
  tou:=text1.Text;
  wei:=text2.Text;
TreeView1.Items.Clear;
 i:=0;
 haha:=fenjie(tou);
 a:=length(haha);
 b:=length(tou);
 c:=length(wei);
 liujia:=copy(tou,a+1,b-a);
 zhangrei:=copy(wei,a+1,c-a);
 mm:=strtoint(liujia);
 n:=strtoint(zhangrei);
 if n<mm then
   begin
    messagedlg('尾IP不能小于头IP！',mtinformation,[mbok],0);
    exit;
   end;
With TreeView1.Items Do
Begin
//增加根接点;
TreeNode1:=Add(nil, '校园网络IP检测');
//全部展开所有结点
TreeView1.FullExpand;
//刷新TreeView
TreeView1.Refresh;
//根结点图标
TreeNode1.ImageIndex:=-1;
TreeNode1.SelectedIndex:=-1;
//二级接点
For h:=mm to n Do
Begin
o:=inttostr(h);
if ping(haha+o)=true Then
Begin
//如果可以Ping通，图标为0；
TreeNode2:=AddChild(TreeNode1,haha+o);
TreeNode2.ImageIndex:=0;
TreeNode2.SelectedIndex:=0;
//全部展开所有结点
TreeView1.FullExpand;
//刷新TreeView
TreeView1.Refresh;
//bar.Position :=bar.Position+100+n;
End
Else
Begin
//如果不能Ping通，图标为1
TreeNode2:=AddChild(TreeNode1,haha+o);
TreeNode2.ImageIndex:=1;
TreeNode2.SelectedIndex:=1;
//全部展开所有结点
TreeView1.FullExpand;
//刷新TreeView
TreeView1.Refresh;
//bar.Position :=bar.Position+100+n;
i:=i+1;
End;
End;End;
//Application.MessageBox('检测结束','提示',0);
messagedlg('检查结束！',mtConfirmation,[mbok],0);
End;
end.