![]() |
Tipp 0130
|
DFÜ-Status prüfen
|
 |
|
Autor/Einsender: Datum: |
|
Alexander Csadek 28.09.2001 |
|
Entwicklungsumgebung: |
|
VB 5 |
|
|
Mit diesem Beispiel können Sie überprüfen, ob aktuell eine DFÜ-Verbindung besteht. Dazu kann man die
Remote-Access-Funktion von Windows nutzen. Die Funktion
DFÜStatus bedient sich der RASAPI-Funktion RasGetConnectStatus aus der Laufzeit-Bibliothek RASAPI32.DLL und liefert als Ergebnis den Verbindungsstatus zurück.
|
Bei diesem Tipp wird die Fenstergröße mit Hilfe von API-Funktionen und Subclassing eingeschränkt.
|
|
|
Der Tipp funktioniert nur, wenn auch eine DFÜ-Verbindung oder eine äquivalente Verbindung im System eingerichtet ist, da erst zu diesem Zeitpunkt die Datei
RASAPI32.DLL installiert wird.
|
|
|
Option Explicit
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" _
Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As _
Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.DLL" _
Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, _
lpStatus As Any) As Long
Const RAS_MaxEntryName = 256
Const RAS_MaxDeviceType = 16
Const RAS_MaxDeviceName = 32
Private Type RASType
dwSize As Long
hRasCon As Long
szEntryName(RAS_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Sub Form_Load()
Timer1.Interval = 20
End Sub
Private Function DFÜStatus() As Boolean
Dim RAS(255) As RASType, RASStatus As RASStatusType
Dim lg, lpconnection, Result
RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpconnection)
If lpconnection = 0 Then
DFÜStatus = False
lbl_Info.Caption = "Offline"
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000& Then
DFÜStatus = True
lbl_Info.Caption = "Online"
Else
DFÜStatus = False
lbl_Info.Caption = "Einwahl oder Trennen der Verbindung"
End If
End If
End Function
Private Sub Timer1_Timer()
DFÜStatus
End Sub
|
|
|
|
|
Windows-Version |
95 |
 |
|
98/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (2,3 kB)
|
Downloads bisher: [ 2399 ]
|
|
|