求ping程序的源代码。。。！

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 := 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;