怎样再delphi中实现ping命令啊？？

shellexecute('ping xxx')
然后参见http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=82562

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}
Function MyPing(const Host:string):boolean;
var
  CmdLinePChar:array[0..120] of char;
  StartUpInfo:TStartUpInfo;
  ProcessInfo:TProcessInformation;
  HOutput:THandle;
  StringList:TStringList;
  TempFileName:String;
  i:integer;
begin
  Result:=false;
  Screen.Cursor:=crHourGlass;
  StringList:=TStringList.Create;
  try
    TempFileName:=ExtractFilePath(application.ExeName)+'tempfile.tmp';
    HOutput:=FileCreate(TempFileName);
    if HOutput<0 then
      exit;
    StrPCopy(CmdLinePChar,'Ping.exe'+Host);
    FillChar(StartUpInfo,sizeof(StartUpInfo),#0);
    with StartUpInfo do
    begin
      cb:=sizeof(StartUpInfo);
      dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow:=SW_HIDE;
      hstdOutput:=HOutput;
    end;
    if CreateProcess(nil,CmdLinePChar,nil,nil,True,0,nil,nil,StartUpInfo,ProcessInfo) then
    begin
      WaitForSingleObject(Processinfo.hProcess,INFINITE);
      FileClose(HOutput);
    end
    else
    begin
      FileClose(HOutput);
      exit;
    end;
  StringList.LoadFromFile(TempFileName);
  DeleteFile(TempFileName);
  for i:=1 to StringList.Count-1 do
  begin
    if pos('Reply from',StringList[i])>=1 then
    begin
      Result:=true;
      break;
    end;
  end;
  finally
  screen.Cursor:=crDefault;
  form1.edit1.text:=stringlist[i];
  StringList.Free;  end;end;procedure TForm1.Button1Click(Sender: TObject);
begin
MyPing(' jsj_ws8');
end;end.

调用shellexecute('ping xxx') 或者winexec。然后参见http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=82562

uses ...WinSock;
const
  IcmpDLL = 'icmp.dll';
  TimeOut = 5000;
......
  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;
......
var
  hICMPlib: HModule;
  IcmpCreateFile: TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho: TIcmpSendEcho;
  hICMP: THandle;// Handle for the ICMP Calls
  Size: integer;
  Address: DWord;                     // Address of host to contact
  HostName, HostIP: String;           // Name and dotted IP of host to contact
  Phe: PHostEnt;                      // HostEntry buffer for name lookup
  BufferSize, nPkts: Integer;
  pReqData, pData: Pointer;
  pIPE: PIcmpEchoReply;               // ICMP Echo reply buffer
  IPOpt: TIPOptionInformation;        // IP Options for packet to send
......
procedure TForm1.FormCreate(Sender: TObject);
var
  wsadata: TWSAData;
begin
  // initialise winsock
  if WSAStartup($101, wsadata) <> 0 then
  begin
   ShowMessage('初始化Winsock错误');
   halt;
  end;
  // register the icmp.dll stuff
  hICMPlib := loadlibrary(icmpDLL);
  if hICMPlib <> null then
  begin
   @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
   @IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');
   @IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');
   if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then
   begin
    ShowMessage('读入函数出错');
    halt;
   end;
   hICMP := IcmpCreateFile;
   if hICMP = INVALID_HANDLE_VALUE then
   begin
    ShowMessage('无效句柄');
    halt;
   end;
  end
  else
  begin
   ShowMessage('库注册错误');
   halt;
  end;
end;procedure TForm1.Ping;
begin
  Memo1.Lines.Add('发出 ' + IntToStr(Size) + ' 字节给 ' +
                  HostName + ' (' + HostIP + ')');  // Get some data buffer space and put something in the packet to send
  BufferSize := SizeOf(TICMPEchoReply) + Size;
  GetMem(pReqData, Size);
  GetMem(pData, Size);
  GetMem(pIPE, BufferSize);
  FillChar(pReqData^, Size, $AA);
  pIPE^.Data := pData;
  // Finally Send the packet
  FillChar(IPOpt, SizeOf(IPOpt), 0);
  IPOpt.TTL := 64;
  NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
                        @IPOpt, pIPE, BufferSize, TimeOut);
  if NPkts = 0 then
   ShowError(GetLastError)
  else
  begin
   HostIP := StrPas(inet_ntoa(TInAddr(pIPE^.Address)));
   Memo1.Lines.Add('收到 ' + IntToStr(pIPE^.DataSize) +
                   ' 字节,来自: ' + HostIP + #13#10 +
                   '用时: ' + IntToStr(pIPE^.RTT) + ' 毫秒')
  end;
  // Free those buffers
  FreeMem(pIPE);
  FreeMem(pData);
  FreeMem(pReqData);
  Memo1.Lines.Add('');
end;

使用Indy 的 TIdIcmpClient{***************************************************************
*
* Project  : PingGUI
* Unit Name: Main
* Purpose  : Demonstrates ICMP "Ping"
*
****************************************************************}unit Main;interfaceuses
  {$IFDEF Linux}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls,
  {$ELSE}
  windows, messages, graphics, controls, forms, dialogs, stdctrls, extctrls,
  {$ENDIF}
  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
{$IFDEF MSWINDOWS}{$R *.dfm}{$ELSE}{$R *.xfm}{$ENDIF}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.

该如何得到是否ping得通的是非结果呢？？？

搜索一下，CSDN有N多的例子呀

