Mein Netzwerk ping arbeitet irgend wie nicht richtig...
Servus,
habe mir eine einfache Ping funktion gebastelt die per Thread aufgerufen wird. Thread
Delphi-Quellcode:
Ping Funktion
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';
Delphi-Quellcode:
Und einmal mein Replayknecht
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;
Delphi-Quellcode:
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.
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; 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. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:39 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz