Delphi中用ICMP探测远程主机是否存活

delphi中用icmp探测远程主机是否存活

2005-03-10 jlbnet

网络通讯中经常需要确定远程主机是否存活，以决定下一部进行的操作。可以直接使用icmp协议来实现，但是要考虑许多协议细节，实现起来比较麻烦。windows 自带的icmp库里有现成的函数可以使用，只要在使用前填充相应的数据结构就可以了。

以下是要使用的数据结构。这些结构msdn里有c形式的声明，这里给出的是delphi的形式。

//用到的协议数据结构
  pipoptioninfo = ^tipoptioninfo; // ip 头选项
  tipoptioninfo = packed record
    ttl: byte;//存活时间
    tos: byte;//type of service，请求类型
    flags: byte;//标志
    optionssize: byte;//选项长度
    optionsdata: pchar;//选项数据
  end;
  picmpechoreply = ^ticmpechoreply;
  ticmpechoreply = packed record  // icmp 返回信息
    address: dword;//ip地址
    status: dword;//状态
    rtt: dword;
    datasize: word;//数据长度
    reserved: word;//保留
    data: pointer;//数据
    options: tipoptioninfo;//选项区
  end;

//动态库中的函数声明
  ticmpcreatefile = function: thandle; stdcall; //创建icmp句柄
  ticmpclosehandle = function(icmphandle: thandle): boolean; stdcall; //关闭icmp句柄
  ticmpsendecho = function(icmphandle:thandle; destinationaddress:dword;
       requestdata:pointer; requestsize:word; requestoptions:pipoptioninfo;
       replybuffer:pointer; replysize:dword; timeout:dword):dword; stdcall;//发送icmp探测数据报

//要用到的变量声明
  hicmpdll,hicmp:thandle;
  wsadata:twsadata;
  icmpcreatefile:ticmpcreatefile;
  icmpclosehandle:ticmpclosehandle;
  icmpsendecho:ticmpsendecho;

//destip:要探测的远程地址，形如 192.168.1.1
procedure f_checkonline(destip:string);
var
  ipopt:tipoptioninfo;// 发包的 ip 选项
  ipaddr:dword;
  preqdata,prevdata:pchar;
  pipe:picmpechoreply;// icmp echo 回复缓冲区
  fsize: dword;
  mystring:string;
  ftimeout:dword;
  buffersize:dword;
  i:integer;
begin
  hicmpdll := loadlibrary('icmp.dll'); //调取icmp 动态库
  if hicmpdll<>null then
  begin
    wsastartup($101,wsadata);//初始化网络协议栈
    @icmpcreatefile := getprocaddress(hicmpdll, 'icmpcreatefile'); //取动态库中的导出函数
    @icmpclosehandle := getprocaddress(hicmpdll, 'icmpclosehandle');
    @icmpsendecho := getprocaddress(hicmpdll, 'icmpsendecho');
    hicmp := icmpcreatefile; //创建 icmp句柄
 ipaddr:= inet_addr(pchar(destip)); //取要探测的远端主机ip地址
   
   fsize := 40;
   buffersize := sizeof(ticmpechoreply) + fsize;
   getmem(prevdata,fsize);
   getmem(pipe,buffersize);
   fillchar(pipe^, sizeof(pipe^), 0);
   pipe^.data := prevdata;
   mystring := 'hi, online?';//任意字符串
   preqdata := pchar(mystring);
   fillchar(ipopt, sizeof(ipopt), 0);
   ipopt.ttl := 64;
   ftimeout := 500;//等待时长
   i:=icmpsendecho(hicmp, ipaddr, preqdata, length(mystring), @ipopt, pipe, buffersize, ftimeout);//如果有返回，返回值表示收到的回复的个数。如果为0表示没有回复，主机无法到达
   freemem(prevdata);
   freemem(pipe);
    icmpclosehandle(hicmp);
    freelibrary(hicmpdll);//释放动态库
    wsacleanup();//清理协议栈
  end;
end;