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

 在工程中要先引入:

NetCon 1.0 Type Library

NetFwTypeLib

 

Vb代码 

1. Option Explicit  
2. Const NET_FW_SCOPE_ALL = 0  
3. Const NET_FW_SCOPE_LOCAL_SUBNET = 1  
4. Const NET_FW_IP_VERSION_ANY = 2  
5.   
6. '获取Windows防火墙的当前状态  
7. Public Function FirewallStatus() As Boolean  
8.     Dim fwMgr As INetFwMgr  
9.     Dim oProfile As INetFwProfile  
10.     On Error GoTo errHandler  
11.     '声明Windows防火墙配置管理接口对象  
12.     Set fwMgr = CreateObject("HNetCfg.FwMgr")  
13.     '获取本地防火墙当前的配置对象  
14.     Set oProfile = fwMgr.LocalPolicy.CurrentProfile  
15.     '获取防火墙的状态，Ture表示启用，False表示禁用  
16.     FirewallStatus = oProfile.FirewallEnabled  
17.     Set oProfile = Nothing  
18.     Set fwMgr = Nothing  
19.     Exit Function  
20. errHandler:  
21.     FirewallStatus = False  
22.     MsgBox ("Error: & Err.Description")  
23.     Err.Clear  
24. End Function  
25.   
26. '切换Windows防火墙的状态  
27. Public Sub SwitchFirewall()  
28.     Dim fwMgr As INetFwMgr  
29.     Dim oProfile As INetFwProfile  
30.     On Error GoTo errHandler  
31.     '声明Windows防火墙配置管理接口对象  
32.     Set fwMgr = CreateObject("HNetCfg.FwMgr")  
33.     '获取本地防火墙当前的配置对象  
34.     Set oProfile = fwMgr.LocalPolicy.CurrentProfile  
35.     '根据当前的防火墙状态相应地调整启用与禁用状态  
36.     oProfile.FirewallEnabled = Not (oProfile.FirewallEnabled)  
37.     Set oProfile = Nothing  
38.     Set fwMgr = Nothing  
39.     Exit Sub  
40. errHandler:  
41.     MsgBox (Err.Description)  
42.     Err.Clear  
43. End Sub  
44.   
45. '将当前应用程序添加到Windows防火墙例外列表  
46. Public Sub AddApplicationRule()  
47.     Dim fwMgr As INetFwMgr  
48.     Dim oProfile As INetFwProfile  
49.     On Error GoTo errHandler  
50.     '声明Windows防火墙配置管理接口对象  
51.     Set fwMgr = CreateObject("HNetCfg.FwMgr")  
52.     '获取本地防火墙当前的配置对象  
53.     Set oProfile = fwMgr.LocalPolicy.CurrentProfile  
54.     Dim oApplication As INetFwAuthorizedApplication  
55.     '声明认证程序对象  
56.     Set oApplication = CreateObject("HNetCfg.FwAuthorizedApplication")  
57.     '设置认证程序对象的相关属性  
58.     With oApplication  
59.         '应用程序的完整路径  
60.         .ProcessImageFileName = App.Path & "\" & App.EXEName & ".exe"  
61.         '应用程序的名称，也就是在Windows防火墙例外列表中显示的名称  
62.         .Name = "测试例子"  
63.         '定义本规则作用的范围  
64.         .Scope = NET_FW_SCOPE_ALL  
65.         '定义本规则用户的IP协议版本  
66.         .IpVersion = NET_FW_IP_VERSION_ANY  
67.         '表示启用当前规则  
68.         .Enabled = True  
69.     End With  
70.     '将创建的认证程序对象添加到本地防火墙策略的认证程序集合  
71.     oProfile.AuthorizedApplications.Add oApplication  
72.     Set oApplication = Nothing  
73.     Set oProfile = Nothing  
74.     Set fwMgr = Nothing  
75.     MsgBox ("添加成功！")  
76.     Exit Sub  
77. errHandler:  
78.     MsgBox (Err.Description)  
79.     Err.Clear  
80. End Sub  
81.   
82. Private Sub Command1_Click()  
83.     SwitchFirewall  
84.     Label1.Caption = FirewallStatus  
85. End Sub  
86.   
87. Private Sub Command3_Click()  
88. AddApplicationRule  
89. Label1.Caption = FirewallStatus  
90. End Sub  

 

转载于:https://www.cnblogs.com/interdrp/p/10778335.html