Ping WMI-Remote-Ping-Sensor

Der WMI-Remote-Ping-Sensor stellt über Windows Management Instrumentation (WMI) eine Remote-Verbindung zu einem Windows-System her und führt von diesem Gerät eine Internet Control Message Protocol (ICMP)-Echoanforderung („Ping“) an ein angegebenes Ziel aus.

uses ActiveX, ComObj

//

function GetStatusCodeStr(statusCode:integer) : string;
begin
  case statusCode 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:='Unknow';
  end;
end;

procedure  Ping(const Address:string;Retries,BufferSize:Word);
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  i             : Integer;

  PacketsReceived : Integer;
  Minimum         : Integer;
  Maximum         : Integer;
  Average         : Integer;
begin;
  PacketsReceived:=0;
  Minimum        :=0;
  Maximum        :=0;
  Average        :=0;

  Form1.Memo1.Lines.Add(Format('Pinging %s with %d bytes of data:',
                        [Address,BufferSize]));
  
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  //FWMIService   := FSWbemLocator.ConnectServer('192.168.52.130',
   //                'root\CIMV2', 'user', 'password');
  for i := 0 to Retries-1 do
  begin
    FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM Win32_PingStatus where Address=%s AND BufferSize=%d',
                                          [QuotedStr(Address),BufferSize]),'WQL',0);

    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;

    if oEnum.Next(1, FWbemObject, iValue) = 0 then
    begin
      if FWbemObject.StatusCode=0 then
      begin
        if FWbemObject.ResponseTime>0 then
        Form1.Memo1.Lines.Add(Format('Reply from %s: bytes=%s time=%sms TTL=%s',
                                    [FWbemObject.ProtocolAddress,
                                    FWbemObject.ReplySize,
                                    FWbemObject.ResponseTime,
                                    FWbemObject.TimeToLive]))

          //Writeln(Format('Reply from %s: bytes=%s time=%sms TTL=%s',
          //              [FWbemObject.ProtocolAddress,
          //              FWbemObject.ReplySize,
          //              FWbemObject.ResponseTime,
          //              FWbemObject.TimeToLive]))

        else
        Form1.Memo1.Lines.Add(Format('Reply from %s: bytes=%s time= < 1ms TTL=%s',
                             [FWbemObject.ProtocolAddress,
                             FWbemObject.ReplySize,
                             FWbemObject.TimeToLive]));

        //Writeln(Format('Reply from %s: bytes=%s time= < 1ms TTL=%s',
        //               [FWbemObject.ProtocolAddress,
        //               FWbemObject.ReplySize,
        //               FWbemObject.TimeToLive]));

        Inc(PacketsReceived);

        if FWbemObject.ResponseTime>Maximum then
        Maximum:=FWbemObject.ResponseTime;

        if Minimum=0 then
        Minimum:=Maximum;

        if FWbemObject.ResponseTime < Minimum then
        Minimum:=FWbemObject.ResponseTime;

        Average:=Average+FWbemObject.ResponseTime;

      end
      else
      if not VarIsNull(FWbemObject.StatusCode) then
      Form1.Memo1.Lines.Add(Format('Reply from %s: %s',
                           [FWbemObject.ProtocolAddress,
                           GetStatusCodeStr(FWbemObject.StatusCode)]))

      //Writeln(Format('Reply from %s: %s',
      //              [FWbemObject.ProtocolAddress,
      //              GetStatusCodeStr(FWbemObject.StatusCode)]))
      else
      Form1.Memo1.Lines.Add(Format('Reply from %s: %s',
                           [Address,'Error processing request']));

      //Writeln(Format('Reply from %s: %s',[Address,'Error processing request']));
    end;
    FWbemObject:=Unassigned;
    FWbemObjectSet:=Unassigned;
    //Sleep(500);
  end;

  //Writeln('');
  Form1.Memo1.Lines.Add(Format('Ping statistics for %s:',[Address]));
  Form1.Memo1.Lines.Add(Format('    Packets: Sent = %d, Received = %d, Lost = %d (%d%% loss),',
                               [Retries,PacketsReceived,
                               Retries-PacketsReceived,
                               Round((Retries-PacketsReceived)*100/Retries)]));

  //Writeln(Format('Ping statistics for %s:',[Address]));
  //Writeln(Format('    Packets: Sent = %d, Received = %d, Lost = %d (%d%% loss),',
  //              [Retries,PacketsReceived,
  //               Retries-PacketsReceived,
  //               Round((Retries-PacketsReceived)*100/Retries)]));

  if PacketsReceived > 0 then
  begin
  Form1.Memo1.Lines.Add('Approximate round trip times in milli-seconds:');
   //Writeln('Approximate round trip times in milli-seconds:');

   Form1.Memo1.Lines.Add(Format('    Minimum = %dms, Maximum = %dms, Average = %dms',
                         [Minimum,Maximum,Round(Average/PacketsReceived)]));
   //Writeln(Format('    Minimum = %dms, Maximum = %dms, Average = %dms',
   //        [Minimum,Maximum,Round(Average/PacketsReceived)]));
  end;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
 try
    CoInitialize(nil);
    try
      //Ping('192.168.0.1',4,32);
      Ping('google.com',10,32);

    finally
      CoUninitialize;
    end;
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
end;