'-------------Add this to sms_def.mof or mini.mof--------

'   #pragma namespace("\\\\.\\root\\cimv2\\sms")
'   
'   [SMS_Report(TRUE), SMS_Group_Name("GPO History"), SMS_Class_ID("SMSEXPERT|GPOHistory|1.0")]
'
'   class GPOHistory : SMS_Class_Template
'   {
'      [SMS_Report(TRUE)] string DisplayName;
'      [SMS_Report(TRUE)] string DSPath;
'      [SMS_Report(TRUE)] string FileSysPath;
'      [SMS_Report(TRUE)] string GPOName;
'      [SMS_Report(TRUE)] string Link;
'      [SMS_Report(TRUE), Key] uint32 Key1;
'      [SMS_Report(TRUE)] string Type;
'   };

'---------without the ' of course!----------------



Dim objRegistry
Dim strComputer
Dim Arr1(1000,1000)
Set sho = CreateObject("Wscript.Shell")
Const HKEY_LOCAL_MACHINE = &H80000002 'HKEY_LOCAL_MACHINE
Const HKEY_CURRENT_USER = &H80000001 'HKEY_CURRENT_USER

strcomputer = "."

Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strcomputer & "/root/default:StdRegProv")

strKey = "Software\Microsoft\Windows\CurrentVersion\Group Policy\History"

SearchReg(strKey)
wscript.quit

Function SearchReg(strKeyPath)
Dim RC, strSubKey, arrSubKeys

'call Function recursively To deal With HKLM subkeys
RC = objRegistry.EnumKey (HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys)
i=0
If IsArray(arrSubKeys)Then 
 For Each strSubKey In arrSubKeys
   RC2 = ObjRegistry.EnumKey (HKEY_LOCAL_MACHINE,strKeyPath & "\" & strSubkey, arrSubKeys2)
   if IsArray(arrSubKeys2) then
   For Each strSubKey2 in arrSubKeys2
   Arr1(i,0)=i
   Arr1(i,1)="Machine"
   Arr1(i,2)=sho.regread("HKLM\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\DisplayName")
   Arr1(i,3)=sho.regread("HKLM\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\DSPath")
   Arr1(i,4)=sho.regread("HKLM\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\FileSysPath")
   Arr1(i,5)=sho.regread("HKLM\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\GPOName")
   Arr1(i,6)=sho.regread("HKLM\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\Link")
	i = i + 1
   Next
   end if 
 Next
Else
 Exit Function
End If 

'call Function recursively To deal With HKCU subkeys
RC = objRegistry.EnumKey (HKEY_CURRENT_USER, strKeyPath, arrSubKeys)

If IsArray(arrSubKeys)Then 
 For Each strSubKey In arrSubKeys
   RC2 = ObjRegistry.EnumKey (HKEY_CURRENT_USER,strKeyPath & "\" & strSubkey, arrSubKeys2)
   if IsArray(arrSubKeys2) then
   For Each strSubKey2 in arrSubKeys2
   Arr1(i,0)=i
   Arr1(i,1)="User"
   Arr1(i,2)=sho.regread("HKCU\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\DisplayName")
   Arr1(i,3)=sho.regread("HKCU\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\DSPath")
   Arr1(i,4)=sho.regread("HKCU\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\FileSysPath")
   Arr1(i,5)=sho.regread("HKCU\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\GPOName")
   Arr1(i,6)=sho.regread("HKCU\" & strKeyPath & "\" & strsubkey & "\" & strsubkey2 & "\Link")
	i = i + 1
   Next
   end if 
  'SearchReg((strKeyPath & "\" & strSubKey))
 Next
Else
 Exit Function
End If 

'Create WMI Area, populate with info.
On Error Resume Next
wbemCimtypeSint32 = 3
wbemCimtypeString = 8
wbemCimtypeUint32 = 19

Set oLocation = CreateObject("WbemScripting.SWbemLocator")
Set oServices = oLocation.ConnectServer(, "root\cimv2")
set oNewObject = oServices.Get("GPOHistory")
oNewObject.Delete_
Set oServices = oLocation.ConnectServer(, "root\cimv2\SMS")
set oNewObject = oServices.Get("GPOHistory")
oNewObject.Delete_
'Create data class structure
Set oServices = oLocation.ConnectServer(, "root\cimv2")
Set oDataObject = oServices.Get
oDataObject.Path_.Class = "GPOHistory"
oDataObject.Properties_.add "Key1", wbemCimtypeUint32
oDataObject.Properties_.add "Type", wbemCimtypeString
oDataObject.Properties_.add "DisplayName", wbemCimtypeString
oDataObject.Properties_.add "DSPath", wbemCimtypeString
oDataObject.Properties_.add "FileSysPath", wbemCimtypeString
oDataObject.Properties_.add "GPOName", wbemCimtypeString
oDataObject.Properties_.add "Link", wbemCimtypeString
oDataObject.Properties_("Key1").Qualifiers_.add "key", True
oDataObject.Put_
For j = 0 to i-1
Set oNewObject = oServices.Get("GPOHistory").SpawnInstance_
 oNewObject.Key1 = Arr1(j,0)
 oNewObject.Type = Arr1(j,1)
 oNewObject.DisplayName = Arr1(j,2)
 oNewObject.DSPath = Arr1(j,3)
 oNewObject.FileSysPath = Arr1(j,4)
 oNewObject.GPOName = Arr1(j,5)
 oNewObject.Link = Arr1(j,6)
 oNewObject.Put_
Next
'Create reporting class structure
Set oServices = oLocation.ConnectServer(, "root\cimv2\SMS")
Set oRptObject = oServices.Get("SMS_Class_Template").SpawnDerivedClass_

'Set Class Name and Qualifiers
oRptObject.Path_.Class = "GPOHistory"
oRptObject.Qualifiers_.Add "SMS_Report", True
oRptObject.Qualifiers_.Add "SMS_Group_Name", "GPO History"
oRptObject.Qualifiers_.Add "SMS_Class_ID", "SMSEXPERT|GPOHistory|1.0"
'Add Reporting Class Properties
oRptObject.Properties_.Add("Key1", wbemCimtypeUint32).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("Type", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("DisplayName", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("DSPath", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("FileSysPath", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("GPOName", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_.Add("Link", wbemCimtypeString).Qualifiers_.Add "SMS_Report", True
oRptObject.Properties_("Key1").Qualifiers_.Add "key", True
oRptObject.Put_
Exit Function
End Function