Dwarfsoft [GPA]

I had started another post on Group Policy editing, and how the Policy files are structured, and how to use and improve on the existing Group Policy Editor tool. The post has been found to be far too epic, so I have decided to cover a smaller subset of recent finds.

As everybody is probably already aware, we use Novell ConsoleOne and Zenworks where I work. ConsoleOne has some interesting features that require that whenever a Group Policy is being edited it takes over as the policy on the machine that is editing it. Rather than have a useful tool like Microsofts Group Policy Management Console, Novell likes to replace the local Group Policy and then just run gpedit.msc. Which is where my first gripe about gpedit.msc comes in:

GPEdit.msc requires line by line entry of things like, for example, port exceptions and program exceptions for the Windows Firewall. This is usually not an issue except that, as I have discussed in previous posts, we have been moving towards a Windows Domain environment. Firewall Exception rules are configured within two places in Group Policy: Domain Profile and Standard Profile. I have found that there is a need to move our current Standard Profile settings across to the Domain Profile settings. After a bit of registry searching I found a neat trick for doing exactly that.

In Novell, when a GPO is opened in gpedit.msc the Group Policy Contents are loaded into the normal registry locations (as per a normal GPO being applied to user and machine) and the contents are also loaded under a specific pair of registry keys. The HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Group Policy Objects Key is created on loading gpedit.msc, and underneath a pair of Keys are created like {449E44B0-A4DC-4665-AE8F-68710E1BC1EC}Machine and {449E44B0-A4DC-4665-AE8F-68710E1BC1EC}User, where the GUID is randomly generated (or at least seems to be random) each time gpedit.msc is run. Under these keys are the branch on which the Group Policy Settings are configured.

So therefore in order to duplicate StandardProfile Settings I need to duplicate all keys and values underneath HKCU\Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{GUID}Machine\Software\Policies\Microsoft\WindowsFirewall\StandardProfile\, where {GUID} is the randomly generated GUID for editing a Group Policy Object. So far from my research I have never seen more than one GUID appear underneath the Group Policy Objects key, though your mileage may vary. So the first step is to get the User and Machine keys from under the Group Policy Objects key.

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

The code here is the shell of the script. We need to flesh out the functions keyExists, GetSubkeys, RegCopyTree, and valueExists (which we can’t see just yet). So first we will have a look at keyExists:

Function keyExists(Hive, Key)
  On Error Resume Next
  Err.Clear
 
  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

Fairly straightforward, we try and enumerate the values of a key. If we succeed then the key does exist, otherwise it doesn’t. We will use the same principle for checking if a Value Exists.

Function valueExists(Hive, Key, ValueName)
  On Error Resume Next
  Err.Clear
 
  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

Here, we take the Enumeration of the Keys Values a step further and actually step through them looking for a match with ValueName. I have opted for a Case Insensitive search due to registry being case insensitive with value names.

Function GetSubkeys(Hive, Key)
  On Error Resume Next
  Err.Clear
 
  ret = objReg.EnumKey(Hive,Key,arrSubkeys)
 
  GetSubkeys = arrSubkeys
 
  Err.Clear
  On Error Goto 0
End Function

Possibly the simplest of the functions, GetSubkeys just returns an array of Keys underneath the current Key. The most indepth function we require is the RegCopyTree:

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

This function takes the Hive, Source Key, Destination Key, and a Boolean Value to determine whether to Force overwriting existing values. It first creates the Destination key if it doesn’t already exist, then enumerates all values in the Source path, and writes them to the Destination path, creating new values or overwriting only if Force is set. This function has a lot of StdOut.Write calls to show the progress of the duplication. Running the script via CScript gives the following results:

Copying from: Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{678C8897-54AA-4FB9-AA72-6C227C287D12}Machine\Software\Policies\Microsoft\WindowsFirewall\StandardProfile\EnableFirewall
To          : Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{678C8897-54AA-4FB9-AA72-6C227C287D12}Machine\Software\Policies\Microsoft\WindowsFirewall\DomainProfile\EnableFirewall
       Value: 1
Copying from: Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{678C8897-54AA-4FB9-AA72-6C227C287D12}Machine\Software\Policies\Microsoft\WindowsFirewall\StandardProfile\AuthorizedApplications\Enabled
To          : Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{678C8897-54AA-4FB9-AA72-6C227C287D12}Machine\Software\Policies\Microsoft\WindowsFirewall\DomainProfile\AuthorizedApplications\Enabled
       Value: 1
...

This should simplify the time taken for duplicating from Standard to Domain profile. For future reference this has also made it far easier to import/export port/program exceptions from policies I am editing. In future I may incorporate this into my Group Policy Firewall Exceptions Excel Spreadsheet in VBA to allow writing updated policies to the Policy.

After running this the settings will be seen to have changed in the Group Policy Editor Window immediately. I have tested this and checked that the Logging file is not replaced by “…\standard.log” where it should be “…\domain.log”.

Cheers, Chris.

Attached: RegFirewallProfileDuplication.vbs