来自网上
---------------此程序开发环境为Delphi XE
---------Unit开始
1 unit Unit1; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, StdCtrls,ComObj ; 8 9 type 10 TFrmFirewallprogram = class(TForm) 11 Button1: TButton; 12 Button2: TButton; 13 Edit1: TEdit; 14 Label1: TLabel; 15 Label2: TLabel; 16 Edit2: TEdit; 17 Label3: TLabel; 18 Label4: TLabel; 19 Edit3: TEdit; 20 procedure Button1Click(Sender: TObject); 21 procedure Button2Click(Sender: TObject); 22 private 23 { Private declarations } 24 public 25 { Public declarations } 26 end; 27 28 var 29 FrmFirewallprogram: TFrmFirewallprogram; 30 31 implementation 32 33 {$R *.dfm} 34 procedure AddExceptToFirewall(const Caption, AppPath: String); 35 // Uses ComObj 36 const 37 NET_FW_PROFILE2_PRIVATE = 2; 38 NET_FW_PROFILE2_PUBLIC = 4; 39 NET_FW_IP_PROTOCOL_TCP = 6; 40 NET_FW_ACTION_ALLOW = 1; 41 var 42 Profile: Integer; 43 Policy2: OleVariant; 44 RObject: OleVariant; 45 NewRule: OleVariant; 46 ROItem: OleVariant; 47 Enumerator : OleVariant; 48 begin 49 50 Profile := NET_FW_ACTION_ALLOW or NET_FW_PROFILE2_PRIVATE OR NET_FW_PROFILE2_PUBLIC; 51 Policy2 := CreateOleObject('HNetCfg.FwPolicy2'); 52 RObject := Policy2.Rules; 53 try 54 //ROItem:=RObject.item('360se.ex'); //FrmFirewallprogram.Edit1.Text 55 Enumerator := RObject.GetEnumerator; 56 except 57 on e:Exception do 58 begin 59 ShowMessage(e.Message); 60 61 end; 62 63 end; 64 if VarIsEmpty(rOItem) then 65 ShowMessage('名称不存在可以建立') 66 else 67 ShowMessage('名不存在，不允许覆盖'); 68 69 exit; 70 NewRule := CreateOleObject('HNetCfg.FWRule'); 71 NewRule.Name := Caption; 72 NewRule.Description := Caption; 73 NewRule.ApplicationName := AppPath; 74 NewRule.Protocol := NET_FW_IP_PROTOCOL_TCP; 75 NewRule.Enabled := True; 76 NewRule.Grouping := ''; 77 NewRule.Profiles := Profile; 78 NewRule.Action := NET_FW_ACTION_ALLOW; 79 RObject.Add(NewRule); 80 Policy2:=Unassigned ; 81 RObject:=Unassigned ; 82 NewRule:= Unassigned ; 83 end; 84 procedure TFrmFirewallprogram.Button1Click(Sender: TObject); 85 begin 86 AddExceptToFirewall(Edit1.Text ,Edit2.Text ) ; 87 end; 88 procedure RemoveExceptFromFirewall(const RuleName: String); 89 const 90 NET_FW_PROFILE2_PRIVATE = 2; 91 NET_FW_PROFILE2_PUBLIC = 4; 92 var 93 Profile: Integer; 94 Policy2: OleVariant; 95 RObject: OleVariant; 96 ROItem: OleVariant; 97 begin 98 Profile := NET_FW_PROFILE2_PRIVATE OR NET_FW_PROFILE2_PUBLIC; 99 Policy2 := CreateOleObject('HNetCfg.FwPolicy2'); 100 RObject := Policy2.Rules; 101 102 103 try 104 ROItem:=RObject.item(FrmFirewallprogram.Edit3.Text); 105 RObject.Remove(RuleName); 106 ShowMessage('移除成功！'); 107 except 108 if (rOItem=Unassigned ) then 109 ShowMessage('移除失败！'); 110 end; 111 112 {if (VarIsNull(rOItem)) then 113 begin 114 //if (rOItem=Unassigned ) then 115 // ShowMessage('000'); 116 end; 117 ShowMessage('00'); 118 } 119 end; 120 procedure TFrmFirewallprogram.Button2Click(Sender: TObject); 121 begin 122 RemoveExceptFromFirewall(Edit3.Text ); 123 end; 124 end. 125 126 {使用Delphi删除Windows防火墙规则(例外) - 程序园 http://www.voidcn.com/article/p-xlqbcail-bwq.html} 127 {如何使用Delphi在Win7防火墙中打开端口 - IT屋-程序员软件开发技术分享社区 https://www.it1352.com/1759250.html} 128 {INetFwRules.Item 方法 (Microsoft.TeamFoundation.Build.Common) | Microsoft Docs 129 https://docs.microsoft.com/zh-cn/previous-versions/jj153759(v=vs.140)}
---------Unit结束--
---Form开始
1 object FrmFirewallprogram: TFrmFirewallprogram 2 Left = 0 3 Top = 0 4 Caption = #38450#28779#22681#20801#35768#30340#31243#24207#27979#35797#29256 5 ClientHeight = 260 6 ClientWidth = 413 7 Color = clBtnFace 8 Font.Charset = DEFAULT_CHARSET 9 Font.Color = clWindowText 10 Font.Height = -11 11 Font.Name = 'Tahoma' 12 Font.Style = [] 13 OldCreateOrder = False 14 PixelsPerInch = 96 15 TextHeight = 13 16 object Label1: TLabel 17 Left = 16 18 Top = 88 19 Width = 42 20 Height = 13 21 Alignment = taRightJustify 22 AutoSize = False 23 Caption = #21517#31216 24 end 25 object Label2: TLabel 26 Left = 0 27 Top = 0 28 Width = 413 29 Height = 25 30 Align = alTop 31 Alignment = taCenter 32 AutoSize = False 33 Caption = #25511#21046#38754#26495'\'#25152#26377#25511#21046#38754#26495#39033'\Windows '#38450#28779#22681'\'#20801#35768#30340#31243#24207 34 Font.Charset = DEFAULT_CHARSET 35 Font.Color = clWindowText 36 Font.Height = -13 37 Font.Name = 'Tahoma' 38 Font.Style = [] 39 ParentFont = False 40 end 41 object Label3: TLabel 42 Left = 10 43 Top = 112 44 Width = 48 45 Height = 13 46 Alignment = taRightJustify 47 Caption = #31243#24207#36335#24452 48 end 49 object Label4: TLabel 50 Left = 8 51 Top = 203 52 Width = 50 53 Height = 13 54 Alignment = taRightJustify 55 AutoSize = False 56 Caption = #21517#31216 57 end 58 object Button1: TButton 59 Left = 64 60 Top = 139 61 Width = 75 62 Height = 25 63 Caption = #21019#24314 64 TabOrder = 0 65 OnClick = Button1Click 66 end 67 object Button2: TButton 68 Left = 256 69 Top = 198 70 Width = 75 71 Height = 25 72 Caption = #31227#38500 73 TabOrder = 1 74 OnClick = Button2Click 75 end 76 object Edit1: TEdit 77 Left = 64 78 Top = 85 79 Width = 121 80 Height = 21 81 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 82 TabOrder = 2 83 end 84 object Edit2: TEdit 85 Left = 64 86 Top = 112 87 Width = 289 88 Height = 21 89 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 90 TabOrder = 3 91 end 92 object Edit3: TEdit 93 Left = 64 94 Top = 200 95 Width = 186 96 Height = 21 97 ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861 98 TabOrder = 4 99 end 100 end
----Form结束
