-
А не знает ли кто как преодолеть такую особенность ОС Vista - программы, написанные на Delphi с использованием компонента IdlCmpClient не работают. Конкретно - Ноутбук Acer со встроеной беспроводной картой и предустановленной ОС Vista. Ping из командной строки работает, а программа, пингующая из компонента - не работает. На компьютерах с ОС XP всё работает. Программа, взятая из сети и осуществляющая мониторинг IP адреса (не использующая компоненты) также проявляет это свойство.
-
> JohnKorsh (06.10.2008 17:21:00) [0]
Какое свойство проявляет
-
> [0] JohnKorsh (06.10.08 17:21)
дело в том, что в xp так же не будет работать, если программа запущена не от имени админа. соответственно в висте с включенным UAC не работает тоже. для работы с RAW сокетами нужны права админа. выход - использовать якобы устаревшую icmp.dll, которая и в висте успешно работает.
-
рабочий код: unit ROMPing;
interface
uses
Windows, SysUtils, Classes;
function Ping(InetAddress : string) : Boolean;
implementation
uses
WinSock;
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;
type
IP_OPTION_INFORMATION = record
Ttl: Byte; Tos: Byte; Flags: Byte; OptionsSize: Byte; OptionsData: PByte; end;
PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
TIpOptionInformation = IP_OPTION_INFORMATION;
PIpOptionInformation = PIP_OPTION_INFORMATION;
type
ICMP_ECHO_REPLY = record
Address: IPAddr; Status: ULONG; RoundTripTime: ULONG; DataSize: Word; Reserved: Word; Data: Pointer; Options: IP_OPTION_INFORMATION; end;
PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
TIcmpEchoReply = ICMP_ECHO_REPLY;
PIcmpEchoReply = PICMP_ECHO_REPLY;
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 Fetch(var AInput: string;
const ADelim: string = ' '; const ADelete: Boolean = true): string;
var
iPos: Integer;
begin
if ADelim = #0 then begin
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: AnsiString; var AInAddr);
var
phe: PHostEnt;
pac: PAnsiChar;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PAnsiChar(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;
const
IP_SUCCESS = 0;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
sAnsiAddress: AnsiString;
Icmp: ICMP_ECHO_REPLY;
begin
Result := False;
Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Exit;
sAnsiAddress := AnsiString(InetAddress);
TranslateStringToTInAddr(sAnsiAddress, InAddr);
DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @Icmp, SizeOf(ICMP_ECHO_REPLY), 5000);
Result := (DW <> 0) and (Icmp.Status = IP_SUCCESS);
IcmpCloseHandle(Handle);
end;
end.
-
Свойство - не работает. Точнее, запрос идёт, а не срабатывает событие OnReply у IdlCmpClient. Во всех случаях работаю под Администратором. Спасибо за рабочий код.
-
Извините, а ещё не подскажете, где ошибка - хочу, чтобы при Ping-е посылалась последовательность байт - вот Ваш код, немного модифицированный: type P_Byte = ^byte;
var Tr_Buff : array [0..1023] of byte; P_Tr : P_Byte;
...
function Ping(InetAddress: string) : Boolean; ... begin
...
P_Tr := @Tr_Buff [0];
sAnsiAddress := AnsiString(InetAddress); TranslateStringToTInAddr(sAnsiAddress, InAddr); DW := IcmpSendEcho(Handle, InAddr, P_Tr, 1024, nil, @Icmp, SizeOf(ICMP_ECHO_REPLY), Wait_Time); // DW = 0; - Мой, не работающий.
// DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @Icmp, SizeOf(ICMP_ECHO_REPLY), Wait_Time); // DW = 1; - Ваш, работающий вариант.
-
> IcmpSendEcho(Handle, InAddr, P_Tr, 1024, nil, @Icmp, SizeOf(ICMP_ECHO_REP > LY), Wait_Time);
учитесь пользоваться MSDN. там прекрасно описаны все параметры и есть даже пример! описание предпоследнего параметра The allocated size, in bytes, of the reply buffer. The buffer should be large enough to hold at least one ICMP_ECHO_REPLY structure plus RequestSize bytes of data. параметр ReplyBuffer тоже толжен тогда быть больше, чем Icmp на размер передаваемого буффера. char[] SendData = "Data Buffer";
LPVOID ReplyBuffer;
ReplyBuffer = (VOID*) malloc(sizeof(ICMP_ECHO_REPLY) + sizeof(SendData));
if ((dwRetVal = IcmpSendEcho(hIcmpFile,
inet_addr("123.456.789.0"),
SendData, sizeof(SendData) + sizeof(ICMP_ECHO_REPLY),
NULL, ReplyBuffer,
sizeof(SendData),
1000)) != 0)
else
-
Большое спасибо. Извините, срочно надо, а то бы сам подумал.
|