Delphi简单调用ping检测网络在线状态

　　Delphi中用ICMP探测远程主机是否存活
　　2005-03-10 jlbnet
　　网络通讯中经常需要确定远程主机是否存活，以决定下一部进行的操作。可以直接使用ICMP协议来实现，但是要考虑许多协议细节，实现起来比较麻烦。Windows 自带的ICMP库里有现成的函数可以使用，只要在使用前填充相应的数据结构就可以了。
　　以下是要使用的数据结构。这些结构MSDN里有C形式的声明，这里给出的是Delphi的形式。
　　//用到的协议数据结构
　　 PIPOptionInfo = ^TIPOptionInfo; // IP 头选项
　　 TIPOptionInfo = packed record
　　 TTL: Byte;//存活时间
　　 TOS: Byte;//Type of Service，请求类型
　　 Flags: Byte;//标志
　　 OptionsSize: Byte;//选项长度
　　 OptionsData: PChar;//选项数据
　　 end;
　　 PIcmpEchoReply = ^TIcmpEchoReply;
　　 TIcmpEchoReply = packed record // ICMP 返回信息
　　 Address: DWORD;//IP地址
　　 Status: DWORD;//状态
　　 RTT: DWORD;
　　 DataSize: Word;//数据长度
　　 Reserved: Word;//保留
　　 Data: Pointer;//数据
　　 Options: TIPOptionInfo;//选项区
　　 end;
　　//动态库中的函数声明
　　 TIcmpCreateFile = function: THandle; stdcall; //创建ICMP句柄
　　 TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall; //关闭ICMP句柄
　　 TIcmpSendEcho = function(IcmpHandle:THandle; DestinationAddress:DWORD;
　　 RequestData:Pointer; RequestSize:Word; RequestOptions:PIPOptionInfo;
　　 ReplyBuffer:Pointer; ReplySize:DWord; Timeout:DWord):DWord; stdcall;//发送ICMP探测数据报
　　//要用到的变量声明
　　 hICMPDll,hICMP:THandle;
　　 wsaData:TWSADATA;
　　 ICMPCreateFile:TICMPCreateFile;
　　 IcmpCloseHandle:TIcmpCloseHandle;
　　 IcmpSendEcho:TIcmpSendEcho;
　　//destip:要探测的远程地址，形如 192.168.1.1
　　procedure f_CheckOnline(destip:string);
　　var
　　 IPOpt:TIPOptionInfo;// 发包的 IP 选项
　　 IPAddr:DWORD;
　　 pReqData,pRevData:PChar;
　　 pIPE:PIcmpEchoReply;// ICMP Echo 回复缓冲区
　　 FSize: DWORD;
　　 MyString:string;
　　 FTimeOut:DWORD;
　　 BufferSize:DWORD;
　　 i:integer;
　　begin
　　 hICMPdll := LoadLibrary('icmp.dll'); //调取icmp 动态库
　　 if hICMPDll<>NULL then
　　 begin
　　 WSAStartup($101,wsaData);//初始化网络协议栈
　　 @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile'); //取动态库中的导出函数
　　 @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
　　 @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
　　 hICMP := IcmpCreateFile; //创建 icmp句柄
　　IPAddr:= inet_addr(PChar(destip)); //取要探测的远端主机ip地址
　　
　　 FSize := 40;
　　 BufferSize := SizeOf(TICMPEchoReply) + FSize;
　　 GetMem(pRevData,FSize);
　　 GetMem(pIPE,BufferSize);
　　 FillChar(pIPE^, SizeOf(pIPE^), 0);
　　 pIPE^.Data := pRevData;
　　 MyString := 'Hi, OnLine?';//任意字符串
　　 pReqData := PChar(MyString);
　　 FillChar(IPOpt, Sizeof(IPOpt), 0);
　　 IPOpt.TTL := 64;
　　 FTimeOut := 500;//等待时长
　　 i:=IcmpSendEcho(hICMP, IPAddr, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);//如果有返回，返回值表示收到的回复的个数。如果为0表示没有回复，主机无法到达
　　 FreeMem(pRevData);
　　 FreeMem(pIPE);
　　 IcmpCloseHandle(hicmp);
　　 FreeLibrary(hICMPdll);//释放动态库
　　 WSAcleanup();//清理协议栈
　　 end;
　　end;

===================================================================================================================================
原帖地址：http://www.wangchao.net.cn/bbsdetail_63221.html

