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;