Иногда, необходимо провести проверку подключен ли компьютер пользователя к сети интернет.
Для решения данной задачи можно воспользоваться несколькими способами.
1. функция InetIsOffline, как пишет MSDN, функция «Determines whether the system is connected to the Internet.» (Определяет, является ли система подключенной к Интернету).
Для использования функции, её необходимо импортировать из «url.dll»:
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
в нужном месте программы можно устроить следующую проверку:
if not InetIsOffline(0) then ShowMessage('You are connected to Internet!') else ShowMessage('This computer is not connected to Internet!');
В качестве возвращаемого значения используется BOOL:
Returns TRUE if the local system is not currently connected to the Internet. Returns FALSE if the local system is connected to the Internet or if no attempt has yet been made to connect to the Internet. (Возвращает TRUE, если локальная система в настоящее время не подключена к Интернету. Возвращает FALSE, если локальная система подключена к Интернету или если не было ни какой попытки подключения к Интернету.)
Таким образом, из описания (а также, из практики использования) функция не позволяет достоверно определить есть ли подключение к Интернету.
2. функция InternetGetConnectedState , как пишет MSDN, функция «Retrieves the connected state of the local system.» (Извлекает статус подключения локальной системы)
Для использования функции, её необходимо импортировать из «wininet.dll»:
function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved: DWORD): BOOL; stdcall; external 'wininet.dll' name 'InternetGetConnectedState';
подключить модуль
uses Wininet;
функция проверки выглядит следующим образом:
function InternetConnected: Boolean; var lpdwConnectionTypes: DWORD; begin lpdwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; { Returns TRUE if there is an active modem or a LAN Internet connection, or FALSE if there is no Internet connection, or if all possible Internet connections are not currently active.} Result := InternetGetConnectedState(@lpdwConnectionTypes, 0); end;
В качестве возвращаемого значения используется BOOL:
Returns TRUE if there is an active modem or a LAN Internet connection, or FALSE if there is no Internet connection, or if all possible Internet connections are not currently active. (Возвращает TRUE, если есть активный модем или подключение к Интернету по сети, или FALSE если нет подключения к Интернету, или если все возможные интернет-соединения в настоящее время не активны.)
Следует обратить внимание на следующее:
A return value of TRUE from InternetGetConnectedState indicates that at least one connection to the Internet is available. It does not guarantee that a connection to a specific host can be established. (Когда возвращенное от InternetGetConnectedState значение TRUE, это означает, что по крайней мере одно соединение с Интернетом доступно. Но это не гарантирует, что связь с определенным хостом может быть установлена.)
Таким образом, использование данного метода достаточно точное, хотя и не гарантирует доступность нужного ресурса.
3. метод использования Ping‘а или ICMP Echo-Request (ICMP — Internet Control Message Protocol). Для этого можно использовать функцию IcmpSendEcho. Ссылка на MSDN.
Данный метод позволяет точно определить доступность конкретного интернет-ресурса, или в общем случае доступность, например, DNS серверов Google (8.8.8.8) или Яндекс (77.88.8.8).
Чтобы не повторяться, ниже я приведу исходный текст модуля, включающий в себя все три метода проверки наличия интернет. Также, доступна ссылка на файл с исходным кодом.
unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, WinSock; type ip_option_information = packed record // header of an IP packet // Otherwise, the route option should be formatted as specified in RFC 791 Ttl: byte; // Time to live Tos: byte; // Type of service, generally 0 Flags: byte; // IP header flags, generally 0 OptionsSize: byte; // Size in bytes of options data, generally 0, max 40 OptionsData: Pointer; // Pointer to options data end; icmp_echo_reply = packed record Address: u_long; // Replying address, in the form of an IPAddr structure Status: u_long; // Status of the echo request, //in the form of an IP_STATUS code RTTime: u_long; // Round trip time, in milliseconds DataSize: u_short; // Reply data size, in bytes Reserved: u_short; // Reserved for system use Data: Pointer; // Pointer to the reply data Options: ip_option_information; // Reply options, in the form of an // IP_OPTION_INFORMATION structure end; PIPINFO = ^ip_option_information; PVOID = Pointer; function IcmpCreateFile(): THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile'; function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall; external 'ICMP.DLL' name 'IcmpCloseHandle'; function IcmpSendEcho(IcmpHandle: THandle; // handle, returned IcmpCreateFile() DestAddress: u_long; // Destination IP Address RequestData: PVOID; // The buffer that contains the data to send in the request RequestSize: Word; // The size, in bytes, of the request data buffer. RequestOptns: PIPINFO; // A pointer to the IP header options for the request, //in the form of an IP_OPTION_INFORMATION structure. //May be NULL ReplyBuffer: PVOID; // A buffer to hold any replies to the request. ReplySize: DWORD; // The allocated size, in bytes, of the reply buffer. // The buffer should be large enough to hold at least one // ICMP_ECHO_REPLY structure plus RequestSize bytes of data. Timeout: DWORD // The time, in milliseconds, to wait for replies. ): DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho'; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; function InternetGetConnectedState(lpdwFlags: LPDWORD; dwReserved: DWORD): BOOL; stdcall; external 'wininet.dll' name 'InternetGetConnectedState'; function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL'; function ping_iphost(iphost: PAnsiChar): Boolean; implementation uses Wininet; {$R *.dfm} function InternetConnected: Boolean; var lpdwConnectionTypes: DWORD; begin lpdwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; { Returns TRUE if there is an active modem or a LAN Internet connection, or FALSE if there is no Internet connection, or if all possible Internet connections are not currently active.} Result := InternetGetConnectedState(@lpdwConnectionTypes, 0); end; procedure TForm1.Button1Click(Sender: TObject); begin // checking internet connection // function InetIsOffline(0): TRUE - internet is OFF, FALSE - internet is ON if not InetIsOffline(0) then ShowMessage('You are connected to Internet!') else ShowMessage('This computer is not connected to Internet!'); end; procedure TForm1.Button2Click(Sender: TObject); begin // checking internet connection // function InternetConnected: TRUE - internet is ON, FALSE - internet is OFF // use InternetGetConnectedState if InternetConnected then ShowMessage('You are connected to Internet!') else ShowMessage('This computer is not connected to Internet!') end; procedure TForm1.Button3Click(Sender: TObject); begin // checking internet connection // function ping_iphost(IP_HOST): TRUE - internet is ON, FALSE - internet is OFF // sent ICMP echo reply if ping_iphost('8.8.8.8') then ShowMessage('You are connected to Internet!') else ShowMessage('This computer is not connected to Internet!') end; function ping_iphost(iphost: PAnsiChar): Boolean; var hIP: THandle; pingBuffer: array [0 .. 31] of AnsiChar; pIpe: ^icmp_echo_reply; error: DWORD; begin Result := True; pingBuffer := 'Data Buffer'; // Create handle hIP := IcmpCreateFile(); //allocates a memory block GetMem(pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer)); try // sends an ICMP Echo request and returns any replies IcmpSendEcho(hIP, inet_addr(iphost), @pingBuffer, sizeof(pingBuffer), Nil, pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer), 1000); // Returns the last error reported by an operating system API call error := GetLastError(); if (error <> 0) then begin Result := False; end; finally //closes a handle opened by a call to IcmpCreateFile IcmpCloseHandle(hIP); // terminates use of the WS2_32.DLL WSACleanup(); // frees a memory block previously allocated with GetMem FreeMem(pIpe); end; end; end.
Следует также понимать, что в ряде случаев ICMP запросы могут быть запрещены сетевым экраном, параметрами настройки сети провайдера или правилами прокси-сервера. Кроме того, сам интернет ресурс может быть настроен таким образом, чтобы не отвечать на такие запросы.
EXE и исходные файлы
IDE: Delphi XE2
FileName: inettest.zip
Size 607.27 KB
Комментарии закрыты.