function IsConnectedToNet(HostIP: string; HostPort, CancelTimeMs: Word;
  FirstOctet: Byte; PError: PChar): Boolean;

{GENERAL EXPLANATION:

This function returns a Boolean value indicating if the computer is connected to a desired
subnet, in particular to Internet.

My basic need was to know periodically, say at each 5 seconds, if a computer was connectable or not
to Internet, by means of a modem connection (dial-up and cable-modem) or a LAN connection (Microsoft
ICS and a generic proxy like Socks5).

After trying to use WinInet and some other stuff, I concluded all that was too much slow and
not precise.

Then I turned back to basic Winsock and got the general function here described which, using a
clever timing schema, can respond usually in less than one second what is the condition of a general
kind of connection.

It tests if a machine is TCP/IP connectable to a supplied argument HostIP address, typical to that
class of IP addresses or subnet on which we are interested.
So, if using Microsoft ICS, a client machine could specify HostIP address 192.168.0.1 or any
other address of class 192.168.0.XXX to test for a connection to the ICS server machine.
Correspondly, if interested in testing the direct access to Internet it could be specified any
other HostIP address valid on Internet, preferably one "near" to its own area, to speed up even more
the process.

The argument HostPort permits to specify a port number to be used during testing.
This number is not very important, as we are not really interested in connecting to HostIP address,
as the kind of information we need is much more of "router" nature.
So, even if the HostIP address does not possess a service operating on the specified port, the
function can detect if the HostIP address is connectable or not, just using a simple timing schema.

The main idea is that if there isn't a connectable route to a specified HostIP address, then the system
returns this information in a very fast way. If it takes a longer time, then this is because connection
is possible (there is a route, even if is not possible a connection...).

The argument CancelTimeMs permits to specify the maximum time in miliseconds the function will wait
until give up and conclude the connection state is true. Usually a value of 1000 ms is enough, but
some experimentation may be necessary to compensate for local network latency times and so on.

The argument FirstOctet permits to vary randomically the final IP address used in testing.
This is provided in order to prevent causing abuse, by imposing a heavy access load on a same fixed and
living IP address. It indicates the order number from 1 to 4 (left to right) of the first octet in
HostIP address from which randomizing is to be applied. Its use is optional, as a value of 0 or greater
than 4 results in no randomizing at all. In general, using for HostIP an address in your Internet area,
a value of 3 or 4 for FirstOctet is a good choice.

The last argument PError is optional (can be nil) and corresponds to a buffer of 255 characters
maximum length, that can be used to collect the error messages issued by the function.
Its main use is possibly for debugging or instructional purposes.


CODING:
}
uses Winsock;


  { Declaration of global variables }
var
  
WaitTimeMs: WORD;
  InitialTick, DifTick: DWORD;


  procedure TForm.FormCreate(Sender: TObject);
  begin
    
Randomize;  // Generates a new random randomizing seed
  
end;


{ Auxiliary Winsock blocking hook function (can't be an object method).
  Consult Winsock API WSASetBlockingHook function for details }
  
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;


  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: stringconst 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.
    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 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 }
    
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 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

          
if FirstOctet in [1, 4] then  // Any valid IP address on desired subnet
            
SockAddr.sin_addr := in_addr(inet_addr(PChar(GetRandomSimilarIP(HostIP))))
          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 <> nilthen
              
SaveError('GetPeerName', WSAGetLastError);
          end;
        finally
          
CloseSocket(SockDescript);  // Frees the socket
        
end;
      finally
        
WSAUnhookBlockingHook;  // Deactivates the blocking hook
      
end;
    finally
      
WSACleanup;  // Frees Winsock
    
end;
  end;


// Examples:

var
  
KConnected: Boolean;
  PError: array[0..255] of Char;

  {--- To verify connection to Internet and show error message returned ---}
  
KConnected := IsConnectedToNet('81.29.65.150', 80, 1000, 3, PError);

  if StrLen(PError) > 0 then
    
ShowMessage('IsConnectedToNet (' + IntToStr(Integer(KConnected)) + ') returned error ' + PError);

  {--- To just verify connection to Internet ---}
  
KConnected := IsConnectedToNet('81.29.65.150', 80, 1000, 3, nil);