...überprüfen, ob eine Verbindung zum Internet besteht (2) UPDATE?
Autor: Roberto de Martin Serqueira
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 or cable-modem) or a LAN connection (Microsoft ICS
and a generic proxy like Socks5).
After trying to use WinInet, Url.dll and some other stuff, I concluded all that was too much slow and not
precise or reliable.
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 one could specify 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 actually interested in connecting to HostIP address and
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 can be done 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. Obviously, the function is also useful to test basic connection
access to specific and fixed IP and port, thus setting FirstOctet to 0.
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. Observe that, by construction,
Winsock errors occurrence is normally expected.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
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 < 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;
// Examples:
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)));
- - - - -&&&- - - - -
printed from
www.swissdelphicenter.ch
developers knowledge base