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

在工程中要先引入:

NetCon 1.0 Type Library

NetFwTypeLib

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