如何编程实现ping的功能？请帮忙！

发信人: jackzhang (玉~~不灌水了!), 信区: Delphi
标  题: Delphi编程实现Ping操作
使用过网络的用户都熟悉“Ping”这个指令，它是一个DOS下的可执行文件，
一般用它来检查网络连接的好坏程度。其基本原理是利用TCP/IP协议包中ICMP协
议中的一个功能，即向所指定的计算机发送一个请求，收到请求的计算机返回一
个应答，借此来判断该计算机是否在网上运行或者检查网络连接是否稳定可靠。
在Ping程序执行过程中，双方计算机所耗费的资源都很少，因此，它是一个非常
实用的工具。我们可以通过编程来实现“Ping”操作，对其加以改进，使之具
  首先，对编程中需要的动态链接库作一简要说明：在Windows的System目录下
可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，我们的
1、IcmpCreateFile 　　打开一个句柄，通过该句柄你可以发送ICMP的请求
                      回送报文。
2、IcmpCloseHandle　　关闭你通过IcmpCreateFile函数打开的句柄。
3、IcmpSendEcho   　　通过你打开的句柄发送ICMP请求，在超时或应答报
                      文接收后返回。其参数基本上和它的帧结构一致，
                      可参看下面的程序部分，其具体含意你可以参看有
                      关ICMP协议的书籍。
                      关ICMP协议的书籍。  首先，我们的程序运行后应该有如图1所示的基本功能。为此，我们可先在
　然后，在程序的开始部分（FormCreate）对WinSocket进行初始化，其作用是
               申明使用的版本信息，同时调入Icmp.dll库。
                 　　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:IPOptionInformation;
                    　　 ReplyBuffer: Pointer;
                         ReplySize: DWord;
Timeout: DWord
                ): DWord; stdcall;
                　　 TMyPing = class(TForm)
                    　　 Panel1: TPanel;
                         Label1: TLabel;
                 　　    PingEdit: TEdit;
                 　　    ExeBtn: TButton;
                 　　    ExeBtn: TButton;
                 　　    Button2: TButton;
                 　　    Button3: TButton;
                 　　    StatusShow: TMemo;
                 　　    procedure Button3Click(Sender: TObject);
                 　　    procedure FormCreate(Sender: TObject);
                 　　    procedure ExeBtnClick(Sender: TObject);
                 　　 private  　　 { Private declarations }
                 　　    hICMP: THANDLE;
                　　    IcmpCreateFile : TIcmpCreateFile;
                 　　    IcmpCloseHandle: TIcmpCloseHandle;
                 　　    IcmpSendEcho: TIcmpSendEcho;
                 　　 public  　　 { Public declarations }
                 　　end;  　　
               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  　　
               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;  　　
                   通过上面的编程，我们就实现了Ping功能的界面操作。实际上，
             ICMP协议的功能还有很多，都可以通过对Icmp.dll的函数调用来实现。

function PingHost(HostIP: String): Boolean;
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;
var
  hICMP          : THandle;
  hICMPdll        : THandle;
  IcmpCreateFile  : TIcmpCreateFile;
  IcmpCloseHandle : TIcmpCloseHandle;
  IcmpSendEcho    : TIcmpSendEcho;
  pIPE            : PIcmpEchoReply;// ICMP Echo reply buffer
  FIPAddress      : DWORD;
  FSize          : DWORD;
  FTimeOut        : DWORD;
  BufferSize      : DWORD;
  pReqData,pRevData:PChar;
  MyString:string;
begin
  Result := False;
  hICMPdll := LoadLibrary('icmp.dll');
  if hICMPdll = 0 then exit;  @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');  hICMP := IcmpCreateFile;  if (hICMP = INVALID_HANDLE_VALUE) then exit;  FIPAddress := inet_addr(PChar(HostIP));
  MyString := 'Hello,World';                //send data buffer
  pReqData := PChar(MyString);  FSize := 40;                              //receive data buffer
  BufferSize := SizeOf(TICMPEchoReply) + FSize;
  GetMem(pIPE,BufferSize);
  FillChar(pIPE^, SizeOf(pIPE^), 0);
  GetMem(pRevData,FSize);
  pIPE^.Data := pRevData;  FTimeOut := 4000;
  try
    Result := IcmpSendEcho(hICMP, FIPAddress, pReqData,
                  Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;
  finally
    IcmpCloseHandle(hICMP);
    FreeLibrary(hICMPdll);
    FreeMem(pRevData);
    FreeMem(pIPE);
  end;
end;

在Delphi6中:  Inet_Addr: TInet_AddrProc  = nil;
  //即FIPAddress := inet_addr(PChar(HostIP));不能执行啊！
  //怎么办！！！

我知道为什么上面的代码出错的原因了。
在调用idWinSock.pas的函数之前要对这些函数初始化!
必须调用loadwinsock过程。
即（可以执行的ping函数代码）:unit UnitICMP;interface
uses Windows, Classes;
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: PIcmpEchoReply;
   ReplySize: DWord;
   Timeout: DWord
   ): DWord; stdcall;
   procedure InitICMP(Lines:Tstrings);
   procedure Ping(Host:string; Lines:Tstrings);
var
   hICMP: THANDLE;
   IcmpCreateFile : TIcmpCreateFile;
   IcmpCloseHandle: TIcmpCloseHandle;
   IcmpSendEcho: TIcmpSendEcho;implementation
uses IdWinsock, SysUtils;procedure InitICMP(Lines:Tstrings);//初始化ICMP库函数
var
   // WSAData: TWSAData;
   hICMPdll: HMODULE;
begin
   //WSAStartup($0202, WSAData);
   // Load the icmp.dll stuff  　　
   hICMPdll := LoadLibrary('icmp.dll');
   @ICMPCreateFile := GetProcAddress(hICMPdll,'IcmpCreateFile');
   @IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
   @IcmpSendEcho := GetProcAddress(hICMPdll,'IcmpSendEcho');
   hICMP := IcmpCreateFile;
   Lines.Add('目的IP地址字节数返回时间(毫秒)');
   end;
procedure Ping(Host:string; Lines:Tstrings);
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
      //首先检验是否为合法IP
     if Host <> '' then
     begin
LoadWinsock;//帖子上的几乎所有的关于ping的代码都没有这句。但在Delphi6中是必需的。
FIPAddress := inet_addr(PChar(Host));
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
Lines.Add(Host + ' '+IntToStr(pIPE^.DataSize) +' '+IntToStr(pIPE^.RTT));
end;
FreeMem(pRevData);
FreeMem(pIPE);
  end;
end;  end.

icmp.pas已经贴给你，看http://www.csdn.net/expert/topic/466/466796.shtm
而自己写PING可以不用它，有ICMP.DLL！
仔细看看我的回复！！！已经给你了！！
http://www.csdn.net/expert/topic/466/466796.shtm
http://www.csdn.net/expert/topic/466/466796.shtm

调试易

如何编程实现ping的功能？请帮忙！

解决方案 »