unit dllping; interface uses windows,sysutils,winsock; //function initdllping : boolean; //procedure uninitdllping; function ping (host : string) : integer; implementation type TSunB = packed record s_b1, s_b2, s_b3, s_b4: byte; end; TSunW = packed record s_w1, s_w2: word; end; PIPAddr = ^TIPAddr; TIPAddr = record case integer of 0: (S_un_b: TSunB); 1: (S_un_w: TSunW); 2: (S_addr: longword); end; IPAddr = TIPAddr; {type TIP_OPTION_INFORMATION = record Ttl : char; // Time To Live Tos : char; // Type Of Service Flags : char; // IP header flags OptionsSize : char; // Size in bytes of options data OptionsData : pointer; // Pointer to options data end; type IP_ECHO_REPLY = record Address : dword; // Replying address Status : longword; // Reply status RoundTripTime : longword; // RTT in milliseconds DataSize : byte; // Echo data size Reserved : byte; // Reserved for system use Data : pointer; // Pointer to the echo data Options : TIP_OPTION_INFORMATION; // Reply options end; } //type {TIcmpCreateFile = function : thandle; stdcall; TIcmpCloseHandle = function (IcmpHandle : thandle ) : boolean; stdcall; TIcmpSendEcho = function (IcmpHandle : THandle; DestinationAddress : IPaddr; RequestData : pointer; RequestSize : smallint; RequestOptions : pointer; replybuffer : pointer; replysize : Dword; timeout : dword) : dword; } function IcmpCreateFile : THandle; stdcall; external 'icmp.dll'; function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll' function IcmpSendEcho (IcmpHandle : THandle; DestinationAddress : IPAddr; RequestData : Pointer; RequestSize : Smallint; RequestOptions : pointer; ReplyBuffer : Pointer; ReplySize : DWORD; Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll'; //var //PINGDLLInstance : Thandle; //IcmpCreatefile : Ticmpcreatefile; //IcmpCloseHandle : TIcmpcloseHandle; //IcmpSendEcho : TIcmpSendEcho; {function initdllping : boolean; begin result:=true; PINGDLLInstance := Loadlibrary('icmp.DLL'); if PINGDLLInstance= 0 then begin result:=false; exit; end; //@IcmpCreateFile:=getprocaddress(PINGDLLINSTANCE,'IcmpCreateFile'); //@IcmpCloseHandle:=getprocaddress(PINGDLLINSTANCE,'IcmpCloseHandle'); //@IcmpSendEcho:=getprocaddress(PINGDLLINSTANCE,'IcmpSendEch'); end; } {procedure uninitdllping; begin freelibrary(PINGDLLInstance); end; } function ping (host : string) : integer; var H : Phostent; Inaddr : IPAddr; hand : thandle; res : DWORD; rep : array[1..128] of byte; pac : Pansichar; phost : ansichar; begin strpcopy(phost,host); H := GetHostByName(PAnsiChar(host)); If H=nil then begin result:=-1; exit; end; pac := h^.h_addr_list^; if Assigned(pac) then begin with TIPAddr(Inaddr).S_un_b do begin s_b1 := Byte(pac[0]); s_b2 := Byte(pac[1]); s_b3 := Byte(pac[2]); s_b4 := Byte(pac[3]); end; end; hand := icmpcreatefile; result:=-2; if hand= INVALID_HANDLE_VALUE then exit; res:=IcmpSendEcho(hand,InAddr,nil,0,nil,@rep,128,2000); Result:= res; IcmpCloseHandle(hand); end; end.