在工程中要先引入:
NetCon 1.0 Type Library
NetFwTypeLib
Option Explicit Const NET_FW_SCOPE_ALL = 0 Const NET_FW_SCOPE_LOCAL_SUBNET = 1 Const NET_FW_IP_VERSION_ANY = 2 '获取Windows防火墙的当前状态 Public Function FirewallStatus() As Boolean Dim fwMgr As INetFwMgr Dim oProfile As INetFwProfile On Error GoTo errHandler '声明Windows防火墙配置管理接口对象 Set fwMgr = CreateObject("HNetCfg.FwMgr") '获取本地防火墙当前的配置对象 Set oProfile = fwMgr.LocalPolicy.CurrentProfile '获取防火墙的状态,Ture表示启用,False表示禁用 FirewallStatus = oProfile.FirewallEnabled Set oProfile = Nothing Set fwMgr = Nothing Exit Function errHandler: FirewallStatus = False MsgBox ("Error: & Err.Description") Err.Clear End Function '切换Windows防火墙的状态 Public Sub SwitchFirewall() Dim fwMgr As INetFwMgr Dim oProfile As INetFwProfile On Error GoTo errHandler '声明Windows防火墙配置管理接口对象 Set fwMgr = CreateObject("HNetCfg.FwMgr") '获取本地防火墙当前的配置对象 Set oProfile = fwMgr.LocalPolicy.CurrentProfile '根据当前的防火墙状态相应地调整启用与禁用状态 oProfile.FirewallEnabled = Not (oProfile.FirewallEnabled) Set oProfile = Nothing Set fwMgr = Nothing Exit Sub errHandler: MsgBox (Err.Description) Err.Clear End Sub '将当前应用程序添加到Windows防火墙例外列表 Public Sub AddApplicationRule() Dim fwMgr As INetFwMgr Dim oProfile As INetFwProfile On Error GoTo errHandler '声明Windows防火墙配置管理接口对象 Set fwMgr = CreateObject("HNetCfg.FwMgr") '获取本地防火墙当前的配置对象 Set oProfile = fwMgr.LocalPolicy.CurrentProfile Dim oApplication As INetFwAuthorizedApplication '声明认证程序对象 Set oApplication = CreateObject("HNetCfg.FwAuthorizedApplication") '设置认证程序对象的相关属性 With oApplication '应用程序的完整路径 .ProcessImageFileName = App.Path & "\" & App.EXEName & ".exe" '应用程序的名称,也就是在Windows防火墙例外列表中显示的名称 .Name = "测试例子" '定义本规则作用的范围 .Scope = NET_FW_SCOPE_ALL '定义本规则用户的IP协议版本 .IpVersion = NET_FW_IP_VERSION_ANY '表示启用当前规则 .Enabled = True End With '将创建的认证程序对象添加到本地防火墙策略的认证程序集合 oProfile.AuthorizedApplications.Add oApplication Set oApplication = Nothing Set oProfile = Nothing Set fwMgr = Nothing MsgBox ("添加成功!") Exit Sub errHandler: MsgBox (Err.Description) Err.Clear End Sub Private Sub Command1_Click() SwitchFirewall Label1.Caption = FirewallStatus End Sub Private Sub Command3_Click() AddApplicationRule Label1.Caption = FirewallStatus End Sub