function Ping(IP :String) :String;
const
  BUFSIZE = 2000;

var
  SecAttr     :TSecurityAttributes;
  hReadPipe   :THandle;
  hWritePipe  :THandle;
  StartupInfo :TStartUpInfo;
  ProcessInfo :TProcessInformation;
  Buffer      :PAnsiChar;
  WaitReason  :DWord;
  BytesRead   :DWord;

begin

 Result := '';

 with SecAttr do begin
   nLength              := SizeOf(TSecurityAttributes);
   bInheritHandle       := True;
   lpSecurityDescriptor := nil;
 end; { with }

 if CreatePipe(hReadPipe, hWritePipe, @SecAttr, 0) then begin

   Buffer := AllocMem(BUFSIZE + 1);

   try

     FillChar(StartupInfo, SizeOf(StartupInfo), #0);
     StartupInfo.cb          := SizeOf(StartupInfo);
     StartupInfo.hStdOutput  := hWritePipe;
     StartupInfo.hStdInput   := hReadPipe;
     StartupInfo.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
     StartupInfo.wShowWindow := SW_HIDE;

     if CreateProcess(nil, PChar('ping.exe '+IP),
        @SecAttr, @SecAttr, True, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then begin

       try

         repeat
           WaitReason := WaitForSingleObject(ProcessInfo.hProcess, 100);
           Application.ProcessMessages;
         until (WaitReason <> WAIT_TIMEOUT);

         repeat
           BytesRead := 0;
           ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);
           Buffer[BytesRead]:= #0;
           OemToAnsi(Buffer,Buffer);
           Result := Result + String(Buffer);
         until (BytesRead < BUFSIZE);

       finally
         CloseHandle(ProcessInfo.hProcess);
         CloseHandle(ProcessInfo.hThread);
       end; { try ... finally }

     end; { if }

   finally
     CloseHandle(hReadPipe);
     CloseHandle(hWritePipe);
     FreeMem(Buffer);
   end; { try ... finally }

 end; { if }

end; { Ping }