以下代码是对从 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.
最佳答案
我认为答案是您忘记向 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;
关于Delphi IcmpPing 异常仅在发布中出现,在调试中正常,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/25548211/