hICMPDll,hICMP:THandle;
wsaData:TWSADATA;
ICMPCreateFile:TICMPCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
//destip:要探测的远程地址，形如 192.168.1.1
proceduref_CheckOnline(destip:string);
var
IPOpt:TIPOptionInfo;//发包的 IP 选项
IPAddr:DWORD;
pReqData,pRevData:PChar;
pIPE:PIcmpEchoReply;//ICMPEcho 回复缓冲区
FSize:DWORD;
MyString:string;
FTimeOut:DWORD;
BufferSize:DWORD;
i:integer;
begin
hICMPdll:=LoadLibrary('icmp.dll'); //调取 icmp 动态库
ifhICMPDll<>NULLthen
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,FTimeO
ut);//如果有返回，返回值表示收到的回复的个数。如果为 0 表示没有回复，主机无法到达
FreeMem(pRevData);
FreeMem(pIPE);
IcmpCloseHandle(hicmp);