Tipp 5.15 - DFÜ-Verbindung offen

Wie kann ich prüfen, ob eine DFÜ-Verbindung besteht?

Mit dieser Funktion können Sie prüfen, ob eine DFÜ-Verbindung besteht. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: RasEnumConnections, RasGetConnectStatus - RAS_TYPE, RAS_STATUS_TYPE

Beispiel:

Option Explicit
 
Public Const RAS_MAXENTRYNAME             As Long = 256
Public Const RAS_MAXDEVICETYPE            As Long = 16
Public Const RAS_MAXDEVICENAME            As Long = 32
 
Public Type RAS_TYPE
  dwSize                                  As Long
  hRasCon                                 As Long
  szEntryName(RAS_MAXENTRYNAME)           As Byte
  szDeviceType(RAS_MAXDEVICETYPE)         As Byte
  szDeviceName(RAS_MAXDEVICENAME)         As Byte
End Type
 
Public Type RAS_STATUS_TYPE
  dwSize                                  As Long
  RasConnState                            As Long
  dwError                                 As Long
  szDeviceType(RAS_MAXDEVICETYPE)         As Byte
  szDeviceName(RAS_MAXDEVICENAME)         As Byte
End Type
 
Public Declare Function RasEnumConnections _
    Lib "RasApi32.dll" Alias _
    "RasEnumConnectionsA" _
    (lpRasCon As Any, _
    lpcb As Long, _
    lpcConnections As Long) As Long
 
Public Declare Function RasGetConnectStatus _
    Lib "RasApi32.dll" Alias _
    "RasGetConnectStatusA" _
    (ByVal hRasCon As Long, _
    lpStatus As Any) As Long
 
Public Function DFUEConnectionOnline() As Boolean
  '// -----------------------------------------------------
  '// Methode:   | Prüft, ob eine DFUE-Verbindung besteht
  '// -----------------------------------------------------
  '// Parameter: | -
  '// -----------------------------------------------------
  '// Rückgabe:  | True, wenn eine DFUE-Verbindung besteht
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  Dim auRAS_Types(255)  As RAS_TYPE
  Dim uRASStatus        As RAS_STATUS_TYPE
  Dim lSize             As Long
  Dim lConnections      As Long
  Dim lResult           As Long
 
  DFUEConnectionOnline = False
  auRAS_Types(0).dwSize = 412
  lSize = 256 * auRAS_Types(0).dwSize
  lResult = RasEnumConnections(auRAS_Types(0), lSize, _
      lConnections)
  If lConnections <> 0 Then
    uRASStatus.dwSize = 160
    lResult = RasGetConnectStatus(auRAS_Types(0).hRasCon, _
        uRASStatus)
    DFUEConnectionOnline = (uRASStatus.RasConnState = _
        &H2000)
  End If
 
End Function