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探測數據報

　　//要用到的變量聲明
　　  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;