Title: How to determine if there is an active connection to the internet (2) UPDATE
function IsConnectedToNet(HostIP: string; HostPort, CancelTimeMs: Word;
FirstOctet: Byte; PError: PChar): Boolean;
uses Winsock;
{ Declaration of global variables }
var
WaitTimeMs: WORD;
InitialTick, DifTick: DWORD;
procedure TForm.FormCreate(Sender: TObject);
begin
//...
{ Generates a new random randomizing seed, in order to not always repeate
the same random IP numbers sequence }
Randomize;
//...
end;
{ Auxiliary Winsock blocking hook function (can't be an object method).
Consult Winsock 1.1 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 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 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;
Usage Example:
var
KConnected: Boolean;
PError: array[0..255] of Char;
{--- Example 1: 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)) + '. Error returned: ' + PError)
else ShowMessage('IsConnectedToNet: ' + IntToStr(Integer(KConnected)));
{--- Example 2: To just verify connection to Internet ---}
KConnected := IsConnectedToNet('81.29.65.150', 80, 1000, 3, nil);
ShowMessage('IsConnectedToNet: ' + IntToStr(Integer(KConnected)));
- - - - -&&&- - - - -