Delphi中用ICMP探测远程主机状态

　　网络通讯中经常需要确定远程主机是否存活，以决定下一部进行的操作。可以直接使用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; 文章来源于www.hot007.com //动态库中的函数声明 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 动态库 hot007.com 　　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表示没有回复，主机无法到达 文章来源于www.hot007.com 　　　　FreeMem(pRevData); 　　　　FreeMem(pIPE); 　　　　IcmpCloseHandle(hicmp); 　　　　FreeLibrary(hICMPdll);//释放动态库 　　　　WSAcleanup();//清理协议栈 　　end; end;