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.
Hinweis
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
 
Weitere Links zum Thema
Internet-Verbindung prüfen und bestimmen
Modem-Test mit dem MS-Comm-Control

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: [ 2316 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 9. August 2011