vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · Netzwerk   |   VB-Versionen: VB628.09.04
LAN-Verbindung deaktivieren (WMI)

Deaktiviert alle LAN-Verbindungen, deren Netzwerkkarten nicht verbunden sind

Autor:   Michael GosseBewertung:     [ Jetzt bewerten ]Views:  26.046 
www.ech-o-lot.deSystem:  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

Dieser Tipp wurde bereits 26.046 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (1 Beitrag)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel