Delphi XE6 实现Ping的功能


介绍

本代码实现了windows的ping的功能,通过使用icmp.dll里的IcmpSendEcho()函数,来发送Ping命令,具体代码:

function TPing.PingHost(IP: string; var RTT: DWORD; TTL: Byte = 64; TimeOut: DWORD = 4000): Integer;
var
 // IP Options for packet to send
 IPOpt: TIPOptionInformation;
 FIPAddress: DWORD;
 pReqData, pRevData: PAnsiChar;
 // ICMP Echo reply buffer
 pIPE: PIcmpEchoReply;
 FSize: DWORD;
 MyString: AnsiString;
 FTimeOut: DWORD;
 BufferSize: DWORD;
 OpResult: DWORD;
begin
 Result := -1;
 RTT := 0;
 if ip <> '' then
 begin
 FIPAddress := inet_addr(MarshaledAString(AnsiString(IP)));
 FSize := 30;
 BufferSize := SizeOf(TIcmpEchoReply) + FSize;
 GetMem(pRevData, FSize);
 GetMem(pIPE, BufferSize);
 FillChar(pIPE^, SizeOf(pIPE^), 0);
 pIPE^.DataPtr := pRevData;
 MyString := 'Test Net - Sos Admin';
 pReqData := PAnsiChar(MyString);
 FillChar(IPOpt, SizeOf(IPOpt), 0);
 IPOpt.TTL := TTL;
 FTimeOut := TimeOut;
 try
 OpResult := IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);
 Result := PIPE.Status;
 if pIPE.Status = 0 then
 RTT := PIPE.RTT;
 except
 Result := -2;
 FreeMem(pRevData);
 FreeMem(pIPE);
 Exit;
 end;
 FreeMem(pRevData);
 FreeMem(pIPE);
 end;

end;

联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678