Rubrik: HTML/Internet/Netzwerk · Netzwerk | VB-Versionen: VB6 | 28.09.04 |
LAN-Verbindung deaktivieren (WMI) Deaktiviert alle LAN-Verbindungen, deren Netzwerkkarten nicht verbunden sind | ||
Autor: Michael Gosse | Bewertung: | Views: 26.092 |
www.ech-o-lot.de | System: WinXP, Win8, Win10, Win11 | Beispielprojekt auf CD |
Unser heutiger Tipp zeigt, wie sich mit Hilfe von WMI alle LAN-Verbindungen deaktivieren lassen, deren Netzwerkkarten nicht verbunden sind.
Option Explicit ' benötigte API-Deklaration Private Declare Function WaitForSingleObject Lib "kernel32" ( _ ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long
' LAN-Verbindungen deaktivieren Public Sub DeactivateLAN() Const ssfCONTROLS = 3 Const HKEY_LOCAL_MACHINE = &H80000002 Dim objWMIService As Variant Dim colAdapters As Variant Dim objAdapter As Variant Dim colAdapters2 As Variant Dim oReg As Variant Dim shellApp As Variant Dim oControlPanel As Variant Dim oNetConnections As Variant Dim oLanConnection As Variant Dim folderitem As Variant Dim oDisableVerb As Variant Dim Verb As Variant Dim strMACaddress(9) Dim strSettingID(9) Dim strComputer As String Dim sDisableVerb As String Dim sConnectionName As String Dim i As Long Dim strKeyPath As String Dim strValueName As String Dim bEnabled As Boolean strComputer = "." sDisableVerb = "&Deaktivieren" ' Hier werden alle Adapter ermittelt, die nicht verbunden sind Set objWMIService = GetObject _ ("winmgmts:" & "!\\" & strComputer & "\root\cimv2") Set colAdapters = objWMIService.ExecQuery _ ("Select * from Win32_NetworkAdapter Where NetConnectionStatus = 7") ' MAC-Adresse ermitteln i = 0 For Each objAdapter In colAdapters If Not IsNull(objAdapter.MACAddress) Then strMACaddress(i) = objAdapter.MACAddress i = i + 1 End If Next If i = 0 Then ' kein verbindungsloser Netzwerk-Adapter gefunden MsgBox "keine verbindungslose Netzwerk-Adapter gefunden!" Exit Sub End If ' Hier wird die SettingID(i) der Netzwerkkarte herausgefunden, ' die nicht verbunden ist Set objWMIService = GetObject _ ("winmgmts:" & "!\\" & strComputer & "\root\cimv2") Set colAdapters2 = objWMIService.ExecQuery _ ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = TRUE") For Each objAdapter In colAdapters2 For i = 0 To UBound(strMACaddress) If objAdapter.MACAddress = strMACaddress(i) Then strSettingID(i) = objAdapter.SettingID End If ' Hier wird der Registry-Key zusammengebaut, ' der ausgelesen werden soll strKeyPath = "SYSTEM\CurrentControlSet\Control\Network\" & _ "{4D36E972-E325-11CE-BFC1-08002BE10318}\" & _ strSettingID(i) & _ "\Connection" ' Setzen von Variablen Set oReg = GetObject("winmgmts:" & "!\\" & strComputer & _ "\root\default:StdRegProv") strValueName = "Name" ' Hier wird der Name (ExpandedString) der LAN-Verbindung ' aus der Registry gelesen oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _ strValueName, sConnectionName ' Setzen von Variablen Set shellApp = CreateObject("shell.application") Set oControlPanel = shellApp.Namespace(ssfCONTROLS) Set oNetConnections = Nothing Set oLanConnection = Nothing ' Hier sucht das Programm einen Ordner der Netzwerkverbindung heißt For Each folderitem In oControlPanel.items If folderitem.Name = "Netzwerkverbindungen" Then Set oNetConnections = folderitem.getfolder: Exit For End If Next ' Wenn es keinen gefunden hat dann Fehlermeldung If oNetConnections Is Nothing Then MsgBox "Finde den Ordner Netzwerkverbindungen nicht !!" Exit Sub End If ' Hier vergleicht das Programm LAN-Verbindungen aus der ' Registry mit denen im Ordner Netzwerkverbindungen For Each folderitem In oNetConnections.items If LCase(folderitem.Name) = LCase(sConnectionName) Then Set oLanConnection = folderitem: Exit For End If Next ' Wenn es keine identischen LAN-Verbindungen gefunden hat ' dann Fehlermeldung If oLanConnection Is Nothing Then MsgBox "Finde folgende Lan-Verbindung nicht: " & sConnectionName & "item" Exit Sub End If ' Hier wird die LAN-Verbindung im Netzwerkordner auf ' deaktiviert gesetzt bEnabled = True Set oDisableVerb = Nothing For Each Verb In oLanConnection.verbs If Verb.Name = sDisableVerb Then Set oDisableVerb = Verb End If Next If bEnabled Then oDisableVerb.DoIt ' kurze Pause (5 Sekunden) Sleep 5000 Next Next End Sub
' Ewartet wird die Zeitangabe in Millisekunden! ' z.B. 1000 für 1 Sekunde Public Function Sleep(ByVal mSek As Long) WaitForSingleObject -1, mSek End Function