Fórum Como detectar se o computador está conctado? #225712

unit Conexao;

interface

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

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


const cERROR_BUFFER_TOO_SMALL = 603; cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128; cRAS_MaxDeviceType = 16;

type TConnectionType = (ctNone, ctProxy, ctDialup);

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; var BufSize: DWord; var Connections: DWord): LongInt; stdcall;

var
  Form1: TForm1;

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;

implementation

{$R *.dfm}

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(´Software\Microsoft\WindowsCurrentVersion\Internet settings´,False) then begin if GetDataType(´ProxyEnable´) = rdBinary then ReadBinaryData(´ProxyEnable´, UseProxy, SizeOf(LongWord) ) else begin bUseProxy := ReadBool(´ProxyEnable´); if bUseProxy then UseProxy := 1 else UseProxy := 0; 
end;

end; 
except end;
finally Free; 
end; 
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; 
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);
var Status : TConnectionType;
sMsg : string;
begin
Status:=ConnectedToInternet;

if Status=ctDialup then sMsg:=´Online´;
if Status=ctNone then sMsg:=´Offline´;

showmessage(sMsg);
end;

procedure TForm1.TestaConexao;
Var Flags: DWORD;
begin
// Incluir biblioteca Wininet na seção Uses
if not InternetGetConnectedState(@Flags, 0) then
   ShowMessage(´Você não está conectado à Internet.´)
else
   begin
      if Flags and INTERNET_CONNECTION_LAN <> 0 then
         ShowMessage(´Você está conectado à Internet através de LAN´);
      if Flags and INTERNET_CONNECTION_MODEM <> 0 then
         ShowMessage(´Você está conectado à Internet através de MODEM´);
      if Flags and INTERNET_CONNECTION_PROXY <> 0 then
         ShowMessage(´Você está conectado à Internet através de proxy.´);
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   TestaConexao;
end;

end.