Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Вниз

Работа программ с сетевыми компонентами в ОС Vista.   Найти похожие ветки 

 
JohnKorsh   (2008-10-06 17:21) [0]

А не знает ли кто как преодолеть такую особенность ОС Vista - программы, написанные на Delphi с использованием компонента IdlCmpClient не работают. Конкретно - Ноутбук Acer со встроеной беспроводной картой и предустановленной ОС Vista. Ping из командной строки работает, а программа, пингующая из компонента - не работает. На компьютерах с ОС XP всё работает. Программа, взятая из сети и осуществляющая мониторинг IP адреса (не использующая компоненты) также проявляет это свойство.


 
Anatoly Podgoretsky ©   (2008-10-06 19:45) [1]

> JohnKorsh  (06.10.2008 17:21:00)  [0]

Какое свойство проявляет


 
Eraser ©   (2008-10-07 00:17) [2]

> [0] JohnKorsh   (06.10.08 17:21)

дело в том, что в xp так же не будет работать, если программа запущена не от имени админа. соответственно в висте с включенным UAC не работает тоже. для работы с RAW сокетами нужны права админа. выход - использовать якобы устаревшую icmp.dll, которая и в висте успешно работает.


 
Eraser ©   (2008-10-07 00:18) [3]

рабочий код:
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;          // Time To Live
   Tos: Byte;          // Type Of Service
   Flags: Byte;        // IP header flags
   OptionsSize: Byte;  // Size in bytes of options data
   OptionsData: PByte; // Pointer to options data
 end;
 PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
 TIpOptionInformation = IP_OPTION_INFORMATION;
 PIpOptionInformation = PIP_OPTION_INFORMATION;

type
 ICMP_ECHO_REPLY = record
   Address: IPAddr;      // Replying address
   Status: ULONG;        // Reply IP_STATUS
   RoundTripTime: ULONG; // RTT in milliseconds
   DataSize: Word;     // Reply data size in bytes
   Reserved: Word;     // Reserved for system use
   Data: Pointer;         // Pointer to the reply data
   Options: IP_OPTION_INFORMATION; // Reply options
 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
   // 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: 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.


 
JohnKorsh   (2008-10-07 08:39) [4]

Свойство - не работает. Точнее, запрос идёт, а не срабатывает событие OnReply у IdlCmpClient.
Во всех случаях работаю под Администратором.
Спасибо за рабочий код.


 
JohnKorsh   (2008-10-09 16:44) [5]

Извините, а ещё не подскажете, где ошибка - хочу, чтобы при 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; - Ваш, работающий вариант.


 
Eraser ©   (2008-10-09 22:29) [6]

> 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 на размер передаваемого буффера.
// Declare and initialize variables
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) {
 PICMP_ECHO_REPLY pEchoReply = (PICMP_ECHO_REPLY)ReplyBuffer;
 printf("\tReceived %ld messages.\n", dwRetVal);
 printf("\tMessage: %s\n", pEchoReply->Data);
}
else {
 printf("\tCall to IcmpSendEcho() failed.\n");
 printf("\tError: %ld\n", GetLastError());
}


 
JohnKorsh   (2008-10-10 08:44) [7]

Большое спасибо. Извините, срочно надо, а то бы сам подумал.



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.065 c
3-1242203480
Int23
2009-05-13 12:31
2010.08.27
Как получить список полей в ХП в МС СКЛ 2005


2-1275629647
Delphist2
2010-06-04 09:34
2010.08.27
Как в winapi различить 2 контрола одного класса на окне?


15-1273523397
Юрий
2010-05-11 00:29
2010.08.27
С днем рождения ! 11 мая 2010 вторник


15-1275856176
Юрий
2010-06-07 00:29
2010.08.27
С днем рождения ! 7 июня 2010 понедельник


15-1266165222
Czz
2010-02-14 19:33
2010.08.27
Win7 - не запускается проводник 2





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский