Pingen funktioniert nicht

[fr0g]

Hallo User

Ich habe ein Programm in Delphi programmiert womit man Nachrichten hin und her schicken kann (über Netzwerk). Dazu habe ich die Indy10 Komponenten idTcpServer und Client genommen. Mit den Nachrichten hin und her schicken funktioniert einwandfrei.

Die Programm besteht teilweise aus Client und Server!

Jetzt möchte ich, um den Online-Status abzufragen die anderen Programme (IPs) anpingen. Bei mir zu Hause läuft ein Teil des Programms auf der IP 192.168.0.1. Wenn ich jetzt von einer anderen IP diese IP anpinge kommt als Rück meldung immer nur 0.0.0.0 zurück. Zum Pingen wollte ich den IdicmpClient benutzen.

Delphi-Quellcode:

procedure TFicyou.Button1Click(Sender: TObject);
begin
ping.Host:='192.168.0.1';
ping.ping;
showmessage(ping.replystatus.fromipaddress);
end;

Hab glaub ich hab jetzt schon das Gnaze DP Forum durch ^^. Hat jemand eine Idee warum das ganze nicht klappt? bzw. was ich ändern muss?

mfg fr0g

[halinchen]

Kommt ein Fehler?

Ich hatte nämlich so ein ähnliches Problem und habe rausgefunden:
der IdicmpClient braucht irgentwelche RAW-Rechte. -> Man muss Administrator sein. :(

Vielleicht hilft es dit ja. :mrgreen:

[fr0g]

Nein es kommen keine Fehlermeldungen. Es kommt nur die Message wo mir die IP 0.0.0.0 angezeigt wird.

P.S.: Bin ja Administrator :???:

[BBoy]

Habe genau das selbe Problem!! Will mein Netzwerk mit PINGs scannen, aber das resultat ist immer IP 0.0.0.0, egal welchenn Host ich eingebe (zb. 192.168.2.35). Wenn ich WWW Ips eingebe funzt es wunderbar, nur bei lokal hosts nicht.

Weis jemand eine Lösung??

[Tormentor32]

Kommt die Antwort des Pings nicht im OnReply Ereignis?

[freak4fun]

Edit: Wer lesen kann ist klar im Vorteil. Sry. :?
MfG
freak

[BBoy]

Ja, die antwort kommt in OnReply. bin auch mit Adminrecchten angemeldet, funzt aber trotzdem nicht.

[Tormentor32]

Zeig mal deinen Code aus dem OnReply Ereignis!

[Relicted]

hiho..

ich hab das damals mit ner seperaten unit gelöst...

Delphi-Quellcode:

unit Ping;

interface
uses
  Windows, SysUtils, Classes;

type
  TSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TSunW = packed record
    s_w1, s_w2: word;
  end;

  PIPAddr = ^TIPAddr;
  TIPAddr = record
    case integer of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  end;

 IPAddr = TIPAddr;

  function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
  function IcmpCloseHandle (icmpHandle : THandle) : boolean;
            stdcall; external 'icmp.dll'
  function IcmpSendEcho
    (IcmpHandle : THandle; DestinationAddress : IPAddr;
     RequestData : Pointer; RequestSize : Smallint;
     RequestOptions : pointer;
     ReplyBuffer : Pointer;
     ReplySize : DWORD;
     Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';


  function Ping(InetAddress : string) : boolean;

implementation

uses
  WinSock;

function Fetch(var AInput: string; 
                      const ADelim: string = ' '; 
                      const ADelete: Boolean = true) : string;
var
  iPos: Integer;
begin
  if ADelim = #0 then begin
    // AnsiPos does not work with #0
    iPos := Pos(ADelim, AInput);
  end else begin
    iPos := Pos(ADelim, AInput);
  end;
  if iPos = 0 then begin
    Result := AInput;
    if ADelete then begin
      AInput := '';
    end;
  end else begin
    result := Copy(AInput, 1, iPos - 1);
    if ADelete then begin
      Delete(AInput, 1, iPos + Length(ADelim) - 1);
    end;
  end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
  phe: PHostEnt;
  pac: PChar;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  try
    phe := GetHostByName(PChar(AIP));
    if Assigned(phe) then
    begin
      pac := phe^.h_addr_list^;
      if Assigned(pac) then
      begin
        with TIPAddr(AInAddr).S_un_b do begin
          s_b1 := Byte(pac[0]);
          s_b2 := Byte(pac[1]);
          s_b3 := Byte(pac[2]);
          s_b4 := Byte(pac[3]);
        end;
      end
      else
      begin
        raise Exception.Create('Error getting IP from HostName');
      end;
    end
    else
    begin
      raise Exception.Create('Error getting HostName');
    end;
  except
    FillChar(AInAddr, SizeOf(AInAddr), #0);
  end;
  WSACleanup;
end;

function Ping(InetAddress : string) : boolean;
var
 Handle : THandle;
 InAddr : IPAddr;
 DW : DWORD;
 rep : array[1..128] of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then
   Exit;
  TranslateStringToTInAddr(InetAddress, InAddr);
  DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
  Result := (DW <> 0);
  IcmpCloseHandle(Handle);
end;

end.

ich hoffe mal die unit funzt noch hab die schon ewig ned mehr angepackt...

einfach mit Ping( ) aufrufen und dann bekommst das ergebnis zurück :-)
die reply zeit habe ich nicht mit drin aber es reicht für dich ja zu wissen ob da oder nicht so wie ich das verstanden habe

gruß
reli

[TeronG]

Ist das "dein" Netz oder bist du "nur" user mit Adminrechten!?

Kannte mal Spaßvogel, der das Pingen intern "deaktivierte" ... und selbst hab ich mir im Heimnetz schon mal n Bein gestellt, weil ich Gateway und SubnetMask vergessen hatte (richtig) einzugeben (kein DHCP) :wall: aber da der rest wohl get wird's wohl daran nicht liegen ^^

[Sharky]

Hai fr0g,

ich habe mal schnell diesen Code getippt und kann ohne Probleme "pingen".

Delphi-Quellcode:

procedure TDemo_Form.Button1Click(Sender: TObject);
begin
  ping.Host := '192.168.11.1';
  ping.ping;
end;

procedure TDemo_Form.pingReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
  showmessage(AReplyStatus.fromipaddress);
end;

Ein "0.0.0.0" bekomme ich nur zurück wenn ich keine Antwort erhalte.
Kannst Du die Rechner denn "ganz normal" anpingen? Nicht das dort die XP-Firewall aktiv ist und darum keine Antwort auf deinen Ping kommt.

BTW: Ich würde nicht mit einem Ping getesten. Dies sagt dir ja nur ob der andere Rechner eingeschaltet ist und seine Netzwerkverbindung funktioniert.

Besser wäre es doch wenn dein Programm das ganze auswertet.

BTW: Ich muss doch kein Administrator sein um einen Rechner anpingen zu können.

[BBoy]

So, jetzt funzt es. Keine Ahnung was vorher war, manchmal ist es wie verhext :)

Mir reicht zu wissen das der Rechner an ist...


danke!

[SirThornberry]

wenn du wissen willst ob auf anderen Rechnern dein Programm erreichbar ist kannst du auch gleich versuchen zu diesem zu verbinden anstelle des Pings. denn ein Ping ist auch nichts anderes als ein Verbindungsvesuch auf einem bestimmten Port und zu prüfen wie lange die Antwort benötigt.

[Piro]

Ich hoffe einer schaut hier nochmal rein, denn ich habe das gleiche Problem und mit den oben genannten Lösungen komme ich nicht weiter.

Mein Quellcode:

Delphi-Quellcode:

unit uPing;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Ping: TIdIcmpClient;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure PingReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.PingReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: String;
begin
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';

  Listbox1.Items.Add(Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
                            [AReplyStatus.BytesReceived,
                             AReplyStatus.FromIpAddress,
                             AReplyStatus.SequenceId,
                             AReplyStatus.TimeToLive,
                             sTime,
                             AReplyStatus.MsRoundTripTime]));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i : integer;
