delphi ping操作

【核心代码】

uses
winsock;
////////////////
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(PAnsiChar(AnsiString(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;