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;