VB编写的程序加入防火墙的例外中

最新推荐文章于 2012-02-27 23:52:20 发布

原创最新推荐文章于 2012-02-27 23:52:20 发布 · 420 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#防火墙 #VB #VB.NET #Windows #配置管理

VB 专栏收录该内容

13 篇文章

订阅专栏

本文介绍如何使用VBA操控Windows防火墙的状态，包括开关防火墙、获取防火墙当前状态及将指定程序添加到防火墙例外列表的方法。

在工程中要先引入:

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