delphi中利用winsock判断是否ping通某IP

来源：互联网发布：热血无赖优化编辑：程序博客网时间：2024/05/20 16:40

突然要用到如题功能，自己在网上搜了下，自己写了个小Demo，以备以后不时之需。。。

特此鸣谢资料一：http://hi.baidu.com/654474209/blog/item/77b28224e95dae1e8a82a1ac.html

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 :=1000;
   try
   Result :=IcmpSendEcho(hICMP,FIPAddress,pReqData,
   Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;
   finally
   IcmpCloseHandle(hICMP);
   FreeLibrary(hICMPdll);
   FreeMem(pRevData);
   FreeMem(pIPE);
   end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
  IP:String;
  flag:Boolean;
begin
  IP:='192.168.3.1';
  flag:=PingHost(IP);
  if flag=true then
   MessageBox(0,'pingÍ¨','ÌáÊ¾',MB_ICONASTERISK and MB_ICONINFORMATION)
  else
   MessageBox(0,'ping²»Í¨','ÌáÊ¾',MB_ICONASTERISK and MB_ICONINFORMATION);

end;

PS:在引用单元中加入winsock。。。