如果有ICS控件可以直接用，也可以取得返回值，如果没有可以down一个下来，有源码
可以使用如下方法：
//use icmp.dll
Type
TIPAddr = LongInt; // IP Address
TIPMask = LongInt; // An IP subnet mask.
TIPStatus = LongInt; // Status code returned from IP APIs. PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte; // Time To Live (used for traceroute)
TOS: Byte; // Type Of Service (usually 0)
Flags: Byte; // IP header flags (usually 0)
OptionsSize: Byte; // Size of options data (usually 0, max 40)
OptionsData: PChar; // Options data buffer
end; PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = record
Address : TIPAddr; // Replying address
Status : ULONG; // Reply IP_STATUS
RoundTripTime : ULONG; // RTT in milliseconds
DataSize : ULONG; // Reply data size in bytes
Reserved : ULONG; // Reserved for system use
Data : Pointer; // Pointer to the reply data
Options : PIPOptionInformation; // Reply options
end; Function IcmpSendEcho(IcmpHandle : THandle;
DestinationAddress : TIPAddr;
RequestData : Pointer;
RequestSize : Word;
RequestOptions : PIPOptionInformation;
ReplyBuffer : Pointer;
ReplySize : DWord;
Timeout : DWord) : DWord; StdCall;
implementation Const IcmpDll = 'Icmp.dll'; Function IcmpCreateFile; External IcmpDll Name 'IcmpCreateFile';
Function IcmpCloseHandle; External IcmpDll Name 'IcmpCloseHandle';
Function IcmpSendEcho; External IcmpDll Name 'IcmpSendEcho'; ------------------------------------------------------------------
errorcode := IcmpSendEcho(hICMP, FIPAddress, pReqData, FSize,
@IPOpt, pIPE, BufferSize, FTimeOut);
****如果你有了ics的ping控件，那么请看一下icmp.pas中对icmp.dll的写法。****
**** 以上所贴其实全是多余，ICS的icmp.pas中都有 *******
当你ping通一个IP地址后，
myhost:=gethostbyaddr(@FIPAddress,4,AF_INET);
hostname:=myhost.h_name;--》即得主机名。 windows下的gethostbyaddr的操作方式是：
先发包到dns中试图去获取主机名。如不成功则去取windows的主机名。一举两得。//////////////////////////////////////////////////////////////////////////
uses winsock; {-------------------------------------------------------------------------------}
procedure TMyPing.FormCreate(Sender: TObject);
var
WSAData: TWSAData;
hICMPdll: HMODULE;
begin
// Load the icmp.dll stuff
hICMPdll := LoadLibrary('icmp.dll');
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
StatusShow.Text := '';
StatusShow.Lines.Add('目的IP地址字节数返回时间(毫秒)');
end; {-------------------------------------------------------------------------------}
{接下来，就要进行如下所示的Ping操作的实际编程过程了。}
procedure TMyPing.ExeBtnClick(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;
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);
if pReqData^ = pIPE^.Options.OptionsData^ then begin
StatusShow.Lines.Add(PChar(PingEdit.Text) + ' ' + IntToStr(pIPE^.DataSize) + ' ' + IntToStr(pIPE^.RTT));
end;
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;

搞不懂，明明rawclient里面有ping这个方法的。

使用Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，编程就可以建立在对该动态链接库的调用上。
下面这个网址也有比较详细的介绍可以去看看吧
http://www.cx66.com/cxgzs/program/delphi/967.htm

unit UnitPing;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Winsock;
//////////////////////////////////////////////////////
//        TPing Copyright (C) BaoMin 1999           //
//        Author's Email:[email protected]       //
//        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;DestAddr:DWORD;
         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)
    Label1: TLabel;
    Label2: TLabel;
    MemoResult: TMemo;
    EditAddr: TEdit;
    BtnPing: TButton;
    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
      FIPAddress:DWORD;
      pReqData,pRevData:PChar;
      pIPE:PIcmpEchoReply;// ICMP Echo reply buffer
      FSize: DWORD;
      MyString:string;
      FTimeOut:DWORD;
      BufferSize:DWORD;
      temp:Integer;
      pIPAddr:Pchar;
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.

怎么要获取是否PING得通的结果这么麻烦呀！

用INDY的IdIcmpClient可否直接使用某个函数得到是否PING得通的结果？

用INDY的IdIcmpClient，如果ReplyStatus.BytesReceived=0，是不是就代表ping不通呀？

ping通ping不通还和 Timeout 有关！

function ping(const url: string):boolean;   //写一个ping函数，返回值为真假
var
  aIdICMPClient: TIdICMPClient;
begin
  aIdICMPClient:= TIdICMPClient.Create(nil);
  aIdIcmpclient.ReceiveTimeout:=1500;          //1500ms is timeout
  aIdICMPClient.Host:= url;
  try
    aIdICMPClient.Ping();
  except
    Result:= False;
  end;
  if (aidicmpclient.ReplyStatus.fromipaddress<>'0.0.0.0')
     and (aidicmpclient.ReplyStatus.fromipaddress<>'') then
    result:=true
  else
    result:=false;
  aIdICMPClient.Free;
end;使用：if ping('www.163.com') then
         showmessage('ok')
      else
         showmessage('Unkown host');

用indy系列的控件很简单，delphi6.0有，否则用icmp编程，也简单

调试易

怎样再delphi中实现ping命令啊？？

解决方案 »