Доброго вечера !!
Есть несколько вопросов по реализации пинга:
- не могу сконфигурировать размер пакета
- на удаленные хосты вне данного сегмента, бывает, возвращает ТТЛ =  262164 ms

код функции:

function TForm1.Ping(IP: string): integer;
var hIP : THandle;
  pingBuffer : array of Char;
  pIpe : ^icmp_echo_reply;
  pHostEn : PHostEnt;
  wVersionRequested : WORD;
  lwsaData : WSAData;
  error : DWORD;
  destAddress : In_Addr;
  er : string;
  t, err_count : integer;

  procedure clean();
  begin
    IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
  end;

begin
  {er := '';
  if StrToInt(Trim(LengthPacket.Text))> 1024 then
    LengthPacket.Text := '1024';
  SetLength(pingBuffer, StrToInt(Trim(LengthPacket.Text)));
  for t:= 0 to StrToInt(Trim(LengthPacket.Text))-1 do
    pingBuffer[t] := '1';
  {}
  err_count:= 0;
  IP := TrimIP(IP);
  if Trim(IP)=''then
  begin
    Result := -1;
    exit;
  end;

  for t:=1 to StrToInt(Trim(KolvoPacket.Text)) do
  begin
     Application.ProcessMessages;
     hIP:= IcmpCreateFile();
     GetMem(pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
     pIpe.Data:= @pingBuffer;
     pIpe.DataSize:= sizeof(pingBuffer);
//      pIpe.DataSize:= DWORD(Trim(LengthPacket.Text));

     wVersionRequested:= MakeWord(1,1);
     Error:= WSAStartup(wVersionRequested,lwsaData);
     if (error <> 0)then
     begin
       if Debug.Checked then
       begin
          Memo2.Lines.Add('Error in call to '+ 'WSAStartUp().');
          Memo2.Lines.Add('Error code: '+IntToStr(error));
       end;
       Inc(err_count);
       clean();
       Result := err_count;        
       exit;
     end;

     pHostEn:= gethostbyname(PChar(IP));
     error:= GetLastError();
     if (error <> 0) then
     begin
       if Debug.Checked then
       begin
         Memo2.Lines.Add('Error in call to gethostbyname().');
         Memo2.Lines.Add('Error code: '+IntToStr(error));
       end;

       Inc(err_count);
       clean();
       break;
     end;

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

     // Посылаем ping-пакет
     if t=1 then
       if Debug.Checked then
         Memo2.Lines.Add('Ping ' + 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),
                  StrToInt(Trim(TimeOut.Text)));

     Application.ProcessMessages;

     Error:= GetLastError();
     if Error<>0 then begin
       er:= 'not available';
       case error of
         11001 : er:= 'IP_BUF_TOO_SMALL';
         11002 : er:= 'IP_DEST_NET_UNREACHABLE';
         11003 : er:= 'IP_DEST_HOST_UNREACHABLE';
         11005 : er:= 'IP_DEST_PORT_UNREACHABLE';
         11006 : er:= 'IP_NO_RESOURCES';
         11007 : er:= 'IP_BAD_OPTION';
         11009 : er:= 'IP_PACKET_TOO_BIG';
         11010 : er:= 'IP_REQ_TIMED_OUT';
         11011 : er:= 'IP_BAD_REQ';
         11012 : er:= 'IP_BAD_ROUTE';
         11013 : er:= 'IP_TTL_EXPIRED_TRANSIT';
         11014 : er:= 'IP_TTL_EXPIRED_REASSEM';
         11015 : er:= 'IP_PARAM_PROBLEM';
         11018 : er:= 'IP_BAD_DESTINATION';
         11019 : er:= 'IP_ADDR_DELETED';
         11022 : er:= 'IP_UNLOAD';
         11050 : er:= 'IP_GENERAL_FAILURE';
         11255 : er:= 'IP_PENDING';
         else er:= SysErrorMessage(error);
         end;
       if Debug.Checked then
         Memo2.Lines.Add(er);
       Inc(err_count);
       clean();
       Continue;
     end;

     Application.ProcessMessages;
     if Debug.Checked then
       Memo2.Lines.Add('Reply from '+
                     IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
                     IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
                     IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
                     IntToStr(HiByte(HiWord(pIpe^.Address)))+
                     ' - ' +IntToStr(pIpe.RTTime)+' ms');
       clean();
   end;

  Result:= err_count;
end;

- немного разобрался, осталась проблема: если хост не отвечает на входящие эхо-запросы (режет файервол), то выдает не Таймаут, а фантастическую цифру миллисекунд, как это и почему ?

1. IcmpSendEcho - это функция ! Почему ты не анализируешь возвращаемый ею результат ?

IcmpSendEcho(..); // успешным или неуспешным было выполнение функции - результат ты игнорируешь

Application.ProcessMessages; // при выполнении этой процедуры обязательно будет осуществляться вызов ряда WinAPI-фунций !!

Error:= GetLastError(); //код ошибки, ставшей результатом вызова какой из этих ф-ций, ты здесь пытаешься получить ?

2.

> sizeof(pingBuffer)


Выражение SizeOf(чего-то там) вычисляется на этапе компиляции.

Вопрос на засыпку: чему равен результат вычисления этого выражения, если длина дин.массива становится известной лишь в ран-тайм ?

Сергей, в описании примера сказано, что результат этой функции малоинформативен. Поэтому нужно анализировать ЛастЕррор. Процесс Мессаджес уберу, согласен.
С размером тоже разобрался :)
--------------
Как быть с резанными пакетами и большим значением таймаута, через раз срабатывает

> в описании примера сказано, что результат этой функции малоинформативен


В каком еще "описании примера" ?

Есть первоисточник

http://msdn.microsoft.com/en-us/library/aa366050(VS.85).aspx

В нем черным по белому сказано:

Return Value

The IcmpSendEcho function returns the number of ICMP_ECHO_REPLY or ICMP_ECHO_REPLY32 structures stored in the ReplyBuffer. The status of each reply is contained in the structure. If the return value is zero, call GetLastError for additional error information.

If the function fails, the extended error code returned by GetLastError can be one of the following values.

Спасибо, результат виден

Удалено модератором

Удалено модератором

Удалено модератором