Index » Empathy Jukebox : Blob 797a22 / dllping.pas
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 : Pchar;
begin
H := GetHostByName(pchar(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.