VB編寫的程序加入防火牆的例外中

 在工程中要先引入:

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