DELPHI实现ping

Question

用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
  end
end. 

Answer 1

原则上edit1中应该可以输入IP或者域名
你将
FIPAddress:DWORD;
FIPAddress:=inet_addr(PChar(Edit1.Text));
if Fipaddress=INADDR_NONE then
限制死了，所以出错，改为
if inet_addr(PChar(Edit1.Text))=INADDR_NONE then即可
inet_addr函数是将IP地址转换为标准的网络地址格式，如果返回失败，说明输入的不是IP地址

Answer 2

还有问题呀，提示这行
if pReqData^ = pIPE^.Options.OptionsData^ then错误提示：Project Project2.exe raised exception class EAccessViolation with message 'Access violation at address 0045E44 in module 'Project2.exe'. Read of address 00000000'. Process stopped. Use Step or Run to continue.

Answer 3

procedure TVpnForm.Label5Click(Sender: TObject);
begin
IdIcmpClient1.host:=IP地址;
IdIcmpClient1.Ping;
end;
procedure TVpnForm.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
if AReplyStatus.ReplyStatusType = rsEcho then
    begin
        ShowMessage('Reply from '+AReplyStatus.FromIpAddress+' bytes='+inttostr(IdIcmpClient1.ReplyStatus.BytesReceived)+' time='+inttostr(IdIcmpClient1.ReplyStatus.MsRoundTripTime)+' TTL='+inttostr(IdIcmpClient1.ReplyStatus.TimeToLive));
    end else
    begin
       ShowMessage('time out');
    end;end;