Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE | VB-Versionen: VB4, VB5, VB6 | 27.01.02 |
Alle installierten DFÜ-Verbindungen ermitteln Durch Auslesen der Windows-Registry lassen sich schnell alle installierten DFÜ-Verbindungen ermitteln. | ||
Autor: Dieter Otter | Bewertung: | Views: 21.587 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Ist eine DFÜ-Verbindung installiert oder nicht?
Und wenn ja, welche?
Genau das erfahren Sie, wenn Sie sich mal die Windows-Registry genauer anschauen. Alle DFÜ-Verbindungen werden hier gespeichert - und zwar im Zweig HKEY_CURRENT_USER\RemoteAccess\Profile. Was liegt also näher, als genau diesen Registry-Zweig unter Einsatz der entsprechenden WinAPI-Funktionen auszulesen, um so festzustellen, ob und welche DFÜ-Verbindungen auf dem Anwenderrechner installiert sind.
Und so wird's gemacht:
' benötigte API-Deklarationen Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _ Alias "RegOpenKeyExA" ( _ ByVal hKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ phkResult As Long) As Long Private Declare Function RegEnumKey Lib "advapi32.dll" _ Alias "RegEnumKeyA" ( _ ByVal hKey As Long, _ ByVal dwIndex As Long, _ ByVal lpName As String, _ ByVal cbName As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" ( _ ByVal hKey As Long) As Long ' Konstanten Private Const HKEY_CURRENT_USER = &H80000001 Private Const KEY_ENUMERATE_SUB_KEYS = &H8 Private Const ERROR_SUCCESS = 0&
' Alle installierten DFÜ-Verbindungen ermitteln ' und die Namen als String-Array zurückgeben Public Function RAS_GetConnections() As Variant Dim ErrCode As Long Dim keyIndex As Long Dim strBuffer As String Dim lStatus As Long Dim hKey As Long ReDim RASList(0) As String ' Registry-Zweig öffnen ErrCode = RegOpenKeyEx(HKEY_CURRENT_USER, _ "RemoteAccess\Profile", 0, _ KEY_ENUMERATE_SUB_KEYS, hKey) If ErrCode = ERROR_SUCCESS Then ' Alle SubKeys auslesen keyIndex = 0 Do strBuffer = Space(255) lStatus = RegEnumKey(hKey, keyIndex, strBuffer, _ Len(strBuffer)) If lStatus <> 0 Then Exit Do strBuffer = Left$(strBuffer, _ InStr(1, strBuffer, vbNullChar) - 1) ReDim Preserve RASList(keyIndex) RASList(keyIndex) = strBuffer keyIndex = keyIndex + 1 Loop End If ' Registry-Zugriff beenden Call RegCloseKey(hKey) If RASList(0) <> "" Then RAS_GetConnections = RASList Else RAS_GetConnections = "" End If End Function
Beispiel
Mit nachfolgenden Code werden alle installierten DFÜ-Verbindungen in einer ListBox ausgegeben:
' alle installierten DFÜ-Verbindungen in ' einer ListBox anzeigen Dim I As Integer Dim RASList As Variant RASList = RAS_GetConnections() If IsArray(RASList) Then For I = 0 To UBound(RASList) List1.AddItem RASList(I) Next I Else List1.AddItem "keine DFÜ-Verbidnungen" End If