！！！ping 后如何得到结果？即如何才能知道是否能通(程序实现)！

Question

请看这里：
C:\Program Files\Borland\Delphi6\Demos\Indy\PingGUI

Answer 1

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, winsock;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure ShowError(error: Integer);
  public
    { Public declarations }
  end;  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed record
     TTL:         Byte;      // Time To Live (used for traceroute)
     TOS:         Byte;      // Type Of Service (usually 0)
     Flags:       Byte;      // IP header flags (usually 0)
     OptionsSize: Byte;      // Size of options data (usually 0, max 40)
     OptionsData: PChar;     // Options data buffer
  end;  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
     Address:       DWord;                // replying address
     Status:        DWord;                // IP status value (see below)
     RTT:           DWord;                // Round Trip Time in milliseconds
     DataSize:      Word;                 // reply data size
     Reserved:      Word;
     Data:          Pointer;              // pointer to reply data buffer
     Options:       TIPOptionInformation; // reply options
  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;var
  Form1: TForm1;implementation{$R *.DFM}const
  IcmpDLL = 'icmp.dll';var
  hICMPlib: HModule;
  IcmpCreateFile : TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho:    TIcmpSendEcho;
  hICMP: THandle;                     // Handle for the ICMP Callsprocedure TForm1.FormCreate(Sender: TObject);
var
  wsadata: TWSAData;
begin
  // initialise winsock
  if WSAStartup($101,wsadata) <> 0 then begin
    ShowMessage('Error initialising Winsock');
    halt;
  end;  // register the icmp.dll stuff
  hICMPlib := loadlibrary(icmpDLL);
  if hICMPlib <> null then begin
    @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
    @IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');
    @IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');
    if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin
      ShowMessage('Error loading dll functions');
      halt;
    end;
    hICMP := IcmpCreateFile;
    if hICMP = INVALID_HANDLE_VALUE then begin
      ShowMessage('Unable to get ping handle');
      halt;
    end;
  end
  else begin
    ShowMessage('Unable to register ' + icmpDLL);
    halt;
  end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // Free icmp.dll
  IcmpCloseHandle(hICMP);
  FreeLibrary(hICMPlib);
  // free winsock
  if WSACleanup <> 0 then ShowMessage('Error freeing winsock');
end;procedure TForm1.Button1Click(Sender: TObject);
const
  Size = 56;
  TimeOut = 3000;
var
  Address: DWord;                     // Address of host to contact
  HostName, HostIP: String;           // Name and dotted IP of host to contact
  Phe: PHostEnt;                      // HostEntry buffer for name lookup
  BufferSize, nPkts: Integer;
  pReqData, pData: Pointer;
  pIPE: PIcmpEchoReply;               // ICMP Echo reply buffer
  IPOpt: TIPOptionInformation;        // IP Options for packet to send
begin
  // Do a lookup  Address := inet_addr(PChar(Edit1.Text));  if (Address = INADDR_NONE) then begin
    Phe := GetHostByName(PChar(Edit1.Text));
    if Phe = Nil then ShowError(WSAGetLastError)
    else begin
      Address := longint(plongint(Phe^.h_addr_list^)^);
      HostName := Phe^.h_name;
      HostIP := StrPas(inet_ntoa(TInAddr(Address)));
    end;
  end
  else begin
    Phe := GetHostByAddr(@Address, 4, PF_INET);
    if Phe = Nil then ShowError(WSAGetLastError)
    else begin
      HostName := Phe^.h_name;
      HostIP := StrPas(inet_ntoa(TInAddr(Address)));
    end;
  end;  if Address = INADDR_NONE then begin
    Memo1.Lines.Add('Cannot resolve hostname ' + Edit1.Text);
  end
  else
  begin
    Memo1.Lines.Add('Sending ' + IntToStr(Size) + ' bytes to ' +
      HostName + ' (' + HostIP + ')');    // Get some data buffer space and put something in the packet to send
    BufferSize := SizeOf(TICMPEchoReply) + Size;
    GetMem(pReqData, Size);
    GetMem(pData, Size);
    GetMem(pIPE, BufferSize);
    FillChar(pReqData^, Size, $AA);
    pIPE^.Data := pData;    // Finally Send the packet
    FillChar(IPOpt, SizeOf(IPOpt), 0);
    IPOpt.TTL := 64;
    NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
      @IPOpt, pIPE, BufferSize, TimeOut);
    if NPkts = 0 then ShowError(GetLastError)
      else
    begin
      //ShowMessage('ok');
      HostIP := StrPas(inet_ntoa(TInAddr(pIPE^.Address)));
      Memo1.Lines.Add('Received ' + IntToStr(pIPE^.DataSize) +
        ' bytes from ' + HostIP +
        ' in ' + IntToStr(pIPE^.RTT) + ' msecs')
    end;    // Free those buffers
    FreeMem(pIPE);
    FreeMem(pData);
    FreeMem(pReqData);
  end;
end;procedure TForm1.ShowError(error: integer);
begin
  Memo1.Lines.Add('Error: ' + IntToStr(error));
end;end.以上的例子中，返回的信息会加在memo中，只要获取了error，就知道是否ping通了