• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 8749
  • Last Modified:

How can I use VBScript to enumerate HKEY_USERS and delete a Key and all subkeys only if a REG_SZ values exists.

I am able to enumerate HKEY_USERS\UserSID easily but I need to dig 6 levels deeper to look for a string value.  If that string value exists I need to then delete the parent and all sub keys to the parent key.  

The full path to the "parent" key is: HKEY_USERS\UserSID\Software\FileNET\IDM\Preferences\Libraries\DefaultIMS:AIT:FileNet

If the string value Parent\Label = "AIT" then delete the 7 subkeys of the parent and the parent itself.

Unfortunately the string value is not the same for all user profiles and I need to only delete those that = "AIT".

I have scoured all over and can't find a way to do this.

Here is what I have so far:
 
Const HKU_USERS = &H80000003

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 

strIPDKeyPath = "\Software\FileNET\IDM\Preferences\Libraries\DefaultIMS:AIT:FileNet" 

DeleteIPDSubkeys HKU_USERS, strIPDKeyPath

Sub DeleteIPDSubkeys(HKU_USERS, strIPDKeyPath) 
    objRegistry.EnumKey HKU_USERS,"", arrSubkeys 

    If IsArray(arrSubkeys) Then 
        For Each strSubkey In arrSubkeys 
            'how to enumerate the subkeys of strSubKey to ultimately
            'delete HKU_USERS\UserSID\strIPDKeyPath and it's subkeys
            'if the string value of "Label" = "AIT".
        Next 
    End If 

    objRegistry.DeleteKey HKU_USERS, strIPDKeyPath 
End Sub

Open in new window

0
tneubauertocg
Asked:
tneubauertocg
  • 2
  • 2
1 Solution
 
ltlbearand3Commented:
You will need to loop through each sub key individually until you get to the end and then delete each key back up.  The way to do this is looping through a sub routine.  Also, the want to find out if your key is the correct key is to search one node up and then look for the AIT string.  Try the code below.  Warning - back up your registry first as this has not been tested.  As always, playing with the registry can be dangerous.  I really suggest testing on a virtual machine if you have acces to one.  I would even change to using a message box instead of the actual delete call first time through just to check the results.

-Bear
Const HKU_USERS = &H80000003

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 

strIPDKeyPath = "\Software\FileNET\IDM\Preferences\Libraries" 

DeleteIPDSubkeys HKU_USERS, strIPDKeyPath

Sub DeleteIPDSubkeys(HKU_USERS, strIPDKeyPath) 
    objRegistry.EnumKey HKU_USERS,"", arrSubkeys 

    If IsArray(arrSubkeys) Then 
        For Each strSubkey In arrSubkeys 
			If instr(strSubKey, "AIT") > 0 Then
				' Search and Delete Key and sub keys
				SearchAndDeleteSubKeys strIPDKeyPath & "\" & subkey

				objRegistry.DeleteKey HKU_USERS, strIPDKeyPath 
			End If
        Next 
    End If 
End Sub

sub SearchAndDeleteSubKeys (SubKeyToSearch)
	Dim intArraySize

	objRegistry.EnumKey HKEY_LOCAL_MACHINE, SubKeyToSearch, arrSearchSubKeys

	intArraySize = UpperBound(arrSearchSubKeys)

	if intArraySize < 0 then
		objRegistry.DeleteKey HKEY_CURRENT_USER,strKeyPath
	Else
		For Each subkey In arrSearchSubKeys
			SearchAndDeleteSubKeys(SubKeyToSearch & "\" & subkey)
		Next
	End If
End sub

Function UpperBound (ArrayToSize)
	' Find size of array.  Return -1 if it has not size
	Dim intSize
	msgbox "Here"
	
	On Error Resume Next
	intSize = Ubound(ArrayToSize)
	On Error Goto 0
	
	If len(intSize) > 0 then
		' Ubound returned a value.  Use it
		UpperBound = intSize
	Else
		' UBound Errored send back a -1
		UpperBound = -1
	End if
	
End Function

Open in new window

0
 
tneubauertocgAuthor Commented:
Bear - I just corrected a couple of references (to HKEY_LOCAL_MACHINE & HKEY_CURRENT_USER) back to HKEY_USERS.  When I ran the script on my VM through the debugger I noticed that it never gets out of the first for-next loop in the sub "DeleteIPDSubkeys".  This is because at that level the subkey in the array is the user SID.  The value of "AIT" is several layers below that.  I have included the modified script and a screenshot of the actual registry key.   Any ideas on how to get down this far?  Thanks!
Const HKEY_USERS                     = &H80000003

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 

strIPDKeyPath = "\Software\FileNET\IDM\Preferences\Libraries\DefaultIMS:AIT:FileNet" 

DeleteIPDSubkeys HKEY_USERS, strIPDKeyPath

Sub DeleteIPDSubkeys(HKEY_USERS, strIPDKeyPath) 
    objRegistry.EnumKey HKEY_USERS,"", arrSubkeys 

    If IsArray(arrSubkeys) Then 
        For Each strSubkey In arrSubkeys 
			If instr(strSubKey, "AIT") > 0 Then
				' Search and Delete Key and sub keys
				SearchAndDeleteSubKeys strIPDKeyPath & "\" & subkey

				objRegistry.DeleteKey HKEY_USERS, strIPDKeyPath 
			End If
        Next 
    End If 
End Sub

sub SearchAndDeleteSubKeys (SubKeyToSearch)
	Dim intArraySize

	objRegistry.EnumKey HKEY_USERS, SubKeyToSearch, arrSearchSubKeys

	intArraySize = UpperBound(arrSearchSubKeys)

	if intArraySize < 0 then
		objRegistry.DeleteKey HKEY_USERS,strKeyPath
	Else
		For Each subkey In arrSearchSubKeys
			SearchAndDeleteSubKeys(SubKeyToSearch & "\" & subkey)
		Next
	End If
End Sub

Function UpperBound (ArrayToSize)
	' Find size of array.  Return -1 if it has not size
	Dim intSize
	msgbox "Here"
	
	On Error Resume Next
	intSize = Ubound(ArrayToSize)
	On Error Goto 0
	
	If len(intSize) > 0 Then
		' Ubound returned a value.  Use it
		UpperBound = intSize
	Else
		' UBound Errored send back a -1
		UpperBound = -1
	End If
	
End Function

Open in new window

Registry screen shot.
0
 
ltlbearand3Commented:
Ok.  Give this a try.  I had to re-read your question as I missed a part.  The screen shots also helped me better understand.  Thanks.  I noticed a couple problems in my script also.  I redid the script and think this might be close to what you need.  Comment out the message boxes and uncomment the DeleteKey lines when ready to try for real.

-Bear

Const HKEY_USERS = &H80000003

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 

' Sub SID path to Query and Delete
strIPDKeyPath = "\Software\FileNET\IDM\Preferences\Libraries\DefaultIMS:AIT:FileNet"

' Grab a list of All User SIDs
objRegistry.EnumKey HKEY_USERS, "", arrSubkeys

' Loop Through all User SIDs
For Each strSubKey in arrSubKeys
	if left(strSubKey, 1) = "S" then msgbox strSubKey & strIPDKeyPath
	
	' Look for a Match in HKEY_USERS\UserSID\Software\FileNET\IDM\Preferences\Libraries\DefaultIMS:AIT:FileNet
	objRegistry.GetStringValue HKEY_USERS, strSubKey & strIPDKeyPath ,"Label",strValue
	
	If instr(strValue, "AIT") > 0 Then
		' Value Matches
		' Search Through Sub Keys and Delete
		SearchAndDeleteSubKeys HKEY_USERS, strSubKey & strIPDKeyPath
		
		' Now Delete This Key
		Msgbox "Would attempt to Delete : " & strSubKey & strIPDKeyPath
		'objRegistry.DeleteKey HKEY_USERS, strSubKey & strIPDKeyPath
	End If
Next

sub SearchAndDeleteSubKeys (MainRegKeyPath, SubKeyToSearch)
	Dim intArraySize

	objRegistry.EnumKey MainRegKeyPath, SubKeyToSearch, arrSearchSubKeys

	intArraySize = UpperBound(arrSearchSubKeys)

	if intArraySize < 0 then
		' No Sub Keys.  OK to Delete
		Msgbox "Would attempt to Delete : " & SubKeyToSearch
		'objRegistry.DeleteKey MainRegKeyPath, SubKeyToSearch
	Else
		' Has Sub Keys.  Loop Through them
		For Each subkey In arrSearchSubKeys
			SearchAndDeleteSubKeys MainRegKeyPath, SubKeyToSearch & "\" & subkey
		Next
	End If
End Sub

Function UpperBound (ArrayToSize)
	' Find size of array.  Return -1 if it has not size
	Dim intSize
	
	On Error Resume Next
	intSize = Ubound(ArrayToSize)
	On Error Goto 0
	
	If len(intSize) > 0 Then
		' Ubound returned a value.  Use it
		UpperBound = intSize
	Else
		' UBound Errored send back a -1
		UpperBound = -1
	End If
	
End Function

Open in new window

0
 
tneubauertocgAuthor Commented:
Bear - this is perfect!  I cannot express my thanks enough as this is going to save my bacon!
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now