DFÜ-Verbindung überwachen
[Windows 95/98/NT/2000]

28.04.1999


Folgende Routine überwacht das DFÜ-Netzwerk
    und erkennt eine Online-Verbindung:

ERFORDERLICHE OBJEKTE
   1 Label (Label1)
   1 Timer (Timer1)
   1 CommandButton (Command1)

 FORM-CODE
   Private Sub Form_Load()
      Timer1.Enabled = True
      Timer1.Interval = 1
      Command1.Caption = "&Verbindung trennen"
   End Sub
   Private Sub Timer1_Timer()
      If HaveOnlineConnection = True Then
         t = "Online"
         v = True
      Else
         t = "Offline"
         v = False
      End If
      Label1.Caption = t
      Command1.Enabled = v
   End Sub
   Private Sub Command1_Click()
      A = MsgBox("Wirklich trennen ?", vbQuestion + vbYesNo)
      If A = 7 Then Exit Sub
      Verbindung_trennen
   End Sub

 MODUL-CODE
   Private Type RASCONN
      dwSize As Long
      hRasConn As Long
      szEntryName(256) As Byte
      szDeviceType(16) As Byte
      szDeviceName(128) As Byte
   End Type
   Private Declare Function RasEnumConnections Lib "RasApi32.DLL" _
      Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, _
      lpcConnections As Long) As Long
   Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias _
      "RasHangUpA" (ByVal hRasConn As Long) As Long
   Public Function HaveOnlineConnection() As Boolean
      Dim lprasconn(0 To 1) As Long
      Dim rc As Long
      Dim lpcb As Long
      Dim lpcConnections As Long
      lprasconn(0) = 32
      lpcb = 0
      rc = RasEnumConnections(lprasconn(0), lpcb, lpcConnections)
      HaveOnlineConnection = lpcConnections > 0
   End Function
   Public Sub Verbindung_trennen()
      Dim lprasconn(255) As RASCONN
      lprasconn(0).dwSize = 412
      lpcb& = 256 * lprasconn(0).dwSize
      RasEnumConnections lprasconn(0), lpcb&, lpcConnections&
      If lpcConnections& > 0 Then
         RasHangUp lprasconn(0).hRasConn
      End If
   End Sub

Update: 17.01.2000:
DFÜ-Erkennung jetzt auch unter Windows NT

Update: 09.02.2000:
Trennen einer Verbindung