Mein Netzwerk ping arbeitet irgend wie nicht richtig...

[Jackie1983]

Servus,

habe mir eine einfache Ping funktion gebastelt die per Thread aufgerufen wird.
Thread

Delphi-Quellcode:

          for i:=0 to High(DeviceArray) do
          begin
            PingResult := PingDeviceByIP(DeviceArray[i].Name, 1500, 4);
            PingPakete := PingResult.recResPakete;

            //Offline
            Status := '0';
            //Online
            if PingPakete > 0 then
              Status := '2';

Ping Funktion

Delphi-Quellcode:

Function PingDeviceByIP(ADeviceIP : string; ATimeOut : integer = 3000;APingCount : integer = 4) : rPingResult;
var
  s : string;
  IdIcmp : TIdIcmpClient;
  rk : TReplayKnecht;
  i,count  : integer;
begin
  IdIcmp := TIdIcmpClient.Create(nil);
  rk := TReplayKnecht.Create;
  try
    count := 0;
    for i := 1 to length(ADeviceIP) do
      if ADeviceIP[i] = '.' then inc(count);

    if count <> 4 then
      ADeviceIP :=GetIPFromHost(ADeviceIP);

    rk.fHost := ADeviceIP;
    IdIcmp.Host := ADeviceIP;
    IdIcmp.ReceiveTimeout := ATimeOut;
    IdIcmp.OnReply := rk.IdIcmpReply;
    try
      rk.fPaketeEmpfangen := 0;
      rk.fResponseTimeLow  := High(integer);
      rk.fResponseTimeHigh := 0;
      rk.fResponseAll := 0;

      for i:=0 to APingCount-1 do
      begin
        IdIcmp.Ping;
        sleep(100);
      end;
      result.recResPakete := rk.fPaketeEmpfangen;
      // rest vom result
    except
      result.recResponseAll := 0;
      result.recResPakete   := 0;
      exit;
    end;
    case IdIcmp.ReplyStatus.ReplyStatusType of
      rsErrorUnreachable : result.recResPakete := 0;
      rsTimeOut          : result.recResPakete := 0;
    end;
  finally
    FreeAndNil(IdIcmp);
    FreeAndNil(rk);
  end;
end;

Und einmal mein Replayknecht

Delphi-Quellcode:

procedure TReplayKnecht.IdIcmpReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  Response : integer;
begin
  if AReplyStatus.ReplyStatusType = rsTimeOut then exit;
  if AReplyStatus.FromIpAddress = '' then exit;

  if AReplyStatus.FromIpAddress = fHost then
    fPaketeEmpfangen := fPaketeEmpfangen + 1
end;

Wenn ich per cmd ein ping auf www.google.de mache, alles ok. Wenn ich das aber hier über die Funktion laufen lasse, bekomme ich hier und da mal das das Gerät offline ist, also keine Pakete zurück gesendet hat. Nur das kann nicht sein die geräte sind Online, was meint ihr? TimeOut zu kurz oder ein Fehler in der Funktion, weis nicht wo da was falsch sein kann.

schonmal thx

[Edit]
eventuell muss ich noch dazu sagen das das meistens bei externen geräten Probleme macht. Teste das zum Beispiel mit irgend welchen Webservern, z.B. Google.