知道对方IP，怎样在程序里确认对方是否在线？

Question

知道对方IP，怎样在程序里确认对方是否在线？
如果用Ping的话，怎样在程序里实现，多谢了!

Answer 1

//pingunit PING;interfaceuses WinSock, Types, Windows, Classes, SysUtils;type
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed record
    TTL: Byte;
    TOS: Byte;
    Flags: Byte;
    OptionsSize: Byte;
    OptionsData: PChar;
  end;  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;  TPingParam = record
    H: THandle;
    Msg: integer;    PingIP: string;
    TimeOut: integer;
    PingTimes: integer;
  end;  TPingThread = class(TThread)
  private
    FIP: DWORD;
    FIPStr: string;
    FTimeOut: integer;
    FFormHandle: THandle;
    FMsg: integer;
    FPingTimes: integer;  protected
    procedure Execute; override;
  public
    constructor Create(PingParam: TPingParam;
      RsltStrings: TStrings);
    destructor Destroy; override;
  end;implementationvar
  ICMPHandle: HMODULE;
  ICMPCreateFile : TIcmpCreateFile;
  ICMPCloseHandle: TIcmpCloseHandle;
  ICMPSendEcho: TIcmpSendEcho;function LoadICMPDll: boolean;
begin
  ICMPHandle := LoadLibrary('icmp.dll');
  if ICMPHandle = 0 then
    Result := False
  else
  begin
    @ICMPCreateFile := GetProcAddress(ICMPHandle, pchar('IcmpCreateFile'));
    @ICMPCloseHandle := GetProcAddress(ICMPHandle, pchar('IcmpCloseHandle'));
    @ICMPSendEcho := GetProcAddress(ICMPHandle, pchar('IcmpSendEcho'));
    Result := True;
  end;
end;procedure UnLoadICMP;
begin
  if ICMPHandle <> 0 then
    FreeLibrary(ICMPHandle);
end;{ TPingTHread }{ TPingTHread }constructor TPingTHread.Create(PingParam: TPingParam; RsltStrings: TStrings);
var
  WSAData: TWSAData;
//  Phe : PHostEnt;
begin
  Inherited Create(False);
  if WSAStartup($101, WSAData) <> 0 then
    Terminate;
  if not LoadICMPDll then
    Terminate;
  FIPStr := PingParam.PingIP;
  FIP := inet_addr(pchar(PingParam.PingIP));
{  if FIP = INADDR_NONE then
  begin
    Phe := GetHostByName(PChar(PingParam.PingIP));
    if Phe = nil then
    begin
      raise Exception.Create('Unknow Host!');
      Terminate;
    end else
      FIP := longint(plongint(Phe^.h_addr_list^)^);
  end;     }  FTimeOut := PingParam.TimeOut;
  FFormHandle := PingParam.H;
  FMsg := PingParam.Msg;
  FPingTimes := PingParam.PingTimes;
  FreeOnTerminate := True;
end;destructor TPingTHread.Destroy;
begin
  ICMPCloseHandle(ICMPHandle);
  WSACleanUp;
  UnLoadICMP;
  inherited;
end;procedure TPingTHread.Execute;
var
  IPOpt: TIPOptionInformation;   // IP Options for packet to send
  pReqData, pRevData: PChar;
  pIPE: PIcmpEchoReply;          // ICMP Echo reply buffer
  DataSize: DWORD;
  StrToSend: string;
  BufSize: DWORD;
  HICMP: THandle;
  StrMsg: string;
  n: integer;
  IsThere: integer;              // 是否ping通
begin
  inherited;
  DataSize := 40;
  BufSize := SizeOf(TICMPEchoReply) + DataSize;
  GetMem(pRevData, DataSize);
  GetMem(pIPE, BufSize);
  FillChar(pIPE^, SizeOf(pIPE^), 0);
  pIPE^.Data := pRevData;
  StrToSend := 'Hello,WorldAAAAA';
  pReqData := PChar(StrToSend);
  FillChar(IPOpt, Sizeof(IPOpt), 0);
  IPOpt.TTL := 64;
  HICMP := ICMPCreateFile;
  try
    for n := 1 to FPingTimes do
    begin
      ICMPSendEcho(HICMP, FIP, pReqData, Length(StrToSend), @IPOpt, pIPE, BufSize, FTimeOut);
      try
        if pReqData^ = pIPE^.Options.OptionsData^ then
        begin
          StrMsg := 'Reply from ' + FIPStr + ': bytes=' + IntToStr(pIPE^.DataSize)
            + ' TTL=' + IntToStr(pIPE^.RTT);
          IsThere := 1;
        end else
        begin
          StrMsg := 'Time out from ' + FIPStr;
          IsThere := 0;
        end;
      except
        StrMsg := 'Time out from ' + FIPStr;
        IsThere := 0;
      end;      PostMessage(FFormHandle, FMsg, integer(pchar(StrMsg)), IsThere);
    end;
  finally
    FreeMem(PRevData);
    FreeMem(pIPE);
  end;
end;end.
------------------------------
unit uMain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;const
  WM_PING = WM_USER + $1024;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure WMPing(var Msg: TMessage); message WM_PING;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses PING;{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
  P: TPingParam;
begin
  P.H := Handle;
  p.Msg := WM_PING;
  p.PingIP := Edit1.Text;
  P.TimeOut := 4000;
  p.PingTimes := 4;
  Memo1.Lines.Add('--------------------------------------------------------');
  Memo1.Lines.Add('Ping ' + Edit1.Text + ' ...');
  TPingThread.Create(P, nil);
end;procedure TForm1.WMPing(var Msg: TMessage);
var
  Str: string;
begin
  if Msg.LParam = 0 then
    Str := '不通'
  else
    Str := '通';
  Memo1.Lines.Add(pchar(Msg.WParam) + Str);
end;end.

Answer 2

Delphi6以上有现成的Icmp控件。