Выполнить PING средствами fpc

[Толик]

Возникла необходимость посылать из приложения PING по оперделенному адресу и обрабатывать результат пинга, может кто подскажет как средствами лазаруса это реализовать. на Delphi получилось все лехко, НО к сожалению законы запретили пользоваться им:))) а так вот что то с наскоку не получилось перенести из делфей в лазарус библиотечку

[tria]

Как сделать не знаю, но за правильность заголовка темы тебе двойка...

[Толик]

Ну блин извиняйте, мне нужен результат, вот это главное. Постараюсь в следующий раз быть более детальным.

Но в любом случае, неужели никому никогда не надо было реализовать такую возможность?

[Brainenjii]

Может не в тему, но можно тут посмотреть Там вроде пытались из консольки результат достать...

[Толик]

антивариант че то - может кто нить исходник поможет перелопатить?

Код: Выделить всё

unit IpPing;

{$mode delphi}

interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Crt, WinSock;

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;

    ip_repl_info = packed record
        type_err : boolean;                //Тип ответа, True -Нет ошибки
                                           //            False-Есть ошибка
        err_mes  : string;                 // код ошибки
        err_code : integer;
        time_rep : string;                 // время отклика
    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';

// Функция посылает ping по указанному адресу и можно получить
// различные результаты
   function iping (ipadress : Pchar) : ip_repl_info;

implementation

function iping(ipadress : PChar) : ip_repl_info;
var
    hIP : THandle;
    pingBuffer : array [0..31] of Char;
    pIpe : ^icmp_echo_reply;
    pHostEn : PHostEnt;
    wVersionRequested : WORD;
    lwsaData : WSAData;
    error : DWORD;
    destAddress : In_Addr;
begin

    // Создаем handle
    hIP := IcmpCreateFile();

    GetMem( pIpe,
            sizeof(icmp_echo_reply) + sizeof(pingBuffer));
    pIpe.Data := @pingBuffer;//@pingBuffer;
    pIpe.DataSize := sizeof(pingBuffer);

    wVersionRequested := MakeWord(1,1);
    error := WSAStartup(wVersionRequested,lwsaData);
    if (error <> 0) then
    begin
    iping.err_mes := 'ошибка при подготовки пакета Код: '+IntToStr(error);
    iping.err_code := error;
    iping.type_err := False;
{         Memo1.SetTextBuf('Error in call to '+
                          'WSAStartup().');
         Memo1.Lines.Add('Error code: '+IntToStr(error));}
         Exit;
    end;

    pHostEn := gethostbyname(ipadress);
    error := GetLastError();
    if (error <> 0) then
    begin
    iping.err_mes := 'Неверно определен хост код: '+IntToStr(error);
    iping.err_code := error;
    iping.type_err := False;
{         Memo1.SetTextBuf('Error in call to'+
                          'gethostbyname().');
         Memo1.Lines.Add('Error code: '+IntToStr(error));}
         Exit;
    end;

     destAddress := PInAddr(pHostEn^.h_addr_list^)^;

      // Посылаем ping-пакет
{    Memo1.Lines.Add('Pinging ' +
                    pHostEn^.h_name+' ['+
                    inet_ntoa(destAddress)+'] '+
                    ' with '+
                    IntToStr(sizeof(pingBuffer)) +
                    ' bytes of data:');}

    IcmpSendEcho(hIP,
                 destAddress.S_addr,
                 @pingBuffer,
                 sizeof(pingBuffer),
                 Nil,
                 pIpe,
                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                 5000);

    error := GetLastError();
    if (error <> 0) then
    begin
    iping.err_mes := 'Ошибка в отправке пакета: '+IntToStr(error);
    iping.err_code := error;
    iping.type_err := False;
{         Memo1.SetTextBuf('Error in call to '+
                          'IcmpSendEcho()');
         Memo1.Lines.Add('Error code: '+IntToStr(error));}
         Exit;
    end;

     // Смотрим некоторые из вернувшихся данных
   iping.type_err := True;
   iping.time_rep := IntToStr(pIpe.RTTime);
//   iping := IntToStr(pIpe.RTTime);
{    Memo1.Lines.Add('Reply from '+
                IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
                IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
                IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
                IntToStr(HiByte(HiWord(pIpe^.Address))));
    Memo1.Lines.Add('Reply time: '+IntToStr(pIpe.RTTime)+' ms');}

    IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
end;
end.



[Attid]

Толик
поправил твой пост с исходником пробуй, у меня вроде работает.

[Толик]

Attid
Так что , все дело в - {$mode delphi}? что то других отличий не наблюдел:) а где можно поподробнее описалово lazarusa найти, с его спецификациями, и тонкими настройками? может чего посоветуете?

[ev]

есть три варианта
1. использовать виндовую icmp.dll
2. использовать компонент ICMP (в сунапсе или инди)
3. делать полностью самому (похоже эта задача не стоит)

исходник - это использование виндовой dll
почитать можно тут

[Tiger]

А у меня вдогонку тоже вопрос, почти в тему, может кто знает:

Как и какими средствами (библиотеками/модулями FPC) запрашивать информацию для DHCP?

Честно говоря, даже представления не имею какими протоколами и как это все делается.

[ev]

Как и какими средствами (библиотеками/модулями FPC) запрашивать информацию для DHCP

хм... что значит для? может быть у DHCP-сервера? или пишется сам DHCP-сервер?

алгоритм прост - выбирается любой пункт на Ваш вкус:
1. смотрится инди или сунапс на предмет наличия компоненто нужного плана
2. смотрится интернет на предмет наличия стороннего компонента
3. смотрится рекомендация DHCP и по ней реализуются нужные методы
4. ставится сниффер, ловится трафик, анализируется и потом повторяется (это совсем для извращенцев)

[Lisolog]

а под Линем не подскажете как не через консоль PING попросить и свой IP узнать?

[NXP]

а под Линем не подскажете как не через консоль PING попросить и свой IP узнать?

source\lib\pingsend.pas из либы synapse или юзать TProcess, и парсить консольный вывод

[JoKeR174]

антивариант че то - может кто нить исходник поможет перелопатить?

Код: Выделить всё

unit IpPing;

{$mode delphi}

interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Crt, WinSock;

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;

    ip_repl_info = packed record
        type_err : boolean;                //Тип ответа, True -Нет ошибки
                                           //            False-Есть ошибка
        err_mes  : string;                 // код ошибки
        err_code : integer;
        time_rep : string;                 // время отклика
    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';

// Функция посылает ping по указанному адресу и можно получить
// различные результаты
   function iping (ipadress : Pchar) : ip_repl_info;

implementation

function iping(ipadress : PChar) : ip_repl_info;
var
    hIP : THandle;
    pingBuffer : array [0..31] of Char;
    pIpe : ^icmp_echo_reply;
    pHostEn : PHostEnt;
    wVersionRequested : WORD;
    lwsaData : WSAData;
    error : DWORD;
    destAddress : In_Addr;
begin

    // Создаем handle
    hIP := IcmpCreateFile();

    GetMem( pIpe,
            sizeof(icmp_echo_reply) + sizeof(pingBuffer));
    pIpe.Data := @pingBuffer;//@pingBuffer;
    pIpe.DataSize := sizeof(pingBuffer);

    wVersionRequested := MakeWord(1,1);
    error := WSAStartup(wVersionRequested,lwsaData);
    if (error <> 0) then
    begin
    iping.err_mes := 'ошибка при подготовки пакета Код: '+IntToStr(error);
    iping.err_code := error;
    iping.type_err := False;
{         Memo1.SetTextBuf('Error in call to '+
                          'WSAStartup().');
         Memo1.Lines.Add('Error code: '+IntToStr(error));}
         Exit;
    end;

    pHostEn := gethostbyname(ipadress);
    error := GetLastError();
    if (error <> 0) then
    begin
    iping.err_mes := 'Неверно определен хост код: '+IntToStr(error);
    iping.err_code := error;
    iping.type_err := False;
{         Memo1.SetTextBuf('Error in call to'+
                          'gethostbyname().');
         Memo1.Lines.Add('Error code: '+IntToStr(error));}
         Exit;
    end;

     destAddress := PInAddr(pHostEn^.h_addr_list^)^;

      // Посылаем ping-пакет
{    Memo1.Lines.Add('Pinging ' +
                    pHostEn^.h_name+' ['+
                    inet_ntoa(destAddress)+'] '+
                    ' with '+
                    IntToStr(sizeof(pingBuffer)) +
                    ' bytes of data:');}

    IcmpSendEcho(hIP,
                 destAddress.S_addr,
                 @pingBuffer,
                 sizeof(pingBuffer),
                 Nil,
                 pIpe,
                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                 5000);

    error := GetLastError();
    if (error <> 0) then
    begin
    iping.err_mes := 'Ошибка в отправке пакета: '+IntToStr(error);
    iping.err_code := error;
    iping.type_err := False;
{         Memo1.SetTextBuf('Error in call to '+
                          'IcmpSendEcho()');
         Memo1.Lines.Add('Error code: '+IntToStr(error));}
         Exit;
    end;

     // Смотрим некоторые из вернувшихся данных
   iping.type_err := True;
   iping.time_rep := IntToStr(pIpe.RTTime);
//   iping := IntToStr(pIpe.RTTime);
{    Memo1.Lines.Add('Reply from '+
                IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
                IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
                IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
                IntToStr(HiByte(HiWord(pIpe^.Address))));
    Memo1.Lines.Add('Reply time: '+IntToStr(pIpe.RTTime)+' ms');}

    IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
end;
end.



Подскажите пожалуйста как это использовать?