Função para verificar conexão com a internet. Existe?

Delphi

27/08/2003

Fala galera!

Existe alguma função ou rotina que verifique se o computador está conectado à internet?


Grato.
wbb


Wbb

Wbb

Curtidas 0

Respostas

Mmtoor

Mmtoor

27/08/2003

Caro amigo.. A rotina é um pouco extensa mas funciona perfeitamente:

interface
uses
Windows, SysUtils, Registry, WinSock, WinInet;

type
TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;


implementation

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 para receber dados da conexao}
var BufSize: DWord; { tamanho em bytes do buffer }
var Connections: DWord { numero de conexoes escritas no buffer }
): LongInt; stdcall;


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\Windows\CurrentVersion\Internet 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
//Nao conectado com proxy
end;

Espero ter ajudado.
MMTOOR2003


GOSTEI 0
Wbb

Wbb

27/08/2003

Eu agradeço a ajuda, mas não entendi como você fez para que o código que você passou, exatamente como você passou, funcionasse.

Eu abri uma nova aplicação, coloquei um TButton e em seguida colei o código que você enviou (claro que separando as partes em suas devidas seções). Apareceram muitos erros.

Pesquisei na internet o que você passou, e cheguei ao código que segue abaixo, sendo feito da mesma forma que tentei, ou seja, abrindo uma nova aplicação, colando o código e inserindo um botão. Um dos lugares em que encontrei erro no seu código, foi inserido quando você traduziu os comentários do código original.

Seja como for, obrigado pela atenção.

Segue o código completo:

wbb

unit Unit1;

interface

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

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


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

type
  TConnectionType = (ctNone, ctProxy, ctDialup);

  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;

end.



GOSTEI 0
POSTAR