zoukankan      html  css  js  c++  java
  • Delphi删除建立Windows防火墙规则

    来自网上

     ---------------此程序开发环境为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结束

  • 相关阅读:
    EntityFramework 启用迁移 EnableMigrations 报异常 "No context type was found in the assembly"
    JAVA 访问FTP服务器示例(2)
    NuGet Package Manager 更新错误解决办法
    JAVA 访问FTP服务器示例(1)
    RemoteAttribute 的使用问题
    诡异的 javascript 变量
    javascript apply用法
    Babun 中文乱码
    GSM呼叫过程
    转站博客园
  • 原文地址:https://www.cnblogs.com/dmqhjp/p/14156143.html
Copyright © 2011-2022 走看看