vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: System/Windows · Sonstiges   |   VB-Versionen: VB611.02.05
Steuern der Windows XP SP2 Firewall mit VB6

Einstellungen der WinXP SP2 Firewall auslesen und ändern

Autor:   Stefan MährBewertung:  Views:  12.328 
www.visualsoft-net.deSystem:  WinXP, Win8, Win10, Win11 Beispielprojekt auf CD 

Mit dem Windows XP SP1 hat Microsoft eine Firewall für Windows Systeme eingeführt. Mit dem SP2 für WinXP lieferte man erweiterte Einstellungen für diese Firewall nach. Die Einstellungen dieser Firewall lassen sich über die hnetcfg.dll von einem VB6 Programm aus auslesen und ändern. Die Basisfunktionen für die Windows XP Firewall habe ich im folgenden Code in einem Klassenmodul für die einfache Verwendung in VB6 Projekten gekapselt.

Kopieren Sie folgenden Code in ein neues Klassenmodul:

Option Explicit
 
Const ICSSC_DEFAULT = 0
Const CONNECTION_PUBLIC = 0
Const CONNECTION_PRIVATE = 1
Const CONNECTION_ALL = 2
 
Const NET_FW_IP_PROTOCOL_UDP = 17
Const NET_FW_IP_PROTOCOL_TCP = 6
 
Const NET_FW_SCOPE_ALL = 0
Const NET_FW_SCOPE_LOCAL_SUBNET = 1
 
Private oNetShareMgr As Object
' --> Den Firewall Status auslesen
Public Function FirewallStatus() As Boolean
  Dim bolStatus As Boolean
  Dim oProfile As Object
 
  On Error GoTo errHandler
 
  Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
 
  If oProfile.FirewallEnabled = False Then
    bolStatus = False
  Else
    bolStatus = True
  End If
 
  FirewallStatus = bolStatus
  Exit Function
 
errHandler:
  FirewallStatus = False
  MsgBox "Error: " & Err.Description
  Err.Clear
End Function
' --> Firwall einschalten
Public Sub EnableFirewall()
  Dim oProfile As Object
 
  On Error GoTo ErrorHandler
 
  Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
 
  If oProfile.FirewallEnabled = False Then
    oProfile.FirewallEnabled = True
  End If
 
  Set oProfile = Nothing
  Set oNetShareMgr = Nothing
  Exit Sub
 
ErrorHandler:
  MsgBox Err.Description
  Err.Clear
End Sub
' --> Firwall ausschalten
Public Sub DisableFirewall()
  Dim oProfile As Object
 
  On Error GoTo ErrorHandler
 
  Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
 
  If oProfile.FirewallEnabled = True Then
    oProfile.FirewallEnabled = False
  End If
 
  Set oProfile = Nothing
  Set oNetShareMgr = Nothing
 
  Exit Sub
 
ErrorHandler:
  MsgBox Err.Description
  Err.Clear
End Sub
' --> Einen neuen Port zur Firewall Konfiguration hinzufügen
Public Sub AddPortToFirewall(ByVal strPortName As String, _
  ByVal strPortProtocol As String, _
  ByVal intPortNumber As Integer)
 
  Dim oProfile As Object
  Dim port As Object
 
  On Error GoTo errHandler
 
  Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  Set port = CreateObject("HNetCfg.FWOpenPort")
 
  port.Name = strPortName
  If LCase(strPortProtocol) = "UDP" Then
    port.Protocol = NET_FW_IP_PROTOCOL_UDP
  Else
    port.Protocol = NET_FW_IP_PROTOCOL_TCP
  End If
 
  port.port = intPortNumber
  port.Scope = NET_FW_SCOPE_ALL
  port.Enabled = True
 
  oProfile.GloballyOpenPorts.Add port
 
  Set oProfile = Nothing
  Set port = Nothing
  Set oNetShareMgr = Nothing
  Exit Sub
 
errHandler:
  MsgBox Err.Description
  Err.Clear
End Sub
' --> eingehende ICMP Echo Meldungen zulassen oder blocken
Public Sub AllowIncomingICMP(ByVal bolAllow As Boolean)
  Dim oProfile As Object
 
  On Error GoTo errHandler
 
  Set oNetShareMgr = CreateObject("HNetCfg.FwMgr")
  Set oProfile = oNetShareMgr.LocalPolicy.CurrentProfile
  oProfile.IcmpSettings.AllowInboundEchoRequest = bolAllow
 
  Set oProfile = Nothing
  Set oNetShareMgr = Nothing
  Exit Sub
 
errHandler:
  MsgBox Err.Description
  Err.Clear
End Sub

Ich habe auf meiner Webseite  www.visualsoft-net.de erweiterte Anwendungsbeipiele in VB6 und VB.NET zur Verfügung gestellt, die die Anwendung dieser Klasse und weitere Firewall-Funktionen anschaulich erklären.
 



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.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle 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.