Нужно сделать ping на Delphi

frkbvfnjh · #1 26.06.2018, 11:36

Всем доброго времени суток! Задача избитая, но полноценного решения не нашел. Нужно сделать ping на Delphi. Нашел вроде хороший пример http://www.delphimaster.ru/articles/icmp.html , но не хватает мозгов как сделать, что бы размер буффера можно бло указывать произвольно? Не хватает мозгов переделать на динамический массив буффера данных. Кроме того хотелось бы услышать мнение по правильности этого кода, есть мнение, что этот код может вызывать утечки памяти... И еще интересно - в Delphi XE случайно не сделали "обертку" под использование функций из ICMP.DLL?

Aristarh Dark · #2 26.06.2018, 12:20

Как-то так:

Код:

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.

frkbvfnjh · #3 26.06.2018, 12:29

Цитата:

Сообщение от 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 · #4 26.06.2018, 13:52

В общем вместо

Код:

pingBuffer : array [0..31] of AnsiChar;

я написал

Код:

pingBuffer : array of AnsiChar;

Потом инициализирую переменную

Код:

SetLength(pingBuffer, 1452);

и заменил везде

Код:

sizeof(pingBuffer)

на

Код:

Length(pingBuffer)

Адрес массива передаю также:

Код:

pIpe.Data := @pingBuffer;

Вроде все работает, но вопрос - правильно ли я все сделал? Больше всего волнует вопрос: передача адреса на статический и динамический массив одинаково выполняется в Делфи? Я имею ввиду синтаксически...

Aristarh Dark · #5 26.06.2018, 13:53

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

Aristarh Dark · #6 26.06.2018, 13:54

Цитата:

Вроде все работает, но вопрос - правильно ли я все сделал? Больше всего волнует вопрос: передача адреса на статический и динамический массив одинаково выполняется в Делфи? Я имею ввиду синтаксически...

Нет, нужно передавать указатель на нулевой элемент @pingbuffer[0]

frkbvfnjh · #7 26.06.2018, 14:21

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

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты