Rubrik: System/Windows · Sonstiges | VB-Versionen: VB6 | 11.02.05 |
Steuern der Windows XP SP2 Firewall mit VB6 Einstellungen der WinXP SP2 Firewall auslesen und ändern | ||
Autor: Stefan Mähr | Bewertung: | Views: 12.328 |
www.visualsoft-net.de | System: 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.