DELPHI实现ping
用DELPHI实现PING，程序运行是有错误，提示这两行
if Fipaddress=INADDR_NONE then
if pReqData^ = pIPE^.Options.OptionsData^ then
程序代码如下：
unit ping;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, winsock, StdCtrls;type PIPOptionInformation = ^TIPOptionInformation; TIPOptionInformation = packed record TTL: Byte; TOS: Byte; Flags: Byte; OptionsSize: Byte; OptionsData: PChar; end; type PIcmpEchoReply = ^TIcmpEchoReply; TIcmpEchoReply = packed record Address: DWORD; Status: DWORD; RTT: DWORD; DataSize:Word; Reserved: Word; Data: Pointer; Options: TIPOptionInformation; end; TIcmpCreateFile = function: THandle; stdcall; TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall; TIcmpSendEcho = function(IcmpHandle:THandle; DestinationAddress:DWORD; RequestData: Pointer; RequestSize: Word; RequestOptions: PIPOptionInformation; ReplyBuffer: Pointer; ReplySize: DWord; Timeout: DWord): DWord; stdcall;type TForm1 = class(TForm) StringGrid1: TStringGrid; Edit1: TEdit; Button1: TButton; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } hICMP: THANDLE; IcmpCreateFile : TIcmpCreateFile; IcmpCloseHandle:TIcmpCloseHandle; IcmpSendEcho: TIcmpSendEcho; line:integer; public { Public declarations } hICMPdll: HMODULE; end;var Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);begin hICMPdll := LoadLibrary('icmp.dll'); @ICMPCreateFile:= GetProcAddress(hICMPdll, 'IcmpCreateFile'); @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle'); @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho'); hICMP := IcmpCreateFile; StringGrid1.Cells[0,0]:=' '; StringGrid1.Cells[1,0]:='返回地址'; StringGrid1.cells[2,0]:='返回数据包大小'; StringGrid1.Cells[3,0]:='RTT(Round-Trip-Time)'; line:=1;end;procedure TForm1.Button1Click(Sender: TObject);var IPOpt:TIPOptionInformation; FIPAddress:DWORD; pReqData,pRevData:PChar; pIPE:PIcmpEchoReply; FSize: DWORD; MyString:string; FTimeOut:DWORD; BufferSize:DWORD;begin if Edit1.Text <> '' then begin FIPAddress:=inet_addr(PChar(Edit1.Text)); if Fipaddress=INADDR_NONE then Messagebox(self.handle,'地址无效','Ping32',64) else begin FSize:=80; BufferSize:=SizeOf(TICMPEchoReply)+FSize; GetMem(pRevData,FSize); GetMem(pIPE,BufferSize); FillChar(pIPE^, SizeOf(pIPE^), 0); pIPE^.Data := pRevData; MyString := 'Argen Ping32 Sending Message.'; pReqData := PChar(MyString); FillChar(IPOpt, Sizeof(IPOpt), 0); IPOpt.TTL:= 64; FTimeOut :=500; IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE, BufferSize, FTimeOut); try try if pReqData^ = pIPE^.Options.OptionsData^ then with StringGrid1 do begin if line>1 then rowcount:=line+1; cells[0,line]:=inttoStr(line); cells[1,line]:=Edit1.Text; cells[2,line]:=inttoStr(pIPE^.DataSize); cells[3,line]:=IntToStr(pIPE^.RTT); row:=rowcount-1; line:=line+1; end; except Messagebox(self.handle,'目标不可到','Ping32',64) end; finally FreeMem(pRevData); FreeMem(pIPE); end; end; end;end;procedure TForm1.FormDestroy(Sender: TObject);begin icmpclosehandle(hicmp); freelibrary(hicmpdll);end;end.这里是窗口设置object Form1: TForm1 Left = 326 Top = 250 Width = 451 Height = 267 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 24 Top = 28 Width = 71 Height = 13 Caption = '主机ip地址: ' end object StringGrid1: TStringGrid Left = 6 Top = 56 Width = 427 Height = 177 RowCount = 2 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing] TabOrder = 0 ColWidths = ( 64 123 98 126 8) RowHeights = ( 24 24) end object Edit1: TEdit Left = 112 Top = 24 Width = 121 Height = 21 TabOrder = 1 end object Button1: TButton Left = 272 Top = 22 Width = 65 Height = 25 Caption = 'ping' TabOrder = 2 OnClick = Button1Click endend.