' This script will make changes to Windows Firewall with Advanced Security (WFAS)

' DISCLAIMER:  This script is intended for reference only.  Just because this worked
'   for me, you must assume that this script will probably turn your computer into a
'   puddle of molten silicon, or render your system inoperable requiring a full re-install.
'   I can not be held liable for damage done to your system by using any of this script.
' REMINDER: Before making any changes to your WFAS rules with this script, Export your
'   default WFAS settings ("Restore Default Policy" will not be the same).

' PURPOSE:  Copy specific WFAS rules, "Profile = All" and "Enabled = Yes"
'    to: "Profile = Public" and "Enabled = No"
'    and change the original rule: "Profile = Domain,Private" (leave Enabled)
' REFERENCE: http://msdn.microsoft.com/en-us/library/dd745029(VS.85).aspx
' DEVELOPED BY: Jay Ohman, Ohman Automation Corp - www.OhmanCorp.com
' -------------------------------------------------------------------------------------------------

Option Explicit
Dim Rule, NewRule, RuleProp

' Profile Type
Const NET_FW_PROFILE2_DOMAIN = 1
Const NET_FW_PROFILE2_PRIVATE = 2
Const NET_FW_PROFILE2_PUBLIC = 4
Const NET_FW_PROFILE2_ALL = 2147483647

' Protocol
Const NET_FW_IP_PROTOCOL_TCP = 6
Const NET_FW_IP_PROTOCOL_UDP = 17
Const NET_FW_IP_PROTOCOL_ICMPv4 = 1
Const NET_FW_IP_PROTOCOL_ICMPv6 = 58

' Direction
Const NET_FW_RULE_DIR_IN = 1
Const NET_FW_RULE_DIR_OUT = 2

' Action
Const NET_FW_ACTION_BLOCK = 0
Const NET_FW_ACTION_ALLOW = 1


' Create the FwPolicy2 object.
Dim fwPolicy2
Set fwPolicy2 = CreateObject("HNetCfg.FwPolicy2")

' Get the Rules object
Dim RulesObject
Set RulesObject = fwPolicy2.Rules
WScript.Echo "Processing " & RulesObject.Count & " rules..."

' Iterate rules that match criteria, tweak the profile to drop public, then copy with public profile setting
For Each Rule In Rulesobject
  ' next line(s) for testing
'  If (Rule.Grouping = "@FirewallAPI.dll,-25000") And (Rule.Profiles = NET_FW_PROFILE2_ALL) _
'      And (Rule.Name = "Core Networking - Destination Unreachable (ICMPv6-In)") Then
'  If (Rule.Grouping = "@FirewallAPI.dll,-25000") And (Rule.Profiles = NET_FW_PROFILE2_ALL) _
'      And (Rule.Name = "Core Networking - IPHTTPS (TCP-In)") Then

  ' The real filter, Split all rules with "Profile = All" and "Enabled = Yes"
  If (Rule.Enabled = TRUE) And (Rule.Profiles = NET_FW_PROFILE2_ALL) Then
    If (Rule.LocalPorts = "IPHTTPS") Or (Rule.RemotePorts = "IPHTTPS") Then
      WScript.Echo "NOT COPIED, Rule: " & Rule.Name
      WScript.Echo "   contains LocalPorts = 'IPHTTPS', which can not be copied by script."
      WScript.Echo "   Manually copy/paste this rule."
    Else
      Rule.Profiles = 3                                      ' 3=Domain,Private
      Set NewRule = CreateObject("HNetCfg.FWRule")
'      WScript.Echo "  Rule: " & Rule.Direction & "-" & Rule.Name
      NewRule.Direction = Rule.Direction
      NewRule.Name = Rule.Name
      NewRule.Grouping = Rule.Grouping
      NewRule.Profiles = 4                                   ' 4=Public
      NewRule.Enabled = FALSE
      NewRule.Action = Rule.Action
      NewRule.ApplicationName = Rule.ApplicationName
      NewRule.Protocol = Rule.Protocol
      If (Rule.Protocol = NET_FW_IP_PROTOCOL_ICMPv4) Or (Rule.Protocol = NET_FW_IP_PROTOCOL_ICMPv6) Then
        NewRule.IcmpTypesAndCodes = Rule.IcmpTypesAndCodes
      End If
      NewRule.LocalAddresses = Rule.LocalAddresses
      NewRule.RemoteAddresses = Rule.RemoteAddresses
      If (Rule.Protocol = NET_FW_IP_PROTOCOL_TCP) Then
        NewRule.LocalPorts = Rule.LocalPorts
        NewRule.RemotePorts = Rule.RemotePorts
      End If
      NewRule.Description = Rule.Description
      NewRule.EdgeTraversal = Rule.EdgeTraversal
      NewRule.InterfaceTypes = Rule.InterfaceTypes
      NewRule.ServiceName = Rule.ServiceName
      NewRule.Interfaces = Rule.Interfaces
      RulesObject.Add NewRule
    End If
    Set NewRule = Nothing
  End If
Next
WScript.Echo "Done."