Проверить соединение с Интернетом и узнать тип соединения

По нажатию на кнопку в появляется сообщение. Если не 0 - есть соединения с Интернетом. А в заголовке формы показывается тип соединения.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Registry, WinSock, WinInet, StdCtrls;

type
  TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//For RasConnectionCount =======================
const
  cERROR_BUFFER_TOO_SMALL = 603;
  cRAS_MaxEntryName = 256;
  cRAS_MaxDeviceName = 128;
  cRAS_MaxDeviceType = 16;

type
  ERasError = class(Exception);
    HRASConn = DWord;
    PRASConn = ^TRASConn;
    TRASConn = record
    dwSize: DWORD;
    rasConn: HRASConn;
    szEntryName: array[0..cRAS_MaxEntryName] of Char;
    szDeviceType : array[0..cRAS_MaxDeviceType] of Char;
    szDeviceName : array [0..cRAS_MaxDeviceName] of char;
  end;

  TRasEnumConnections =
    function (RASConn: PrasConn; { buffer to receive Connections data }
    var BufSize: DWord; { size in bytes of buffer }
    var Connections: DWord { number of Connections written to buffer }
    ): LongInt; stdcall;
//End RasConnectionCount =======================

function ConnectedToInternet: TConnectionType;
var
  Reg : TRegistry;
  bUseProxy : Boolean;
  UseProxy : LongWord;
begin
  Result := ctNone;
  Reg := TRegistry.Create;
  with REG do
    try
      try
        RootKey := HKEY_CURRENT_USER;
        if OpenKey('SoftwareMicrosoftWindowsCurrentVersionInternet settings',False) then
        begin
          //I just try to read it, and trap an exception
          if GetDataType('ProxyEnable') = rdBinary then
            ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
          else
          begin
            bUseProxy := ReadBool('ProxyEnable');
            if bUseProxy then
              UseProxy := 1
            else
              UseProxy := 0;
          end;
          if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then
            Result := ctProxy;
        end;
      except
      //Obviously not connected through a proxy
      end;
    finally
      Free;
    end;

  //We can check RasConnectionCount even if dialup networking is not installed
  //simply because it will return 0 if the DLL is not found.
  if Result = ctNone then
  begin
    if RasConnectionCount > 0 then
      Result := ctDialup;
  end;
end;

function RasConnectionCount : Integer;
var
  RasDLL : HInst;
  Conns : array[1..4] of TRasConn;
  RasEnums : TRasEnumConnections;
  BufSize : DWord;
  NumConns : DWord;
  RasResult : Longint;
begin
  Result := 0;

  //Load the RAS DLL
  RasDLL := LoadLibrary('rasapi32.dll');
  if RasDLL = 0 then
    exit;

  try
    RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
  if @RasEnums = nil then
    raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');

  Conns[1].dwSize := Sizeof (Conns[1]);
  BufSize := SizeOf(Conns);

  RasResult := RasEnums(@Conns, BufSize, NumConns);

  if (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then
    Result := NumConns;
  finally
    FreeLibrary(RasDLL);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(RasConnectionCount));
  if ConnectedToInternet=ctNone then
    Form1.Caption:='ctNone';
  if ConnectedToInternet=ctProxy then
    Form1.Caption:='ctProxy';
  if ConnectedToInternet=ctDialup then
    Form1.Caption:='ctDialup';
end;

end.

Другое по теме:

• Get ALL Ip
• FTP - докачка файлов
• Присоединиться к FTP серверу и загрузить с него файл