Проверка подключения к интернету

var
  dwConnectionTypes: DWORD;
begin
  if not(InternetCheckConnection('http://microsoft.com', $00000001, 0) = true)
  then
  begin
    Showmessage('Нет подключения к интернету.');
  end
  else
  begin
    Showmessage('Есть подключения к интернету.');
  end;
end;

unit Ping;
 
interface
 
function PingHost(const HostName: AnsiString; TimeoutMS: cardinal = 500): boolean;
 
implementation
 
uses Windows, SysUtils, WinSock;
 
function IcmpCreateFile: THandle; stdcall; external 'iphlpapi.dll';
function IcmpCloseHandle(icmpHandle: THandle): boolean; stdcall;
  external 'iphlpapi.dll';
function IcmpSendEcho(icmpHandle: THandle; DestinationAddress: In_Addr;
  RequestData: Pointer; RequestSize: Smallint; RequestOptions: Pointer;
  ReplyBuffer: Pointer; ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;
  external 'iphlpapi.dll';
 
type
  TEchoReply = packed record
    Addr: In_Addr;
    Status: DWORD;
    RoundTripTime: DWORD;
  end;
 
  PEchoReply = ^TEchoReply;
 
var
  WSAData: TWSAData;
 
procedure Startup;
begin
  if WSAStartup($0101, WSAData) <> 0 then
    raise Exception.Create('WSAStartup');
end;
 
procedure Cleanup;
begin
  if WSACleanup <> 0 then
    raise Exception.Create('WSACleanup');
end;
 
function PingHost(const HostName: AnsiString;
  TimeoutMS: cardinal = 500): boolean;
const
  rSize = $400;
var
  e: PHostEnt;
  a: PInAddr;
  h: THandle;
  d: string;
  r: array [0 .. rSize - 1] of byte;
  i: cardinal;
begin
  Startup;
  e := gethostbyname(PAnsiChar(HostName));
  if e = nil then
    RaiseLastOSError;
  if e.h_addrtype = AF_INET then
    Pointer(a) := e.h_addr^
  else
    raise Exception.Create('Name doesn''t resolve to an IPv4 address');
 
  d := FormatDateTime('yyyymmddhhnnsszzz', Now);
 
  h := IcmpCreateFile;
  if h = INVALID_HANDLE_VALUE then
    RaiseLastOSError;
  try
    i := IcmpSendEcho(h, a^, PChar(d), Length(d), nil, @r[0], rSize, TimeoutMS);
    Result := (i <> 0) and (PEchoReply(@r[0]).Status = 0);
  finally
    IcmpCloseHandle(h);
  end;
  Cleanup;
end;
 
end.

procedure TForm1.button1Click(Sender: TObject);
begin
try
  if PingHost('8.8.8.8') then
    ShowMessage('Есть интернет')
  else
    ShowMessage('Нет интернета');
except
 ShowMessage('Нет интернета');
end;
end;

unit Unit2;
 
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
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form2: TForm2;
 
implementation
 
{$R *.dfm}
 
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';
  // Создаем дескриптор
  hIP := IcmpCreateFile();
  //Выделяет блок памяти
  GetMem(pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
  try
    // Отправляет запрос ICMP Echo и возвращает все ответы
    IcmpSendEcho(hIP, inet_addr(iphost), @pingBuffer,
      sizeof(pingBuffer), Nil, pIpe, sizeof(icmp_echo_reply) +
      sizeof(pingBuffer), 1000);
    // Возвращает последнюю ошибку, о которой сообщил вызов API операционной системы
    error := GetLastError();
    if (error <> 0) then
    begin
      Result := False;
    end;
  finally
    //Закрывает дескриптор, открытый вызовом IcmpCreateFile
    IcmpCloseHandle(hIP);
  // прекращает использование WS2_32.DLL
    WSACleanup();
// Освобождает блок памяти, ранее выделенный с помощью GetMem
    FreeMem(pIpe);
  end;
end;
 
 
procedure TForm2.Button1Click(Sender: TObject);
begin
  // проверка интернет-соединения
  // функция ping_iphost(IP_HOST): TRUE — интернет включен, FALSE — интернет выключен
  // отправил эхо-ответ ICMP
  if ping_iphost('8.8.8.8') then
    ShowMessage('Есть интернет.')
  else
    ShowMessage('Нет интернета.')
end;
end.