盒子论坛 v2.1

从别的坛子发现的，放这吧，万一有人能用上。

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';          //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   := 2000;
        try
          Result   :=   IcmpSendEcho(hICMP,   FIPAddress,   pReqData,
          Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;
        finally
          IcmpCloseHandle(hICMP);
          FreeLibrary(hICMPdll);
          FreeMem(pRevData);
          FreeMem(pIPE);
        end;
  end;
----------------------------------------------
-

作者：

qingyun (qingyun)	★☆☆☆☆	-
	盒子活跃会员

2016/9/30 23:08:00

1楼：

上面代码编译不过去，
inet_addr 找不到；
----------------------------------------------
青云论坛

作者：

axfx (axfx)	▲▲▲▲▲	-
	普通会员

2016/10/2 20:21:05

2楼：

建议不要使用icmp.dll，在win7里面ping不通。
----------------------------------------------
超低价出售pos/进销存/收银软件源码
https://item.taobao.com/item.htm?spm=a21dvs.23580594.0.0.4fee645eC26dvB&ft=t&id=671027238807

信息

登陆以后才能回复