Как проверить наличие Internet [Delphi]

Иногда, необходимо провести проверку подключен ли компьютер пользователя к сети интернет.

Для решения данной задачи можно воспользоваться несколькими способами.

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 (ICMPInternet 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 запросы могут быть запрещены сетевым экраном, параметрами настройки сети провайдера или правилами прокси-сервера. Кроме того, сам интернет ресурс может быть настроен таким образом, чтобы не отвечать на такие запросы.

FileName: inettest.zip

EXE и исходные файлы
IDE: Delphi XE2
FileName: inettest.zip
Size 607.27 KB

(Visited 2 020 times, 1 visits today)

Комментарии закрыты.