在工程中要先引入:
NetCon 1.0 Type Library
NetFwTypeLib
Vb代碼
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
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
全站熱搜
留言列表
