Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 26.06.2018, 11:36
frkbvfnjh frkbvfnjh вне форума
Прохожий
 
Регистрация: 18.10.2011
Сообщения: 12
Репутация: 10
По умолчанию Нужно сделать ping на Delphi

Всем доброго времени суток! Задача избитая, но полноценного решения не нашел. Нужно сделать ping на Delphi. Нашел вроде хороший пример http://www.delphimaster.ru/articles/icmp.html , но не хватает мозгов как сделать, что бы размер буффера можно бло указывать произвольно? Не хватает мозгов переделать на динамический массив буффера данных. Кроме того хотелось бы услышать мнение по правильности этого кода, есть мнение, что этот код может вызывать утечки памяти... И еще интересно - в Delphi XE случайно не сделали "обертку" под использование функций из ICMP.DLL?
Ответить с цитированием
  #2  
Старый 26.06.2018, 12:20
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Как-то так:
Код:
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  
Старый 26.06.2018, 12:29
frkbvfnjh frkbvfnjh вне форума
Прохожий
 
Регистрация: 18.10.2011
Сообщения: 12
Репутация: 10
По умолчанию

Цитата:
Сообщение от Aristarh Dark
Как-то так:
Код:
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.
Спасибо! Очень аккуратный код, но нет ответа на основной вопрос, как передавать размер пакета в параметре, как в консольной утилите ping, где можно указать произвольный размер пакета, а не только 32 байта, а например 1024 байта (1 КБ)

Последний раз редактировалось frkbvfnjh, 26.06.2018 в 13:16.
Ответить с цитированием
  #4  
Старый 26.06.2018, 13:52
frkbvfnjh frkbvfnjh вне форума
Прохожий
 
Регистрация: 18.10.2011
Сообщения: 12
Репутация: 10
По умолчанию

В общем вместо
Код:
pingBuffer : array [0..31] of AnsiChar;
я написал
Код:
pingBuffer : array of AnsiChar;
Потом инициализирую переменную
Код:
SetLength(pingBuffer, 1452);
и заменил везде
Код:
sizeof(pingBuffer)
на
Код:
Length(pingBuffer)
Адрес массива передаю также:
Код:
pIpe.Data := @pingBuffer;
Вроде все работает, но вопрос - правильно ли я все сделал? Больше всего волнует вопрос: передача адреса на статический и динамический массив одинаково выполняется в Делфи? Я имею ввиду синтаксически...
Ответить с цитированием
  #5  
Старый 26.06.2018, 13:53
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Никогда над этим не задумывался. Сейчас посмотрел, и в коде похоже косяк. Отправляется не 32 байта, а 64 т.к. Char в XE двухбайтовый.
Короче pingbuffer - это пакет который уходит, меняй его длину.
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #6  
Старый 26.06.2018, 13:54
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Цитата:
Вроде все работает, но вопрос - правильно ли я все сделал? Больше всего волнует вопрос: передача адреса на статический и динамический массив одинаково выполняется в Делфи? Я имею ввиду синтаксически...
Нет, нужно передавать указатель на нулевой элемент @pingbuffer[0]
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.

Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
Ответить с цитированием
  #7  
Старый 26.06.2018, 14:21
frkbvfnjh frkbvfnjh вне форума
Прохожий
 
Регистрация: 18.10.2011
Сообщения: 12
Репутация: 10
По умолчанию

Да, на счет 64 байт я тоже заметил, поэтому явно везде указал AnsiChar. А за @pingBuffer[0] спасибо, ошибок при работе не вызвало, остается только креститься и молиться, что бы работало
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 16:50.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter