IdICMPClient unter Vista: Fehler bei Bereichsprüfung

[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;