Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002

const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
 
strComputer = "."

Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
 strComputer & "\root\default:StdRegProv")

strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\"
strStandardPath = "\Software\Policies\Microsoft\WindowsFirewall\StandardProfile\"
strDomainPath = "\Software\Policies\Microsoft\WindowsFirewall\DomainProfile\"

If keyExists(HKEY_CURRENT_USER,strKeyPath) Then
  subkeys = GetSubkeys(HKEY_CURRENT_USER,strKeyPath)
  if Not IsEmpty(subkeys) Then
    GPOMachine = subkeys(LBound(subkeys)) 
	GPOUser    = subkeys(UBound(subkeys))
	
	RegCopyTree HKEY_CURRENT_USER, strKeyPath & GPOMachine & strStandardPath, strKeyPath & GPOMachine & strDomainPath, False
  Else
    WScript.Echo "Policy not found, please try editing the policy manually"
  end if
Else
  WScript.Echo "Please start editing the Group Policy before running this script"
End If

WScript.Quit


Function keyExists(Hive, Key)
  On Error Resume Next
  Err.Clear
  strComputer = "."
  
  ret = objReg.EnumValues(Hive,Key,arrValues,arrValueTypes)
  
  If ret <> 0 Then
    keyExists = False
  Else
    keyExists = True
  End If
  Err.Clear
  On Error Goto 0
End Function

Function valueExists(Hive, Key, ValueName)
  On Error Resume Next
  Err.Clear
  strComputer = "."
  
  valueExists = False
  If Not keyExists(Hive, Key) Then
    Exit Function
  End If
  
  ret = objReg.EnumValues(Hive,Key,arrValues,arrValueTypes)
  
  If IsNull(arrValues) Then
    Exit Function
  End IF
  
  For i = LBound(arrValues) to UBound(arrValues)
    If LCase(CStr(arrValues(i))) = LCase(CStr(ValueName)) Then
	  valueExists = True
	  Exit Function
	End If
  Next
  
  valueExists = False

  Err.Clear
  On Error Goto 0
End Function


Function GetSubkeys(Hive, Key)
  On Error Resume Next
  Err.Clear
  strComputer = "."
  
  ret = objReg.EnumKey(Hive,Key,arrSubkeys)
  
  If ret <> 0 Then
    GetSubkeys = arrSubkeys
  Else
    GetSubkeys = arrSubkeys
  End If
  Err.Clear
  On Error Goto 0
End Function


Function RegCopyTree(Hive, SrcKey, DestKey, Force)
  On Error Resume Next
  Err.Clear
  strComputer = "."
  Set StdOut = WScript.StdOut
  strValue = ""
  If Force <> True Then
    Force = False
  End If
    
  if Right(SrcKey,1) <> "\" Then SrcKey = SrcKey & "\"
  if Right(DestKey,1) <> "\" Then DestKey = DestKey & "\"
  
  ret = objReg.EnumValues(Hive,SrcKey,arrValueNames,arrValueTypes)

  For i= LBound(arrValueNames) To UBound(arrValueNames)
    'StdOut.WriteLine "Value Name: " & arrValueNames(i) 
	StdOut.WriteLine "Copying from: " & SrcKey & arrValueNames(i)
	StdOut.WriteLine "To          : " & DestKey & arrValueNames(i)
    StdOut.Write     "       Value: "

	If (Not valueExists(Hive, DestKey, arrValueNames(i))) Or Force Then
	  Select Case arrValueTypes(i)
			Case REG_SZ
				'StdOut.WriteLine "Data Type: String"
				'StdOut.WriteBlankLines(1)
				
				objReg.GetStringValue Hive, SrcKey, arrValueNames(i), strValue
				objReg.SetStringValue Hive, DestKey, arrValueNames(i), strValue
				StdOut.Write strValue
			Case REG_EXPAND_SZ
				'StdOut.WriteLine "Data Type: Expanded String"
				'StdOut.WriteBlankLines(1)
				
				objReg.GetExpandedStringValue Hive, SrcKey, arrValueNames(i), strValue
				objReg.SetExpandedStringValue Hive, DestKey, arrValueNames(i), strValue
				StdOut.Write strValue

			Case REG_BINARY
				'StdOut.WriteLine "Data Type: Binary"
				'StdOut.WriteBlankLines(1)
				
				objReg.GetBinaryValue Hive, SrcKey, arrValueNames(i), strValue
				objReg.SetBinaryValue Hive, DestKey, arrValueNames(i), strValue
				For Each x in strValue
		          StdOut.Write Hex(x) & " "
		        Next

			Case REG_DWORD
				'StdOut.WriteLine "Data Type: DWORD"
				'StdOut.WriteBlankLines(1)
				
				objReg.GetDWORDValue Hive, SrcKey, arrValueNames(i), strValue
				objReg.SetDWordValue Hive, DestKey, arrValueNames(i), strValue
				
				StdOut.Write Hex(strValue)
			Case REG_MULTI_SZ
				'StdOut.WriteLine "Data Type: Multi String"
				'StdOut.WriteBlankLines(1)
				
				objReg.GetMultiStringValue Hive, SrcKey, arrValueNames(i), strValue
				objReg.SetMultiStringValue Hive, DestKey, arrValueNames(i), strValue
				For Each x in strValue
		          StdOut.Write x
		        Next
		End Select 
		
		StdOut.WriteLine ""
    End If '' Force
  Next
  
  ret = objReg.EnumKey(Hive,SrcKey,arrSubkeys)
  
  For i = LBound(arrSubkeys) to UBound(arrSubkeys)
    If Not keyExists(Hive,DestKey & arrSubkeys(i)) Then
	  objReg.CreateKey Hive,DestKey & arrSubkeys(i)
	End If
	RegCopyTree Hive, SrcKey & arrSubkeys(i), DestKey & arrSubkeys(i), Force
  Next

  On Error Goto 0
End Function