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

Question

以下代码是对从 icmp dll 调用的 IcmpPing 例程的测试。在调试中它工作正常，但在发布中它会抛出错误。该错误是由“IcmpCloseHandle”调用引起的，因为调用 IcmpSendEcho 以某种方式更改了句柄。它给人一种内存问题的感觉，但到目前为止，我发现的唯一修复方法是获取句柄的副本并将其用于关闭句柄调用。我已将代码精简到最低限度，包括将 IP 地址设置为整数(127.0.0.1 = $0100007F 小端)。我究竟做错了什么？我在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.

Answer 1

我认为答案是您忘记向 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;