whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1541)

Database (90)
Files (137)
Forms (107)
Graphic (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Math (76)
Misc (126)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (266)
VCL (242)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

37 Visitors Online


 
...check if I am connected to the internet?
Autor: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch
[ Print tip ]  

Tip Rating (32):  
     


interface

uses
  
Windows, SysUtils, Registry, WinSock, WinInet;

type
  
TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet: TConnectionType;
function RasConnectionCount: Integer;


implementation

//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('\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
        
//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;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners