IdICMPClient unter Vista: Fehler bei Bereichsprüfung

[seim]

Hi,
unter XP lief alles noch ohne Probleme, jetzt in Vista gibt es allerdings fast jedesmal (hin und wieder geht es) ein Fehler wenn ein Ping per Indy ausgeführt wird.

Der Debugger springt an diese Stelle wenn ich das Programm anhalte:

Delphi-Quellcode:

  //Ping
  IdIcmpClient.Ping();
{-->}end;{<--}

Allerdings liegt es am Ping, denn wenn ich das auskommentiere gibt's nichts mehr zu meckern.

Könnte ein Bug im Indy sein oder so? Ich hab' Delphi 2007 und seitdem die Indy Libraries nicht geupdatet.

lg
Seim

[Bernhard Geyer]

Benötigt die Ping-Komponente der Indys nicht Admin-Rechte :gruebel:

[Assertor]

Hi,

Zitat:

Zitat von Bernhard Geyer

Benötigt die Ping-Komponente der Indys nicht Admin-Rechte :gruebel:

Absolut richtig. TIdIcmpClient benutzt RAW Sockets, die seitens Microsoft nun beschränktem Zugriff unterliegen. Um Pings ohne Admin-Rechte zu senden, muß man dort Microsoft's ICMP.dll nutzen.

Das ganze ist z.B. in der IcmpSendEcho() function verfügbar:
http://msdn.microsoft.com/en-us/library/aa366050.aspx

Das wäre aber etwas, was der Programmierer selber umsetzen muß bzw. nicht in den Indys enthalten ist.

Gruß Assertor

[Bernhard Geyer]

Es könnte sein das die ICS-Implementierung beim Ping keine Admin-Rechte benötigt.

[seim]

Da hier eh jeder mit Adminrechten surft ^.^

Ich werd' mir das mal angucken evtl. geht das besser als per Indy.. Was mich nur wundert ist, dass es hin und wieder geht und dann wieder nicht mehr.

[Klaus01]

..schau Dir mal den Link in diesem Thread an.
Die Bereichsüberschreitung passiert dann wenn der Socket nicht geöffnet werden konnte.

Grüße
Klaus

[seim]

Ok ich hab' den Weg über die ICMP.dll genommen..

Aufruf:

Delphi-Quellcode:

procedure TForm1.BtnClick(lala)
begin
if Ping('127.0.0.1') then
ShowMessage('Dein PC ist an')
else
ShowMessage('Dein PC scheint aus zu sein');
end;

Types und Vars:

Delphi-Quellcode:

type
  //ICMP.dll Datentypen
  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; //Eine der Funktionen in icmp.dll braucht den Datentyp "IPAddr"

  ip_option_information = record
    Ttl : byte;
    Tos : byte;
    Flags : byte;
    OptionsSize : byte;
    OptionsData : pointer;
  end;

  ICMP_ECHO_REPLY = record
    Address : IPAddr;
    Status : ULONG;
    RoundTripTime : ULONG;
    DataSize : Word;
    Reserved : Word;
    Data : Pointer;
    Options : IP_OPTION_INFORMATION;
  end;

//ICMP.dll Declarations
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';

Funktionen:

Delphi-Quellcode:

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;
 PingBuf: array[0..31] of char;
 Reply  : ICMP_ECHO_REPLY;
begin
  result := false;

  Handle := IcmpCreateFile;

  if Handle = INVALID_HANDLE_VALUE then
   Exit;

  TranslateStringToTInAddr(InetAddress, InAddr);

  Reply.Data := @pingBuf;
  Reply.DataSize := 32;

  DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 1000); //Die 1000 gibt den TimeOut an

  if DW <> 0 then
    Result:= true;

  IcmpCloseHandle(Handle);
end;

[judoka]

Unter Delphi 2006 funktioniert es wunderbar. Mit Delphi 2010 trotz Änderung

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
phe: PHostEnt;
pac: PAnsiChar;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PAnsiChar(AIP));


1.) Änderung auf ANSICHAR
2.) Keine Fehlermeldung beim komplieren.
3.) Fehlermeldung bei Ausführung - Adresse wird nicht aufgelöst!

Hat jemand eine Idee?

[stoxx]

Zitat:

Zitat von seim (Beitrag 864504)

Ok ich hab' den Weg über die ICMP.dll genommen..


Funktionen:

Delphi-Quellcode:

  ....
  TranslateStringToTInAddr(InetAddress, InAddr);

  Reply.Data := @pingBuf;
  Reply.DataSize := 32;

  DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 1000); //Die 1000 gibt den TimeOut an

  if DW <> 0 then
    Result:= true;

  IcmpCloseHandle(Handle);
end;

Hi .. die Unit ist schick, hat aber leider einen kleinen Fehler.
Trotz abgezogenem Netzwerkkabel liefert die Funktion (manchmal) ein True zurück.
Nach stöbern im msdn hat sich herausgestellt, dass man den Rückgabewert nicht so behandeln darf.

so ist es korrekt:

Delphi-Quellcode:

const

  IP_SUCCESS                  = 0;
  IP_BUF_TOO_SMALL            = 11001;
  IP_DEST_NET_UNREACHABLE     = 11002;
  IP_DEST_HOST_UNREACHABLE    = 11003;
  IP_DEST_PROT_UNREACHABLE    = 11004;
  IP_DEST_PORT_UNREACHABLE    = 11005;
  IP_NO_RESOURCES             = 11006;
  IP_BAD_OPTION               = 11007;
  IP_HW_ERROR                 = 11008;
  IP_PACKET_TOO_BIG           = 11009;
  IP_REQ_TIMED_OUT            = 11010;
  IP_BAD_REQ                  = 11011;
  IP_BAD_ROUTE                = 11012;
  IP_TTL_EXPIRED_TRANSIT      = 11013;
  IP_TTL_EXPIRED_REASSEM      = 11014;
  IP_PARAM_PROBLEM            = 11015;
  IP_SOURCE_QUENCH            = 11016;
  IP_OPTION_TOO_BIG           = 11017;
  IP_BAD_DESTINATION          = 11018;
  IP_GENERAL_FAILURE          = 11050;




  ....

function Ping(InetAddress : string; var ErrorMessage : String) : boolean;
var
 Handle : THandle;
 InAddr : IPAddr;
 DW : DWORD;
 PingBuf: array[0..31] of char;
 Reply : ICMP_ECHO_REPLY;
begin
  result := false;
  ErrorMessage := '';
  try
      DW := 0;
      Handle := IcmpCreateFile;
      if Handle = INVALID_HANDLE_VALUE then
       Exit;
      try
        TranslateStringToTInAddr(InetAddress, InAddr);
      except
        on E: Exception do begin
          ErrorMessage :=  e.Message;
          Exit;
        end;
      end;
      Reply.Status := IP_SUCCESS;
      Reply.Data := @pingBuf;
      Reply.DataSize := 32;
      DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 1500); //Die 1000 gibt den TimeOut an

      // if (Reply.Status <> IP_GENERAL_FAILURE) and (Reply.Status <> IP_SUCCESS) then
      //    ErrorMessage :=  Get_ICMP_ECHO_REPLY_StateString(reply.Status);
         
      
      if DW <> 0 then begin

          if Reply.Status = IP_SUCCESS then begin
               Result := True;
               ErrorMessage := '';
          end;
      end;
  except
  end;
  IcmpCloseHandle(Handle);
end;   // Ping