begin
 ListBox1.Clear;
 Ping.ReceiveTimeout := 1000;
 Ping.Host := Edit1.Text;
for i := 1 to 10 do
 begin
   Ping.Ping;
   Application.ProcessMessages;
 end;

end;

end.

Bin zu Hause und benutze einen Firmenlaptop mit dem ich mich per VPN ins Firmennetz einwähle. IP Adressen sind unterschiedlich. Folgendes Symptom habe ich, benutze ich den ping Befehl von Windows geht es aber benutze ich das Delphi Programm geht es nicht. Ich habe keine Firewall oder dergelichen an.

Was kann es sein? Muss man noch etwas mit geben, was auch immer?

[RainerO]

Ich hatte das gleiche Problem - Ping mit cmd geht, aus dem Programm heraus kommt immer 0.
Um nicht allzulange zu suchen, hab ich die Unit "DosCommand" genommen (von maxime collomb, hab ich glaub ich hier oder beim Delphi-Forum gefunden, an dieser Stelle ein herzliches Danke schön!!) und mit dieser Funktion

Delphi-Quellcode:

... uses DosCommand;
... Var dosCommandReady : Boolean;

procedure Tkdtinst.onterminatedDosCommand(Sender : TObject);
begin
  dosCommandReady := True;
end;

function _IsConnectedToInternet: Boolean;
var
 output     : TStringList;
 DosCommand : TDosCommand;
begin
  RESULT:=FALSE;
  TRY
    OutPut:=TStringlist.Create;
    DosCommand := TDosCommand.Create(NIL);
    DosCommand.MaxTimeAfterBeginning:=30; // max. 30 Sek. versuchen
    DosCommand.OutputLines:=output;
    DosCommand.InputToOutput:=TRUE;
    DosCommand.CommandLine:='ping www.3d-raumplan.com';
    DosCommand.OnTerminated:=kdtinst.onterminatedDosCommand;  // Setzt nur die Globale Var dosCommandReady auf true
    DosCommand.Execute;
    While NOT dosCommandready do
      Application.ProcessMessages;
    DosCommand.Free;
    TRY                                   // wenn der ping schiefgeht, hat OutPut keine 18 Zeilen     
       if POS('(100%',OutPut[18])=0 then  // so hoffe ich, das es auch auf nicht deutschen Windows-Systemen richtig ist
         Result:=TRUE;
    Except
     Result:=FALSE;
    end; // Try ping

  except
    Result:=FALSE;
  end;  // Try DosCommand
    if not result then
     if MessageDlg(output.text+#13#10+'Es scheint keine Internetverbindung zu bestehen. Trotzdem weiter ?',  mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        Result := TRUE
      else
        Result := FALSE;
end;

abgefragt. Wenn die Antwortzeiten wichtig sind, können diese aus OutPut geparst werden.

Ich hoffe, das hilft

[Piro]

moin,

ich finde diese Unit nirgends. Kannst du sie mir zu schicken oder online zur Verfügung stellen?

Danke.

[RainerO]

Hi,

ich hab eine leicht modifizierte Version im Einsatz (ein nicht wirklich schönes "onQuestion"),
ich häng es mal an..