菜鸟入门之二 求ping IP代码一段

Question

本人是菜鸟，想自己做一个PING局域网IP使用情况的小程序，望高手指点指
希望能说说具体方法和提供源码
＾＿＾

Answer 1

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.