LuckiePing

[nicodex]

Zitat von renekr:

Hast du diese Funktion mal unter Vista getestet oder liegt es ev. an Rechten oder der UAC.

IcmpSendEcho() mag unter Vista keinen TimeOut von 0.

Ersetze IcmpPing (in retPing.pas) durch diese Version:

Delphi-Quellcode:

(**)
type
  PIPAddr = ^TIPAddr;
  TIPAddr = record
    S_un: record
      case Integer of
        1: (
          S_un_b: record
            s_b1: Byte;
            s_b2: Byte;
            s_b3: Byte;
            s_b4: Byte;
          end);
        2: (
          S_un_w: record
            s_w1: Word;
            s_w2: Word;
          end);
        4: (
          S_addr: LongWord);
    end;
  end;
  PIpOptionInformation32 = ^TIpOptionInformation32;
  TIpOptionInformation32 = record
    Ttl        : Byte;
    Tos        : Byte;
    Flags      : Byte;
    OptionsSize: Byte;
    OptionsData: LongWord;  // Pointer32
  end;
  PIcmpEchoReply32 = ^TIcmpEchoReply32;
  TIcmpEchoReply32 = record
    Address      : TIPAddr;
    Status       : LongWord;
    RoundTripTime: LongWord;
    DataSize     : Word;
    Reserved     : Word;
    Data         : LongWord;  // Pointer32
    Options      : TIpOptionInformation32;
  end;
(**)

function IcmpPing(IP: DWORD): Boolean;
var
  IcmpHandle: THandle;
  ReplyBuffer: record
    EchoReply: TIcmpEchoReply32;
  end;
begin
  Result := False;
  IcmpHandle := IcmpCreateFile;
  if IcmpHandle <> INVALID_HANDLE_VALUE then
  try
    FillChar(ReplyBuffer, SizeOf(ReplyBuffer), 0);
    Result := IcmpSendEcho(IcmpHandle, TInAddr(IP), nil, 0, nil, @ReplyBuffer,
      SizeOf(ReplyBuffer), 1000) <> 0;
  {$IFDEF DEBUG}
    if not Result then
      Assert(GetLastError() <> ERROR_INVALID_PARAMETER,
        'IcmpSendEcho: Invalid Parameters!');
  {$ENDIF DEBUG}
  finally
    IcmpCloseHandle(IcmpHandle);
  end;
end;

...dann sollte es wieder funktionieren.