1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Registry, WinSock, WinInet;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button2Click(Sender: TObject);
procedure Button3Click(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.Button2Click(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;
procedure TForm1.Button3Click(Sender: TObject);
begin
InternetAutodialHangup(0);
end;
end. |
!