ICMP. Функция ping'а, возвращает код о недостатке ресурсов. ?

[Человек_Борща]

Доброго времени суток!

Пишу свою реализацию PING'а.
Написал функцию:

function PingThis(aAddress: string; aTimeout: Integer;
  var vStr: string): Boolean;

  function IP2Str(aIP: Integer): string;
  begin
    Result := IntToStr(LoByte(LoWord(aIP))) + '.' + IntToStr(HiByte(LoWord(aIP))
      ) + '.' + IntToStr(LoByte(HiWord(aIP))) + '.' +
      IntToStr(HiByte(HiWord(aIP)));
  end;

var
  hICMP: THandle;
  pReply: PIcmpEchoReply;
  Buff: array [0 .. 31] of Char;
  sckVerRequest: Word;
  sckError: Integer;
  sckData: WSAData;
  pSckHost: PHostEnt;
  sckDestAddr: in_addr;
begin
  Result := False;
  try
    hICMP := IcmpCreateFile;
    GetMem(pReply, SizeOf(TIcmpEchoReply) + SizeOf(Buff));
    pReply.Data := @Buff;
    pReply.DataSize := SizeOf(Buff);
    sckVerRequest := MakeWord(1, 1);
    sckError := WSAStartup(sckVerRequest, sckData);
    if not Boolean(sckError) then
    begin
      pSckHost := gethostbyname(PAnsiChar(AnsiString(aAddress)));
      sckError := GetLastError;
      if not Boolean(sckError) then
      begin
        sckDestAddr := PInAddr(pSckHost^.h_addr_list^)^;
        IcmpSendEcho(hICMP, sckDestAddr.S_addr, @Buff, SizeOf(Buff), nil,
          pReply, SizeOf(TIcmpEchoReply) + SizeOf(Buff), aTimeout);
        sckError := GetLastError;
        if not Boolean(sckError) then
        begin
          if pReply.Status = IP_SUCCESS then
          begin
            vStr := Format('Successful reply from %s[%s] RTT=%d',
              [aAddress, IP2Str(pReply.Address), pReply.RoundTripTime]);
            Result := True;
          end;
        end
        else
          vStr :='[ICMP STATUS: '+IntToStr(sckError)+'] '+SysErrorMessage(sckError);
      end
      else
        vStr := '[ICMP STATUS: '+IntToStr(sckError)+'] '+SysErrorMessage(sckError);
    end
    else
      vStr := '[ICMP STATUS: '+IntToStr(sckError)+'] '+SysErrorMessage(sckError);
  finally
    WSACleanup;
    FreeMem(pReply);
    IcmpCloseHandle(hICMP);
  end;
end;

Немогу понять, ночему не хочет работать.

[Баламут]

Хм... Повторить ошибку не смог. Пример перекомпилирова под ХЕ2. После обработки напильником все работает... Выкладываю весь текст, ибо лень. Обрати внимание на переменную sckDestAddr. Ну и на секцию Uses тоже.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, jwaWinSock2, jwaIcmpApi, jwaIPExport,
  RzButton, Vcl.ImgList, Vcl.ExtCtrls, RzPanel;

type
  TForm1 = class(TForm)
    RzToolbar1: TRzToolbar;
    ImageList1: TImageList;
    BtnSkipForward: TRzToolButton;
    procedure BtnSkipForwardClick(Sender: TObject);
  private
   function PingThis(aAddress: string; aTimeout: Integer;  var vStr: string): boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.BtnSkipForwardClick(Sender: TObject);
var
   s: string;
begin
  if PingThis('212.122.1.2', 1000, s) then
  ShowMessage(s);
end;

function TForm1.PingThis(aAddress: string; aTimeout: Integer;
  var vStr: string): boolean;
function IP2Str(aIP: Integer): string;
begin
  Result := IntToStr(LoByte(LoWord(aIP))) + '.' + IntToStr(HiByte(LoWord(aIP))
    ) + '.' + IntToStr(LoByte(HiWord(aIP))) + '.' +
    IntToStr(HiByte(HiWord(aIP)));
end;

var
  hICMP: THandle;
  pReply: PIcmpEchoReply;
  Buff: array [0 .. 31] of Char;
  sckVerRequest: Word;
  sckError: Integer;
  sckData: WSAData;
  pSckHost: PHostEnt;
  sckDestAddr: LONGWORD;
begin
    Result := False;
  try
    hICMP := IcmpCreateFile;
    GetMem(pReply, SizeOf(TIcmpEchoReply) + SizeOf(Buff));
    pReply.Data := @Buff;
    pReply.DataSize := SizeOf(Buff);
    sckVerRequest := MakeWord(1, 1);
    sckError := WSAStartup(sckVerRequest, sckData);
    if not Boolean(sckError) then
    begin
      pSckHost := gethostbyname(PAnsiChar(AnsiString(aAddress)));
      sckError := GetLastError;
      if not Boolean(sckError) then
      begin
        sckDestAddr := LONGINT(pLONGINT(pSckHost^.h_addr_list^)^);
        IcmpSendEcho(hICMP, sckDestAddr, @Buff, SizeOf(Buff), nil,
          pReply, SizeOf(TIcmpEchoReply) + SizeOf(Buff), aTimeout);
        sckError := GetLastError;
        if not Boolean(sckError) then
        begin
          if pReply.Status = IP_SUCCESS then
          begin
            vStr := Format('Successful reply from %s[%s] RTT=%d',
              [aAddress, IP2Str(pReply.Address), pReply.RoundTripTime]);
            Result := True;
          end;
        end
        else
          vStr :='[ICMP STATUS: '+IntToStr(sckError)+'] '+SysErrorMessage(sckError);
      end
      else
        vStr := '[ICMP STATUS: '+IntToStr(sckError)+'] '+SysErrorMessage(sckError);
    end
    else
      vStr := '[ICMP STATUS: '+IntToStr(sckError)+'] '+SysErrorMessage(sckError);
  finally
    WSACleanup;
    FreeMem(pReply);
    IcmpCloseHandle(hICMP);
  end;

end;

end.

[Человек_Борща]

Гм. Всеравно непонимаю. Не хватает ему ресурсов...
С переменной sckDestAddr тоже проблем нет. В sckDestAddr.S_addr тоже значение что и при вашем способе, получается.

Я переводил ICMP API сам, так сказать чтобы одном файлом было, с MSDN.
Выкладываю весь проект.

[Баламут]

Немного неверно функцию импортировал. Размер параметра не тот малость. Все не смотрел. Исправил лишь используемую в данном случае ф-ию.

[Человек_Борща]

Нет, не помогло к сожалению.
Проблема все таже, даже с исправлением из 2-го поста.
У вас работает проект с этим модулем?

[Баламут]

В том-то и петрушка, что все работает на ура.

[tarakan1983]

Доброго времени суток!
Использую Вашу функцию, но она у меня почему-то всегда в false, какой бы IP я не пинговал. Спотыкается на коде

if pReply.Status = IP_SUCCESS then
          begin
            vStr := Format('Successful reply from %s[%s] RTT=%d',
              [aAddress, IP2Str(pReply.Address), pReply.RoundTripTime]);
            Result := True;
          end;

У меня pReply.Status равен 0 а константа IP_SUCCESS=11000.
Что я делаю не так?

[Человек_Борща]

Вечером посмотрю. поищите на моём сайте, по слову ICMP. Там есть рабочая версия. Сейчас ссылку кинуть не могу.

[tarakan1983]

Я первым делом наткнулся на эту функцию на Вашем сайте, но работать её так и не заставил.

[Человек_Борща]

Вечером я заставлю =)) Сейчас прокся не пускает.