Check Internet Connection

uses Winsock

var
  Form1: TForm1;
  WaitTimeMs: WORD;
  InitialTick, DifTick: DWORD;
  
//

function BlockingHookProc: Boolean; stdcall;
  begin
    { Returns False to end Winsock internal testing loop }
    Result := False;

    { Verify time expiration, taking into account rare but possible counter recycling (49.7 days) }
    if GetTickCount < InitialTick then DifTick := $FFFFFFFF - InitialTick + GetTickCount
    else
      DifTick := GetTickCount - InitialTick;

    { Limit time expired, then cancel Winsock operation }
    if (DifTick > WaitTimeMs) and WSAIsBlocking then WSACancelBlockingCall;
  end;


  { To inform connection state to net (may be an object method) }
  function IsConnectedToNet(HostIP: string; HostPort, CancelTimeMs: Word;
    FirstOctet: Byte; PError: PChar): Boolean;
  var
    GInitData: TWSADATA;
    SockDescript: TSocket;
    SockAddr: TSockAddr;
    NameLen: Integer;

    { Auxiliary procedure just to format error string }
    procedure SaveError(Proc: string; const LastError: Integer);
    begin
      StrLCopy(PError, PChar(Proc + ' - Error no.' + IntToStr(LastError)), 255);
    end;

  { Auxiliary function to return a random IP address, but keeping some desired octets fixed at left.
    FirstOctet gives the order of the octet (1 to 4, left to right) from which to randomize }
    function GetRandomSimilarIP(InitIP: string): string;
    var
      Index: Integer;
      P1, P2: PChar;
    begin
      Result := '';

      InitIP := InitIP + '.';  // Final dot added to simplify algorithm

      P1 := @InitIP[1];

      for Index := 1 to 4 do 
      begin  // Extracts octets from initial IP address
        P2 := StrPos(P1, '.');

        if Index < FirstOctet then Result := Result + Copy(P1, 0, P2 - P1)
        else
          Result := Result + IntToStr(1 + Random(254));

        if Index < 4 then Result := Result + '.'
        else 
          Break;

        P1 := P2 + 1;
      end;
    end;
  begin
    { Inicializes as not connected }
    Result := False;

    WaitTimeMs := CancelTimeMs;

    { Inicializes error string }
    if PError <> nil then PError[0] := #0;

    { Inicializes Winsock 1.1 (don't use Winsock 2+, which doesn't implement such blocking hook) }
    if WSAStartup($101, GInitData) <> 0 then 
    begin
      if PError <> nil then SaveError('WSAStartup', WSAGetLastError);
      Exit;
    end;

    try
      { Establishes Winsock blocking hook routine }
      if WSASetBlockingHook(@BlockingHookProc) = nil then 
      begin
        if PError <> nil then SaveError('WSASetBlockingHook', WSAGetLastError);
        Exit;
      end;

      try
        { Creates a new socket }
        SockDescript := Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

        if SockDescript = INVALID_SOCKET then 
        begin
          if PError <> nil then SaveError('Socket', WSAGetLastError);
          Exit;
        end;

        try
          { Initializes local socket data }
          SockAddr.sin_family      := AF_INET;
          SockAddr.sin_port        := 0;       // System will choose local port from 1024 to 5000
          SockAddr.sin_addr.S_addr := 0;
          // System will choose the right local IP address, if multi-homed

          { Associates local IP and port with local socket }
          if Bind(SockDescript, SockAddr, SizeOf(SockAddr)) <> 0 then 
          begin
            if PError <> nil then SaveError('Bind', WSAGetLastError);
            Exit;
          end;

          { Initializes remote socket data }
          SockAddr.sin_family := AF_INET;
          SockAddr.sin_port   := htons(HostPort);  // Any port number different from 0

          { Does random variation on last octets of specified IP (any valid IP address on desired subnet) }
          if FirstOctet in [1..4] then
            SockAddr.sin_addr := in_addr(inet_addr(PChar(GetRandomSimilarIP(HostIP))))
              { If FirstOctet = 0 or > 4, does not generate random octets (use exact IP specified) }
          else
            SockAddr.sin_addr := in_addr(inet_addr(PChar(HostIP)));

          { Inicializes time counter }
          InitialTick := GetTickCount;

          { Tries to connect }
          if Connect(SockDescript, SockAddr, SizeOf(SockAddr)) <> 0 then 
          begin
            { Tests if it is connected }
            Result := (WSAGetLastError = WSAECONNREFUSED) or  // Connection refused (10061)
              (WSAGetLastError = WSAEINTR) or
              // Interrupted system call (10004)
              (WSAGetLastError = WSAETIMEDOUT);
            // Connection timed out (10060)

            { It may have occurred an error but testing indicated being connected }
            if PError <> nil then SaveError('Connect', WSAGetLastError);
          end
          { No error }
          else 
          begin
            NameLen := SizeOf(SockAddr);

            { Tries to get remote IP address and port }
            Result := (GetPeerName(SockDescript, SockAddr, NameLen) = 0);

            if not Result and (PError <> nil) then
              SaveError('GetPeerName', WSAGetLastError);
          end;
        finally
          CloseSocket(SockDescript);  // Frees the socket
        end;
      finally
        WSAUnhookBlockingHook;  // Deactivates the blocking hook
      end;
    finally
      WSACleanup;  // Frees Winsock (or decreases use count)
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  KConnected: Boolean;
  PError: array[0..255] of Char;
begin
  {--- Example 1: To verify connection to Internet and show error message returned ---}
  // Google IP
  KConnected := IsConnectedToNet('172.217.30.9', 80, 1000, 3, PError);

  if StrLen(PError) > 0 then    ShowMessage('IsConnectedToNet: ' +
    IntToStr(Integer(KConnected)) + '. Error returned: ' + PError)
  else ShowMessage('IsConnectedToNet: ' + IntToStr(Integer(KConnected)));

  {--- Example 2: To just verify connection to Internet ---}
  // Google IP
  KConnected := IsConnectedToNet('172.217.30.9', 80, 1000, 3, nil);

  ShowMessage('IsConnectedToNet: ' + IntToStr(Integer(KConnected)));
end;