Ping mit Reaktionszeit

[rayj]

Hi,
Ich bin neu hier, hab heute euer Forum durchgesucht, da ich einen Code zum Pingen brauche.

Ziel: Ein Programm, dass etwa 5-10 Ziele anpingt in einem Intervall von 10 Sekunden (mit Timer).
Diese Ziele sind Nodes in unserem Netzwerk (z.B. 1. Router--->Proxy-----inet----->2. Router--->Server). Das Programm überprüft dann alle 10 Sekunden, bis wo die Verbindungen in Ordnung sind, damit wir bei einem Ausfall sofort sehen, wo der Fehler liegt.

Die Reaktionszeit/Antwortszeit sollte auch angezeigt werden (in MS).
Ich habe es mit dem IdIcmpClient versucht, das pingen geht, allerdings krieg ich mit MsRoundTripTime immer 0.

Delphi-Quellcode:

function TForm1.ping(host: string; lbl: string): Boolean;
begin
IcmpClient.Host := host;
try
  IcmpClient.Ping();
  If IcmpClient.ReplyStatus.BytesReceived > 0 then begin
     TLabel(FindComponent(lbl)).Caption := 'OK ' + IntToStr(IcmpClient.ReplyStatus.MsRoundTripTime);
     TLabel(FindComponent(lbl)).Font.color := clGreen;
  end
except
     TLabel(FindComponent(lbl)).Caption := 'FEHLER!' +IntToStr(IcmpClient.ReplyStatus.MsRoundTripTime);
     TLabel(FindComponent(lbl)).Font.color := clRed;
end;
end;

Auch wenn ich das bei IcmpClientReply mache kommt nur 0.

Gut, dann hab ich folgenden Code versucht:

Delphi-Quellcode:

  type
  IPAddr = DWORD;

  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
  ICMP_ECHO_REPLY = packed record
    Address       : ULONG;
    Status        : ULONG;
    RoundTripTime : ULONG;
    DataSize      : WORD;
    Reserved      : WORD;
    Data          : Pointer;
  end;

  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
  IP_OPTION_INFORMATION = packed record
    Ttl         : byte;
    Tos         : byte;
    Flags       : byte;
    OptionsSize : byte;
    OptionsData : Pointer;
  end;


  function IcmpCreateFile : DWORD; stdcall; external 'icmp.dll';
  function IcmpCloseHandle(const IcmpHandle : DWORD) : longbool; stdcall; external 'icmp.dll';
  function IcmpSendEcho(const IcmpHandle : DWORD;const DestinationAddress : IPAddr;const RequestData : Pointer;const RequestSize : WORD;const RequestOptions : PIP_OPTION_INFORMATION;const ReplyBuffer : Pointer;const ReplySize : DWORD;const TimeOut : DWORD) : DWORD; stdcall; external 'icmp.dll';

Aufruf:

Delphi-Quellcode:

procedure TForm2.Button1Click(Sender: TObject);
var
  hICMP    : DWORD;
  pierWork : PICMP_ECHO_REPLY;
  dwSize   : DWORD;

begin
  hICMP := IcmpCreateFile;
  if hICMP = INVALID_HANDLE_VALUE then exit;
  try
    dwSize   := SizeOf(ICMP_ECHO_REPLY)+8;
    pierWork := AllocMem(dwSize);
    try
      if IcmpSendEcho(hICMP,MAKELONG(MAKEWORD(123, 123),MAKEWORD(123, 123)),nil,0,nil,pierWork,dwSize,1000) = 0 then
      begin
        ShowMessage('Nicht gefunden');
      end
      else
      begin
        ShowMessage('Gefunden');
      end;
    finally
      FreeMem(pierWork,dwSize);
    end;
  finally
    IcmpCloseHandle(hIcmp);
  end;
end;

Hab ich hier im Forum gefunden. Leider kommt immer die Nachricht "Gefunden", auch wenn es eine IP 100% nicht gibt

Kann mir einer helfen?

MfG