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;

//动态库中的函数声明

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探测数据报

//要用到的变量声明

hICMPDllhICMP:THandle;

wsaData:TWSADATA;

ICMPCreateFile:TICMPCreateFile;

IcmpCloseHandle:TIcmpCloseHandle;

IcmpSendEcho:TIcmpSendEcho;

//destip:要探测的远程地址形如

procedure f_CheckOnline(destip:string);

var

IPOpt:TIPOptionInfo;// 发包的 IP 选项

IPAddr:DWORD;

pReqDatapRevData:PChar;

pIPE:PIcmpEchoReply;// ICMP Echo 回复缓沖区

FSize: DWORD;

MyString:string;

FTimeOut:DWORD;

BufferSize:DWORD;

i:integer;

begin

hICMPdll := LoadLibrary(icmpdll); //调取icmp 动态库

if hICMPDll<>NULL then

begin

WSAStartup($wsaData);//初始化网络协议栈

@ICMPCreateFile := GetProcAddress(hICMPdll IcmpCreateFile); //取动态库中的导出函数

@IcmpCloseHandle := GetProcAddress(hICMPdll IcmpCloseHandle);

@IcmpSendEcho := GetProcAddress(hICMPdll IcmpSendEcho);

hICMP := IcmpCreateFile; //创建 icmp句柄

IPAddr:= inet_addr(PChar(destip)); //取要探测的远端主机ip地址

FSize := ;

BufferSize := SizeOf(TICMPEchoReply) + FSize;

GetMem(pRevDataFSize);

GetMem(pIPEBufferSize);

FillChar(pIPE^ SizeOf(pIPE^) );

pIPE^Data := pRevData;

MyString := Hi OnLine?;//任意字符串

pReqData := PChar(MyString);

FillChar(IPOpt Sizeof(IPOpt) );

IPOptTTL := ;

FTimeOut := ;//等待时长

i:=IcmpSendEcho(hICMP IPAddr pReqData Length(MyString) @IPOpt pIPE BufferSize FTimeOut);//如果有返回返回值表示收到的回复的个数如果为表示没有回复主机无法到达

FreeMem(pRevData);

FreeMem(pIPE);

IcmpCloseHandle(hicmp);

FreeLibrary(hICMPdll);//释放动态库

WSAcleanup();//清理协议栈

end;

end;