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 Dieser Tipp wurde bereits 12.430 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
sevAniGif (VB/VBA) ![]() Anzeigen von animierten GIF-Dateien Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Tipp des Monats ![]() Dieter Otter Beliebige Zeichen am Anfang und Ende eines Strings entfernen Mit der Trim-Funktion lassen sich nicht nur Leerzeichen, sondern bei Bedarf auch beliebige Zeichen entfernen. TOP Entwickler-Paket ![]() TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |