Ping und Daten Verwerten

[Kalfany]

Zitat von DeddyH:

...der Code scheint eher eine Art Traceroute durchzuführen (wozu sonst Hopcount?).

schaut so aus, würde auch erklären warum das so lange dauert

[gasty]

Hab jetz Delphi komplett neu installt und gesehn das hat schon indy drin *omg*
is wahrscheinlich v9 oder so, also denke ich hab ichs mit dem installen von v10 nur kaputt gemacht.
Und der befehl ist glaube ich IdIcmpClient1.Ping(); Nur wie mach ich das jetzt dass sich das kästchen entsprechend färbt, ich hab ja kein wert der true oder false zurückgibt, oder sitzt das problem nur wieder einmal vor dem pc?

[DeddyH]

Ist immer schwierig zu beantworten, wenn man die Kompos gerade selbst nicht hat. Also, entweder ist Ping eine Funktion oder es gibt ein Event, das bei Antwort ausgelöst wird (OnResponse oder so).

[Kalfany]

Delphi-Quellcode:

  IdIcmpClient.Host := Host;
  IdIcmpClient.TTL := TTL; //Time to live
  IdIcmpClient.ReceiveTimeout := 5000;
  IdIcmpClient.Ping;
  case IdIcmpClient.ReplyStatus.ReplyStatusType of
    rsEcho:
      begin
        lbLog.Items.Append(format('response from host %s in %d millisec.',
        [IdIcmpClient.ReplyStatus.FromIpAddress,
        IdIcmpClient.ReplyStatus.MsRoundTripTime]));
        result := true;
      end;
    rsError:
      lbLog.Items.Append('Unknown error.');
    rsTimeOut:
      lbLog.Items.Append('Timed out.');
    rsErrorUnreachable:
      lbLog.Items.Append(format('Host %s reports destination network unreachable.',
      [IdIcmpClient.ReplyStatus.FromIpAddress]));
    rsErrorTTLExceeded:
      lbLog.Items.Append(format('Hope %d %s: TTL expired.',
      [IdIcmpClient.TTL, IdIcmpClient.ReplyStatus.FromIpAddress]));
  end; // case

Quelle: delphi-treff.de

[gasty]

Ok, so kann ich 1 ping ausführen, klappt auch
Nur wie mach ich das jetz mit der liste von adressen?

Mein bisheriger Versuch sieht so aus, was aber nicht funktioniert:

Delphi-Quellcode:

  x := 1;
  if x = 1 then
    begin
      IdIcmpClient1.Host := 'www.microsoft.com';
      IdIcmpClient1.Ping();
      case IdIcmpClient1.ReplyStatus.ReplyStatusType of
        rsEcho:
          begin
            shape1.brush.color := cllime;
          end;
      else shape1.brush.color := clred;
      x := 2;
      end;
    end;
  if x = 2 then
    begin
      IdIcmpClient1.Host := 'www.google.de';
      IdIcmpClient1.Ping();
      case IdIcmpClient1.ReplyStatus.ReplyStatusType of
        rsEcho:
          begin
            shape2.brush.color := cllime;
          end;
      else shape2.brush.color := clred;
      x := 0;
      end;
    end;

[DeddyH]

Und was funktioniert nicht? Wieso wird x ständig gesetzt und gleich darauf wieder abgefragt? Irgendwie etwas sinnlos, was Du da machst.

[gasty]

hm dann eben ohne x
Aber das was nicht funktioniert ist, es wird nur das erste shape gefärbt, das zweite bleibt weiß

[DeddyH]

Klar bleibt das weiß. Schau mal genau, wo Du x auf 2 setzt und wozu das end dahinter gehört.

[gasty]

Ah danke
Jetz funktioniert alles

Danke an alle die geholfen haben

[DeddyH]

Versuch es mal so:

Delphi-Quellcode:

procedure GetPingSuccess(const URL: string; const Shape: TShape);
begin
  IdIcmpClient1.Host := URL;
  IdIcmpClient1.Ping();
  case IdIcmpClient1.ReplyStatus.ReplyStatusType of
    rsEcho: Shape.brush.color := cllime;
    else    Shape.brush.color := clred; 
  end;
  Application.Processmessages;
end;

procedure TYourForm.Something;
begin
  GetPingSuccess('www.microsoft.de',Shape1);
  GetPingSuccess('www.google.de',Shape2);
end;