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.