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;
From:http://tw.wingwit.com/Article/program/Delphi/201311/24701.html