Windows防火墙控制

uses
  Winapi.ActiveX;

procedure AddFirewallOutException(const Caption, AppPath: string);
var
  Profile: Integer;
  Policy2: OleVariant;
  RObject: OleVariant;
  NewRule: OleVariant;
const
  NET_FW_RULE_DIR_IN = 1;
  NET_FW_RULE_DIR_OUT = 2;
  NET_FW_ACTION_BLOCK = 0;
  NET_FW_ACTION_ALLOW = 1;
  NET_FW_IP_PROTOCOL_ANY = $00000100;
  NET_FW_PROFILE2_ALL = $7FFFFFFF;
  NET_FW_IP_PROTOCOL_TCP = 6;
begin
  if Caption = '' then Exit;
  Profile := NET_FW_PROFILE2_ALL;
  Policy2 := CreateOleObject('HNetCfg.FwPolicy2');
  RObject := Policy2.Rules;
  NewRule := CreateOleObject('HNetCfg.FWRule');
  NewRule.Name := Caption;
  NewRule.Description := Caption;
  if AppPath <> '' then
    NewRule.ApplicationName := AppPath;
  NewRule.direction := NET_FW_RULE_DIR_OUT;
  NewRule.Protocol := NET_FW_IP_PROTOCOL_ANY;
  NewRule.Enabled := True;
  NewRule.Grouping := '';
  NewRule.Profiles := Profile;
  NewRule.Action := NET_FW_ACTION_BLOCK;
  RObject.Add(NewRule);
end;

procedure DeleteFromWinFirewall(const RuleName: string);
var
  Policy2: OleVariant;
  RObject: OleVariant;
begin
  Policy2 := CreateOleObject('HNetCfg.FwPolicy2');
  RObject := Policy2.Rules;
  RObject.Remove(RuleName);
end;

function FindFireWallRule(const ruleName: string): Boolean;
var
  fwPolicy2: OleVariant;
  RulesObject: OleVariant;
  rule: OleVariant;
  oEnum: IEnumvariant;
  CurrentProfiles: Integer;
  iValue: LongWord;
begin
  fwPolicy2 := CreateOleObject('HNetCfg.FwPolicy2');
  RulesObject := fwPolicy2.Rules;
  CurrentProfiles := fwPolicy2.CurrentProfileTypes;

  oEnum := IUnknown(RulesObject._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rule, iValue) = 0 do
  begin
    if UpperCase(ruleName) = UpperCase(rule.Name) then
      Exit(True);
  end;

  Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sText: AnsiString;
begin
  sText := AnsiString(Edit1.Text);
  FUdp.SendPort := 9000;
  FUdp.SendBuf('192.168.x.x', PAnsiChar(sText), Length(sText), True);
end;

const
  xxx = 'aaaaa3';

procedure TForm1.Button2Click(Sender: TObject);
begin
  DeleteFromWinFirewall(xxx);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if not FindFireWallRule(xxx) then
  begin
    ShowMessage('not found.');
    AddFirewallOutException(xxx, 'C:\Users\WS\Desktop\Project1.exe');
  end;
end;