Option Explicit
 
'zunächst die benötigten API-Deklarationen für den Verbindungsaufbau
 
Private Declare Function InternetDial Lib "wininet.dll" _
        (ByVal hwndParent As Long, ByVal lpszConiID _
        As String, ByVal dwFlags As Long, ByRef hCon _
        As Long, ByVal dwReserved As Long) As Long
 
Private Const DIAL_FORCE_ONLINE = 1
Private Const DIAL_FORCE_UNATTENDED = 2
Global gOnline As Boolean
Global gOffline As Boolean
Global gIstOnline As Boolean
'------------------------------------------------------------------------------
' --------------------------
'zunächst die benötigten API-Deklarationen für die Verbindungstrennung
 
Private Declare Function InternetGetConnectedState Lib _
  "wininet.dll" (ByRef lpdwFlags As Long, _
  ByVal dwReserved As Long) As Long
Private Declare Function InternetHangUp Lib "wininet.dll" _
  (ByVal dwConnection As Long, ByVal dwReserved As Long) _
  As Long
 
'Private Const DIAL_FORCE_ONLINE = 1
'Private Const DIAL_FORCE_UNATTENDED = 2
 
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 RasEnumConnectionsA Lib _
  "RasApi32.DLL" (lpRasConn As Any, lbcp As Long, _
  lbcConnections As Long) As Long
'Online-Verbindung starten
Public Function RASConnect(ByVal hwnd As Long, _
  Optional ByVal DFÜName As String = "", _
  Optional ByVal AutoStart As Boolean = False) As Boolean
 
  Dim conID As Long
 
  InternetDial hwnd, DFÜName, IIf(AutoStart, _
    DIAL_FORCE_UNATTENDED, DIAL_FORCE_ONLINE), _
    conID, 0
 
  RASConnect = (conID <> 0)
  gOnline = RASConnect
End Function
'Prüfen auf aktive Internet-Verbindungen
Public Function RASIsConnected(ByVal hwnd As Long, _
  Optional ByVal DFÜName As String = "") As Long
 
  Dim nConnected As Long
  Dim dwFlags As Long
  Dim lpRasConn(255) As RASCONN
  Dim lpcConnections As Long
  Dim lpcb As Long
  Dim i As Long
  Dim hRasConn As Long
  Dim szEntryName As String
 
  'Anzahl aktiver Verbindungen
  nConnected = InternetGetConnectedState(dwFlags, 0)
  If (nConnected) Then
    'Handle der Verbindung ermitteln
    lpRasConn(0).dwSize = 412
    lpcb = 256 * lpRasConn(0).dwSize
    RasEnumConnectionsA lpRasConn(0), lpcb, lpcConnections
 
    If DFÜName <> "" Then
      'Prüfen, ob "DFÜName" in der Auflistung vorhanden
      For i = 0 To lpcConnections - 1
        szEntryName = StrConv(lpRasConn(i).szEntryName, _
          vbUnicode)
        szEntryName = Left$(szEntryName, _
          InStr(szEntryName, vbNullChar) - 1)
        If szEntryName = DFÜName Then
          hRasConn = lpRasConn(i).hRasConn
          Exit For
        End If
      Next i
    Else
      'Handle der ersten Verbindung
      hRasConn = lpRasConn(0).hRasConn
    End If
  End If
 
  RASIsConnected = hRasConn
 
  If RASIsConnected <> 0 Then
    gIstOnline = True
  Else
    gIstOnline = False
  End If
End Function
'(bestimmte/alle) Internet-Verbindung(en) trennen
Public Function RASDisconnect(ByVal hwnd As Long, _
  Optional ByVal DFÜName As String = "", _
  Optional ByVal DisconnectAll As Boolean) As Boolean
 
  Dim nConnected As Long
  Dim dwFlags As Long
  Dim lpRasConn(255) As RASCONN
  Dim lpcConnections As Long
  Dim lpcb As Long
  Dim hRasConn As Long
  Dim i As Long
  Dim Result As Boolean
 
  Result = False
  If Not DisconnectAll Then
    '(bestimmte) Verbindung trennen
    hRasConn = RASIsConnected(hwnd, DFÜName)
    If hRasConn <> 0 Then
      Result = (InternetHangUp(hRasConn, 0) = 0)
    End If
 
  Else
    'Alle Verbindungen trennen
    nConnected = InternetGetConnectedState(dwFlags, 0)
    If (nConnected) Then
      lpRasConn(0).dwSize = 412
      lpcb = 256 * lpRasConn(0).dwSize
      RasEnumConnectionsA lpRasConn(0), lpcb, lpcConnections
 
      Result = True
      For i = 0 To lpcConnections - 1
        hRasConn = lpRasConn(i).hRasConn
        If InternetHangUp(hRasConn, 0) <> 0 Then _
          Result = False
      Next i
    End If
  End If
 
  RASDisconnect = Result
  gOffline = RASDisconnect
End Function