Rede - ping sem usar componentes

// sem usar componentes...

unit ping;

interface

uses

  Windows, SysUtils, Classes;

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;

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';

function Ping(const IP: string; TimeOut: Integer = 250): boolean;

implementation

uses WinSock;

function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean = True): string;

var

  iPos: Integer;

begin

  if ADelim = #0 then

  begin

    // AnsiPos does not work with #0

    iPos := Pos(ADelim, AInput);

  end

  else

    iPos := Pos(ADelim, AInput);

  if iPos = 0 then

  begin

    Result := AInput;

    if ADelete then AInput := '';

  end

  else

  begin

    Result := Copy(AInput, 1, iPos - 1);

    if ADelete then

      Delete(AInput, 1, iPos + Length(ADelim) - 1);

  end;

end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);

var

  phe: PHostEnt;

  pac: PChar;

  GInitData: TWSAData;

begin

  WSAStartup($101, GInitData);

  try

    phe := GetHostByName(PChar(AIP));

    if Assigned(phe) then

    begin

      pac := phe^.h_addr_list^;

      if Assigned(pac) then

      begin

        with TIPAddr(AInAddr).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

      else

        raise Exception.Create('Error getting IP from HostName');

    end

    else

      raise Exception.Create('Error getting HostName');

  except

    FillChar(AInAddr, SizeOf(AInAddr), #0);

  end;

  WSACleanup;

end;

function Ping(const IP: string; TimeOut: Integer = 250) : boolean;

var

 Handle: THandle;

 InAddr: IPAddr;

 DW    : DWORD;

 rep   : array[1..128] of byte;

begin

  result := false;

  Handle := IcmpCreateFile;

  if Handle = INVALID_HANDLE_VALUE then Exit;

  TranslateStringToTInAddr(IP, InAddr);

  DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, TimeOut);

  Result := (DW <> 0);

  IcmpCloseHandle(Handle);

end;

end.