unit CheckInternetConnection1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Registry, WinSock, WinInet;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
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;
if (UseProxy<>0)
and (ReadString('
ProxyServer')<>'
' )
then Result := ctProxy;
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 := '
Im Internet!';
if Status = ctNone
then sMsg := '
Nicht im Internet!';
if Status = ctProxy
then sMsg := '
Proxyserver';
ShowMessage(
string(sMsg));
end;
end.