Versión de ping con estadísticas precisas y detalladas

Puede descargar el ejecutable desde aquí.

Ping_Log ya que la ubicación anterior ya no es válida.

Aquí está la fuente de uno que escribí recientemente. Lo estoy declarando de código abierto.

{ Log Pings }
program PING_LOG;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  ActiveX,
  ComObj,
  Variants,
  Vcl.Graphics,
  Windows;

const
  Version   = '1.0';
  CopyRight = '(C) Copyright 2015 by Blue Pacific Software';
  Contact   = 'rohitguptanz@gmail.com';
  Name      = 'Ping Log';
  sCRLF     = #$0D#$0A;

resourcestring
  msg_Ping_Help = sCRLF +
                  'Ping_Log [Options] Address' + sCRLF + sCRLF +
                  '/Cnn  = Ping nn times in a Cluster (default 1)' + sCRLF +
                  '/CAnn = Ping nn times in a Cluster and Average (default 0)' + sCRLF +
                  '/Rnn  = Ping every nn seconds (default 5)' + sCRLF +
                  '/Fnn  = For nn hours (default 0)' + sCRLF +
                  '/Bnn  = Buffer Size in bytes (default 32)' + sCRLF +
                  '/S    = Silent Mode (default Verbose)' + sCRLF +
                  '/Oxx  = Output to File xx (default none)' + sCRLF;
  msg_Ping_Waiting  = 'Please press ENTER';
  msg_Ping_Info     = sCRLF + 'Pinging %s with %d bytes of data:';
  msg_Ping_Reply_Lt = 'Reply from %s: bytes=%s time=<1ms TTL=%s';
  msg_Ping_Reply_Eq = 'Reply from %s: bytes=%s time=%sms TTL=%s';
  msg_Ping_Reply    = 'Reply from %s: %s';
  err_Proc_Rqst     = 'Error processing request';
  msg_Ping_Options  = 'Options : ';
  msg_Ping_Cluster  = '%d samples ';
  msg_Ping_Average  = 'averaged  ';
  msg_Ping_Sleep    = 'every %f seconds ';
  msg_Ping_Duration = 'for %d hours  ';
  msg_Ping_Output   = 'output to file "%s"';
  msg_Ping_Abort    = sCRLF + 'To abort at next ping, press Enter and wait.';

const
  fmt_Hdr = '%s [%s]  %s ' + sCRLF + 'Contact %s' + sCRLF;

var
  Address     : string  = '';
  Cluster     : Integer = 1;
  Average     : Boolean = False;
  SleepMs     : Integer = 5;
  DurationHrs : Integer = 0;
  DurationDays: Single  = 0;
  BufferSize  : Integer = 32;
  Verbose     : Boolean = True;
  OutputTo    : string  = '';
  Logging     : Boolean = False;
  Log_File    : Text;

function KeyPressed : Boolean;
var
  lpNumberOfEvents     : DWORD;
  lpBuffer             : TInputRecord;
  lpNumberOfEventsRead : DWORD;
  nStdHandle           : THandle;
begin
  Result := False;
  { Get the console handle }
  nStdHandle := GetStdHandle (STD_INPUT_HANDLE);
  lpNumberOfEvents := 0;
  { Get the number of events }
  GetNumberOfConsoleInputEvents (nStdHandle, lpNumberOfEvents);
  if lpNumberOfEvents <> 0
  then begin
       { Retrieve the event }
       PeekConsoleInput (nStdHandle,lpBuffer,1,lpNumberOfEventsRead);
       if lpNumberOfEventsRead <> 0
       then begin
            { Result is True if it is a Keyboard Event and
              a Key was pressed }
            if lpBuffer.EventType = KEY_EVENT
            then begin
                 if lpBuffer.Event.KeyEvent.bKeyDown
                 then Result := True
                 else FlushConsoleInputBuffer (nStdHandle);
            end
            else FlushConsoleInputBuffer (nStdHandle);
       end;
  end;
end;

function Get_Params : Boolean;
var
  lIdx    : Integer;
  lParams : Integer;
  lCmd    : char;
  lArg    : string;
begin
  Result := False;
  Writeln (Format (fmt_Hdr, [Name, Version, CopyRight, Contact]));
  lParams := ParamCount;
  for lIdx := 1 to lParams
  do begin
     lArg := ParamStr (lIdx);
     if length(lArg) >= 2
     then if lArg[1] in ['/','-','\']
     then begin
          Delete (lArg,1,1);
          lCmd := UpCase (lArg[1]);
          Delete (lArg,1,1);
          case lCmd of
            'C' : begin
                    if length(lArg) > 1
                    then if UpCase (lArg[1]) = 'A'
                    then begin
                         Delete (lArg,1,1);
                         Average := True;
                    end;
                    Cluster := StrToInt (lArg);
                  end;
            'R' : SleepMs := StrToInt (lArg) * 1000;
            'F' : DurationHrs := StrToInt (lArg);
            'S' : Verbose := False;
            'O' : OutputTo := lArg;
          end;
     end
     else Address := lArg;
  end;
  if (lParams = 0) or (Address = '')
  then begin
       Writeln (msg_Ping_Help);
       Write (msg_Ping_Waiting);
       ReadLn;
       Result := False;
  end;
  DurationDays := Round (DurationHrs) / HoursPerDay;
  Result := True;
end;

procedure Close_File;
begin
  if (OutputTo > '') and Logging
  then CloseFile (Log_File);
end;

function ConsoleEventProc (CtrlType : DWORD) : BOOL; stdcall;
begin
  if (CtrlType = CTRL_CLOSE_EVENT)
  then begin
       Close_File;
  end;
  Result := True;
end;

function GetStatusCodeStr (AStatusCode : integer) : string;
begin
  case AStatusCode of
    0     : Result := 'Success';
    11001 : Result := 'Buffer Too Small';
    11002 : Result := 'Destination Net Unreachable';
    11003 : Result := 'Destination Host Unreachable';
    11004 : Result := 'Destination Protocol Unreachable';
    11005 : Result := 'Destination Port Unreachable';
    11006 : Result := 'No Resources';
    11007 : Result := 'Bad Option';
    11008 : Result := 'Hardware Error';
    11009 : Result := 'Packet Too Big';
    11010 : Result := 'Request Timed Out';
    11011 : Result := 'Bad Request';
    11012 : Result := 'Bad Route';
    11013 : Result := 'TimeToLive Expired Transit';
    11014 : Result := 'TimeToLive Expired Reassembly';
    11015 : Result := 'Parameter Problem';
    11016 : Result := 'Source Quench';
    11017 : Result := 'Option Too Big';
    11018 : Result := 'Bad Destination';
    11032 : Result := 'Negotiating IPSEC';
    11050 : Result := 'General Failure'
    else
    Result := 'Unknown';
  end;
end;


{ The form of the Address parameter can be either the
  computer name (wxyz1234),
  IPv4 address (192.168.177.124), or
  IPv6 address (2010:836B:4179::836B:4179).}
function Ping (const AAddress : string;
               const ARetries, ABufferSize : Word)
              : Single;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  i             : Integer;

  lPacketsReceived : Integer;
  lResponse        : Integer;
  lMinimum         : Integer;
  lMaximum         : Integer;
  lAverage         : Integer;
begin;
  lPacketsReceived := 0;
  lMinimum         := 0;
  lMaximum         := 0;
  lAverage         := 0;
  lResponse        := 0;
  if Verbose
  then Writeln (Format(msg_Ping_Info,[AAddress,ABufferSize]));
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  for i := 0 to ARetries-1 do
  begin
    FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM Win32_PingStatus where Address=%s AND BufferSize=%d',[QuotedStr(AAddress),ABufferSize]),'WQL',0);
    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
    if oEnum.Next(1, FWbemObject, iValue) = 0
    then begin
         if FWbemObject.StatusCode = 0
         then begin
              if Verbose
              then begin
                 if FWbemObject.ResponseTime > 0
                 then Writeln (Format(Msg_Ping_Reply_Eq,
                      [FWbemObject.ProtocolAddress,FWbemObject.ReplySize,
                       FWbemObject.ResponseTime,FWbemObject.TimeToLive]))
                 else Writeln (Format(msg_Ping_Reply_lt,
                      [FWbemObject.ProtocolAddress,FWbemObject.ReplySize,
                       FWbemObject.TimeToLive]));
              end;

              Inc (lPacketsReceived);
              lResponse := FWbemObject.ResponseTime;

              if lResponse > lMaximum
              then lMaximum := lResponse;
              if lMinimum = 0
              then lMinimum := lMaximum;
              if lResponse < lMinimum
              then lMinimum := lResponse;

              lAverage := lAverage+lResponse;
         end
         else begin
              if not VarIsNull(FWbemObject.StatusCode)
              then Writeln (Format(msg_Ping_Reply,
                    [FWbemObject.ProtocolAddress,
                     GetStatusCodeStr(FWbemObject.StatusCode)]))
              else Writeln (Format(msg_Ping_Reply,
                    [AAddress,err_Proc_Rqst]));
         end;
    end;
    FWbemObject := Unassigned;
    FWbemObjectSet := Unassigned;
    //Sleep(500);
  end;
  if lPacketsReceived > 0
  then lAverage := Round(lAverage/lPacketsReceived);
  if Verbose
  then begin
       Writeln ('');
       Writeln (Format('Ping statistics for %s:',[AAddress]));
       Writeln (Format('    Packets: Sent = %d, Received = %d, Lost = %d (%d%% loss),',
                [ARetries,lPacketsReceived,ARetries-lPacketsReceived,
                 Round((ARetries-lPacketsReceived)*100/ARetries)]));
       if lPacketsReceived > 0
       then begin
            Writeln ('Approximate round trip times in milli-seconds:');
            Writeln (Format('    Minimum = %dms, Maximum = %dms, Average = %dms',
                     [lMinimum,lMaximum,lAverage]));
       end;
  end;
  if Average
  then Result := lAverage
  else Result := lResponse;
end;

var
  lValue  : Single;
  lExpiry : TDateTime;
begin
 try
    if not Get_Params
    then Exit;
    { Open File If Required }
    if OutputTo <> ''
    then begin
         AssignFile (Log_File, OutputTo);
         if FileExists (OutputTo)
         then Append (Log_File)
         else Rewrite (Log_File);
         Logging := True;
         { Handle Close Event }
         SetConsoleCtrlHandler (@ConsoleEventProc, True);
    end;
    { Initaiize OLE }
    CoInitialize (nil);
    lExpiry  := Now + DurationDays;
    { Tell User the options }
    Write (msg_Ping_Options);
    if Cluster > 0
    then Write (Format (msg_Ping_Cluster, [Cluster]));
    if Average
    then Write (msg_Ping_Average);
    if SleepMs > 0
    then Write (Format (msg_Ping_Sleep, [Round (SleepMs) / 1000]));
    if DurationHrs > 0
    then Writeln (Format (msg_Ping_Duration, [DurationHrs]));
    if OutputTo <> ''
    then Writeln (Format (msg_Ping_Output, [OutputTo]));
    Writeln (msg_Ping_Abort);

    try
      repeat
        lValue := Ping (Address,Cluster,BufferSize);
        if OutputTo <> ''
        then Writeln (Log_File, '"' +
                      DateTimeToStr (Now) + '", ' +
                      FloatToStr (lValue));
        Sleep (SleepMs);
      until (Now >= lExpiry) or KeyPressed
    finally
      CoUninitialize;
      { Close File If Required }
      Close_File;
    end;
 except
    on E:Exception do
        Writeln (E.Classname, ':', E.Message);
 end;
 Readln;
end.