[Delphi]인터넷 연결 상태 확인

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.