Delphi IcmpPing仅在发布时出现异常,在调试中正常

时间:2014-08-28 06:43:30

标签: delphi

以下代码是对从icmp dll调用的IcmpPing例程的测试。在调试它工作正常,但在发布它会抛出一个错误。该错误是由“IcmpCloseHandle”调用引起的,因为调用IcmpSendEcho已经以某种方式更改了句柄。它有内存问题的感觉,但到目前为止唯一的修复我发现它采取句柄的副本并使用它来关闭句柄调用。我已经将代码修剪到最小,包括将ip地址作为整数(127.0.0.1 = $ 0100007F little endian)。我究竟做错了什么?我在2010年测试过这个问题,XE2和XE4都遇到了同样的问题。

任何想法


unit icmptest1;

interface

uses
//  Windows, Messages, SysUtils, Variants, Classes, Graphics,
//  Controls, Forms, Dialogs, StdCtrls;
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TSunW = packed record
    s_w1, s_w2: word;
  end;

  PIPAddr = ^TIPAddr;
  TIPAddr = record
    case integer of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  end;

 IPAddr = TIPAddr;

  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
  ICMP_ECHO_REPLY = packed record
    Address : IPAddr;
    Status : ULONG;
    RoundTripTime : ULONG;
    DataSize : WORD;
    Reserved : WORD;
    Data : Pointer;
  end;

  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
  IP_OPTION_INFORMATION = packed record
    Ttl : byte;
    Tos : byte;
    Flags : byte;
    OptionsSize : byte;
    OptionsData : Pointer;
  end;

type
  TForm34 = class(TForm)
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function  IcmpCreateFile : HWnd; stdcall; external 'icmp.dll';
function  IcmpCloseHandle(const IcmpHandle : HWnd) : longbool; stdcall; external 'icmp.dll';
function  IcmpSendEcho(const IcmpHandle: HWnd; const DestinationAddress: IPAddr ;const RequestData: Pointer;const RequestSize : WORD;const RequestOptions : PIP_OPTION_INFORMATION;const ReplyBuffer : Pointer;const ReplySize : DWORD;const TimeOut : DWORD) : DWORD; stdcall; external 'icmp.dll';

var
  Form34: TForm34;

implementation

{$R *.dfm}
{$T+}

function IcmpPing1(): Boolean;
var
  dwSize : DWORD;
  DW: DWord;
  IPAddr: TIPAddr;
  EchoReply: ICMP_ECHO_REPLY;
  hICMP : HWnd;
  Hc: HWnd;

begin
  Result := False;
  hICMP := IcmpCreateFile;
  Hc := hICMP;

  if hICMP <> INVALID_HANDLE_VALUE then
  begin
    try
      dwSize := SizeOf(ICMP_ECHO_REPLY) + 8;

      IPAddr.S_addr := $0100007F; // 127.0.0.1

      ShowMessage(Format('1: %x',[hICMP]));
      DW := IcmpSendEcho(hICMP, IPAddr, nil, 0, nil, @EchoReply, dwSize, 500);
      hICMP := Hc;
      ShowMessage(Format('2: %x',[hICMP]));

      Result := (EchoReply.Status = 0);
    finally
      try
        IcmpCloseHandle(hICMP);
      except
        on e:exception do
          ShowMessage(e.Message);
      end;
    end;
  end;
end;

procedure TForm34.Button2Click(Sender: TObject);
begin
  ShowMessage(IntToStr(Byte(IcmpPing1())));
end;

end.

2 个答案:

答案 0 :(得分:1)

<强>固定

replybuffer相对于声明的大小而言太小&#34; dwSize:= SizeOf(ICMP_ECHO_REPLY)+ 8&#34;。我在replybuffer中添加了8个字节来保存额外的回复数据。

答案是将8个字节添加到记录中并生成dwSize:= SizeOf(ICMP_ECHO_REPLY);.

转储回复缓冲区的内容显然是回复覆盖了其他变量。

答案 1 :(得分:0)

我认为答案是您忘记向ICMP_ECHO_REPLY添加选项,因此缓冲区的大小错误

type
  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
  IP_OPTION_INFORMATION = packed record
    Ttl : byte;
    Tos : byte;
    Flags : byte;
    OptionsSize : byte;
    OptionsData : Pointer;
  end;



  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
  ICMP_ECHO_REPLY = packed record
    Address : in_addr;
    Status : ULONG;
    RoundTripTime : ULONG;
    DataSize : WORD;
    Reserved : WORD;
    Data : Pointer;
    **options : IP_OPTION_INFORMATION;**
  end;