i:=IcmpSendEcho(hICMP, IPAddr, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);//如果有返回，返回值表示收到的回复的个数。如果为0表示没有回复，主机无法到达
f_CheckOnline('192.168.0.1') ;   //192.168.0.1在线，返回为1
f_CheckOnline('192.168.0.2') ;   //192.168.0.2不在线，返回为0
f_CheckOnline('www.google.com') ;  //网关是否连网，永远返回为1
f_CheckOnline('66.249.89.147:') ;  //66.249.89.147是google的IP地址，网关是否连网，永远返回为1

检测内网IP还比较正常，但是检测外网的就不对了。。这个出了什么问题啊？

我想检测当前机器是否处于在线网络状态，如果不能和外网连通，则修改本机网关。如果有比上面这个ping检测更好的办法，也请各位高人说说啊

9 个解决方案

#1

这个很难么……

#2

IPAddr:= inet_addr(PChar(destip)); //取要探测的远端主机ip地址 
inet_addr的自变量只支持IP地址,不支持域名。当自变量为域名或其他任何非IP地址形式的字符串时，它将返回$FFFFFFFF，即相当于255.255.255.255这个IP，然后在后面的IcmpSendEcho时，将一直返回1。

f_CheckOnline('66.249.89.147:') ;  //66.249.89.147是google的IP地址，网关是否连网，永远返回为1 
66.249.89.147后面多了一个冒号， 结果就变得和写域名一样了。

#3

建议修改如下：

function f_CheckOnline(destip:string): Integer;
var
  //ÒªÓõ½µÄ±äÁ¿ÉùÃ÷
  hICMPDll, hICMP  : THandle;
  wsaData          : TWSADATA;
  ICMPCreateFile   : TICMPCreateFile;
  IcmpCloseHandle  : TIcmpCloseHandle;
  IcmpSendEcho     : TIcmpSendEcho;
  IPOpt            : TIPOptionInfo;
  IPAddr           : DWORD;
  pReqData,pRevData: PChar;
  pIPE             : PIcmpEchoReply;
  FSize            : DWORD;
  MyString         : string;
  FTimeOut         : DWORD;
  BufferSize       : DWORD;
  HostEnt          : PHostEnt;
  sIP              : String;
begin
  Result := 0;
  hICMPdll := LoadLibrary('icmp.dll'); 
  if hICMPDll <> NULL then
  begin
    WSAStartup($101,wsaData);
    @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile'); 
    @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
    @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
    hICMP := IcmpCreateFile; 
    IPAddr:= inet_addr(PChar(destip)); //ȡҪ̽²âµÄÔ¶¶ËÖ÷»úipµØÖ·
    if IPAddr = $FFFFFFFF then
    begin
      HostEnt := gethostbyname(PChar(destip));
      if HostEnt <> nil then
        sIP := Format('%d.%d.%d.%d', [Byte(HostEnt^.h_addr^[0]), Byte(HostEnt^.h_addr^[1]),
                  Byte(HostEnt^.h_addr^[2]), Byte(HostEnt^.h_addr^[3])])
      else
        sIP := '';
      IPAddr:= inet_addr(PChar(sIP));
    end;

    FSize := 40;
    BufferSize := SizeOf(TICMPEchoReply) + FSize;
    GetMem(pRevData,FSize);
    GetMem(pIPE,BufferSize);
    FillChar(pIPE^, SizeOf(pIPE^), 0);
    pIPE^.Data := pRevData;
    MyString := 'Hi, OnLine?';
    pReqData := PChar(MyString);
    FillChar(IPOpt, Sizeof(IPOpt), 0);
    IPOpt.TTL := 64;
    FTimeOut := 500;
    Result:=IcmpSendEcho(hICMP, IPAddr, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);
    //Èç¹ûÓзµ»Ø£¬·µ»ØÖµ±íʾÊÕµ½µÄ»Ø¸´µÄ¸öÊý¡£Èç¹ûΪ0±íʾûÓлظ´£¬Ö÷»úÎÞ·¨µ½´ï
    FreeMem(pRevData);
    FreeMem(pIPE);
    IcmpCloseHandle(hicmp);
    FreeLibrary(hICMPdll);
    WSAcleanup();
  end;
end;

#4

似乎是差不多了，测试下就给分~~

#5

郁闷啊……
在ADSL拨号的机器上测试的时候是 连接状态返回1 掉线状态返回0
但是到了其他共享ADSL的机器上还是一直返回1。。。。。

#6

加群：37802783  ，你有一个专门实现Ping的程序。

#7

以后需再关注，现在先帮你顶一下

#8

我也想知道，正在找這方面的資料~~~~~

#9

学习学习。