|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Нужно сделать ping на Delphi
Всем доброго времени суток! Задача избитая, но полноценного решения не нашел. Нужно сделать ping на Delphi. Нашел вроде хороший пример http://www.delphimaster.ru/articles/icmp.html , но не хватает мозгов как сделать, что бы размер буффера можно бло указывать произвольно? Не хватает мозгов переделать на динамический массив буффера данных. Кроме того хотелось бы услышать мнение по правильности этого кода, есть мнение, что этот код может вызывать утечки памяти... И еще интересно - в Delphi XE случайно не сделали "обертку" под использование функций из ICMP.DLL?
|
#2
|
||||
|
||||
Как-то так:
Код:
unit PingUnits; interface function Ping(Address:RawByteString):Boolean; implementation uses Windows, Winsock, SysUtils; const IP_STATUS_BASE=11000; IP_SUCCESS=0; IP_BUF_TOO_SMALL=11001; IP_DEST_NET_UNREACHABLE=11002; IP_DEST_HOST_UNREACHABLE=11003; IP_DEST_PROT_UNREACHABLE=11004; IP_DEST_PORT_UNREACHABLE=11005; IP_NO_RESOURCES=11006; IP_BAD_OPTION=11007; IP_HW_ERROR=11008; IP_PACKET_TOO_BIG=11009; IP_REQ_TIMED_OUT=11010; IP_BAD_REQ=11011; IP_BAD_ROUTE=11012; IP_TTL_EXPIRED_TRANSIT=11013; IP_TTL_EXPIRED_REASSEM=11014; IP_PARAM_PROBLEM=11015; IP_SOURCE_QUENCH=11016; IP_OPTION_TOO_BIG=11017; IP_BAD_DESTINATION=11018; IP_ADDR_DELETED=11019; IP_SPEC_MTU_CHANGE=11020; IP_MTU_CHANGE=11021; IP_UNLOAD=11022; IP_GENERAL_FAILURE=11050; IP_PENDING=11255; MAX_IP_STATUS=IP_GENERAL_FAILURE; type ip_option_information = packed record // Информация заголовка IP (Наполнение // этой структуры и формат полей описан в RFC791. Ttl : byte; // Время жизни (используется traceroute-ом) Tos : byte; // Тип обслуживания, обычно 0 Flags : byte; // Флаги заголовка IP, обычно 0 OptionsSize : byte; // Размер данных в заголовке, обычно 0, максимум 40 OptionsData : Pointer; // Указатель на данные end; icmp_echo_reply = packed record Address : u_long; // Адрес отвечающего Status : u_long; // IP_STATUS (см. ниже) RTTime : u_long; // Время между эхо-запросом и эхо-ответом // в миллисекундах DataSize : u_short; // Размер возвращенных данных Reserved : u_short; // Зарезервировано Data : Pointer; // Указатель на возвращенные данные Options : ip_option_information; // Информация из заголовка IP end; PIPINFO = ^ip_option_information; PVOID = Pointer; function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile'; function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL' name 'IcmpCloseHandle'; function IcmpSendEcho( IcmpHandle : THandle; // handle, возвращенный IcmpCreateFile() DestAddress : u_long; // Адрес получателя (в сетевом порядке) RequestData : PVOID; // Указатель на посылаемые данные RequestSize : Word; // Размер посылаемых данных RequestOptns : PIPINFO; // Указатель на посылаемую структуру // ip_option_information (может быть nil) ReplyBuffer : PVOID; // Указатель на буфер, содержащий ответы. ReplySize : DWORD; // Размер буфера ответов Timeout : DWORD // Время ожидания ответа в миллисекундах ) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho'; function PingIp(Address:RawByteString):Boolean; var hIP : THandle; pingBuffer : array [0..31] of Char; pIpe : ^icmp_echo_reply; wVersionRequested : WORD; lwsaData : WSAData; error : DWORD; destAddress : In_Addr; begin Result:=False; hIP := IcmpCreateFile(); GetMem( pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer)); try pIpe.Data := @pingBuffer; pIpe.DataSize := sizeof(pingBuffer); wVersionRequested := MakeWord(1,1); error := WSAStartup(wVersionRequested,lwsaData); if (error <> 0) then begin Exit; end; destAddress.S_addr:=inet_addr(PAnsiChar(Address)); IcmpSendEcho(hIP, destAddress.S_addr, @pingBuffer, sizeof(pingBuffer), Nil, pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer), 5000); error := GetLastError(); if (error <> 0) then begin Exit; end; Result:=pIpe.Status=IP_SUCCESS; finally IcmpCloseHandle(hIP); WSACleanup(); FreeMem(pIpe); end; end; function HostToIP(name: RawByteString; var Ip: RawByteString): Boolean; var wsdata : TWSAData; hostName : array [0..255] of ansichar; hostEnt : PHostEnt; addr : PAnsiChar; begin WSAStartup ($0101, wsdata); try gethostname (@hostName[0], sizeof (hostName)); StrPCopy(hostName, name); hostEnt := gethostbyname (hostName); if Assigned (hostEnt) then if Assigned (hostEnt^.h_addr_list) then begin addr := hostEnt^.h_addr_list^; if Assigned (addr) then begin IP := Format ('%d.%d.%d.%d', [byte (addr [0]), byte (addr [1]), byte (addr [2]), byte (addr [3])]); Result := True; end else Result := False; end else Result := False else begin Result := False; end; finally WSACleanup; end end; function Ping(Address:RawByteString):Boolean; var s:RawByteString; begin Result:=HostToIP(Address,s); if Result then Result:=PingIp(s); end; end. Некоторые программисты настолько ленивы, что сразу пишут рабочий код. Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты. |
#3
|
|||
|
|||
Цитата:
Последний раз редактировалось frkbvfnjh, 26.06.2018 в 13:16. |
#4
|
|||
|
|||
В общем вместо
Код:
pingBuffer : array [0..31] of AnsiChar; Код:
pingBuffer : array of AnsiChar; Код:
SetLength(pingBuffer, 1452); Код:
sizeof(pingBuffer) Код:
Length(pingBuffer) Код:
pIpe.Data := @pingBuffer; |
#5
|
||||
|
||||
Никогда над этим не задумывался. Сейчас посмотрел, и в коде похоже косяк. Отправляется не 32 байта, а 64 т.к. Char в XE двухбайтовый.
Короче pingbuffer - это пакет который уходит, меняй его длину. Некоторые программисты настолько ленивы, что сразу пишут рабочий код. Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты. |
#6
|
||||
|
||||
Цитата:
Некоторые программисты настолько ленивы, что сразу пишут рабочий код. Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты. |
#7
|
|||
|
|||
Да, на счет 64 байт я тоже заметил, поэтому явно везде указал AnsiChar. А за @pingBuffer[0] спасибо, ошибок при работе не вызвало, остается только креститься и молиться, что бы работало
|