Set Registry Value for All Users

Author Message
DiGiTAL.SkReAM

  • Total Posts : 1259
  • Scores: 7
  • Reward points : 0
  • Joined: 9/7/2005
  • Location: Clearwater, FL, USA
  • Status: offline
Set Registry Value for All Users Thursday, September 13, 2007 6:08 AM (permalink)
0
This subroutine allows you to set a particular registry key to a particular value for all the users on that computer, and any future users as well.
 
This sub is a derivative of Ginolard's Excellent UserHives sub at http://www.visualbasicscript.com/fb.aspx?m=47074
 
 
usage:
 
SetAllUsersRegKey "Software\Microsoft\Command Processor\CompletionChar",00000009,"REG_DWORD"
 
 Sub SetAllUsersRegKey(sKeyName,sData,sType)
  Dim oShell, sCommand, oUserRegDic, oSubFolder, sKey, oReg, sSubKey, aRegKeys, aDesktopKeys
  Set oShell = CreateObject("Wscript.Shell")
  sCommand = "%comspec% /c " & oShell.ExpandEnvironmentStrings("%WINDIR%") & "\System32\Reg.exe "
  oShell.RegWrite "HKCU\" & sKeyName,sData,sType
  Set oUserRegDic = CreateObject("Scripting.Dictionary")
   For Each oSubFolder In oFSO.GetFolder(Left(oShell.SpecialFolders(0),InStr(oShell.SpecialFolders(0),"\All ")-1)).Subfolders
    On Error Resume Next 
     oUserRegDic.Add oSubFolder,oSubFolder.Name
    On Error GoTo 0 
   Next
   For Each sKey In oUserRegDic.Keys 
    oShell.Run sCommand & "LOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34) & " " & chr(34) & sKey & "\NTUser.dat" & Chr(34),0,True 
   Next
  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
  oReg.EnumKey HKEY_USERS, "", aRegKeys
   For Each sSubkey In aRegKeys
    oReg.EnumKey HKEY_USERS, sSubkey & "\Control Panel\Desktop", aDesktopKeys
     If Not IsNull(aDesktopKeys) Then 
      oShell.RegWrite "HKEY_USERS\" & sSubkey & "\" & sKeyName,sData,sType
     End If
   Next
   For Each sKey In oUserRegDic.Keys 
    oShell.Run sCommand & "UNLOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34),0,True 
   Next
 End Sub
 

 
"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury
 
#1
    jcampbell

    • Total Posts : 21
    • Scores: 0
    • Reward points : 0
    • Joined: 4/24/2008
    • Status: offline
    RE: Set Registry Value for All Users Thursday, March 19, 2009 1:26 AM (permalink)
    0

    Hey Digital,
     
    I tried this script but I keep getting an oFSO Object required error.  I was looking for something along this lines since I have a program that when I install it I need to create some keys for the HKCU section.  Below is the script I am testing with.  I have not modified your sub just changed the information it was adding in.
     
    Thanks,
     
    JC
     
     SetAllUsersRegKey "Software\Autodesk",00000009,"REG_DWORD" 
     Sub SetAllUsersRegKey (sKeyName,sData,sType)
     Dim oShell, sCommand, oUserRegDic, oSubFolder, sKey, oReg, sSubKey, aRegKeys, aDesktopKeys
     Set oShell = CreateObject("Wscript.Shell")
     sCommand = "%comspec% /c " & oShell.ExpandEnvironmentStrings("%WINDIR%") & "\System32\Reg.exe "
     oShell.RegWrite "HKCU\" & sKeyName,sData,sType
     Set oUserRegDic = CreateObject("Scripting.Dictionary")
      For Each oSubFolder In oFSO.GetFolder(Left(oShell.SpecialFolders(0),InStr(oShell.SpecialFolders(0),"\All ")-1)).Subfolders
       On Error Resume Next 
        oUserRegDic.Add oSubFolder,oSubFolder.Name
       On Error GoTo 0 
      Next
      For Each sKey In oUserRegDic.Keys 
       oShell.Run sCommand & "LOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34) & " " & chr(34) & sKey & "\NTUser.dat" & Chr(34),0,True 
      Next
     Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
     oReg.EnumKey HKEY_USERS, "", aRegKeys
      For Each sSubkey In aRegKeys
       oReg.EnumKey HKEY_USERS, sSubkey & "\Control Panel\Desktop", aDesktopKeys
        If Not IsNull(aDesktopKeys) Then 
         oShell.RegWrite "HKEY_USERS\" & sSubkey & "\" & sKeyName,sData,sType
        End If
      Next
      For Each sKey In oUserRegDic.Keys 
       oShell.Run sCommand & "UNLOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34),0,True 
      Next
     End Sub
     

     
     
     
     
    #2
      dm_4ever

      • Total Posts : 3687
      • Scores: 82
      • Reward points : 0
      • Joined: 6/29/2006
      • Location: Orange County, California
      • Status: offline
      RE: Set Registry Value for All Users Thursday, March 19, 2009 10:12 AM (permalink)
      0
      put the following before the first For Each...Next Loop
      Set oFSO = CreateObject("Scripting.FileSystemObject")
      dm_4ever

      My philosophy: K.I.S.S - Keep It Simple Stupid
      Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
      Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
       
      #3
        jcampbell

        • Total Posts : 21
        • Scores: 0
        • Reward points : 0
        • Joined: 4/24/2008
        • Status: offline
        RE: Set Registry Value for All Users Thursday, March 19, 2009 2:36 PM (permalink)
        0
        Ok that got my closer I cant bieleve I missed that one.  I am new so you will have to bare with me.  I am getting an Object not in Collection error.  I am assuming that this is because it is not creating an array from the HKEY_USERS section.  I have not used VBSCRIPTS to work on the registry before so this is all new to me.  I understand what the enumkey is doing but why is it not building the array? 

        Thanks for the help guys. 

         SetAllUsersRegKey "Software\autodesk",00000009,"REG_DWORD"  
         Sub SetAllUsersRegKey (sKeyName,sData,sType) 
         Dim oShell, sCommand, oUserRegDic, oSubFolder, sKey, oReg, sSubKey, aRegKeys, aDesktopKeys
         Set oShell = CreateObject("Wscript.Shell")
         sCommand = "%comspec% /c " & oShell.ExpandEnvironmentStrings("%WINDIR%") & "\System32\Reg.exe "
         oShell.RegWrite "HKCU\" & sKeyName,sData,sType
         Set oUserRegDic = CreateObject("Scripting.Dictionary")
         Set oFSO = CreateObject("Scripting.FileSystemObject")
          For Each oSubFolder In oFSO.GetFolder(Left(oShell.SpecialFolders(0),InStr(oShell.SpecialFolders(0),"\All ")-1)).Subfolders
           On Error Resume Next 
            oUserRegDic.Add oSubFolder,oSubFolder.Name
           On Error GoTo 0 
          Next
          For Each sKey In oUserRegDic.Keys 
           oShell.Run sCommand & "LOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34) & " " & chr(34) & sKey & "\NTUser.dat" & Chr(34),0,True 
          Next
         Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
         oReg.EnumKey HKEY_USERS, "", aRegKeys
          For Each sSubkey In aRegKeys
           oReg.EnumKey HKEY_USERS, sSubkey & "\software\autodesk", aDesktopKeys
            If Not IsNull(aDesktopKeys) Then 
             oShell.RegWrite "HKEY_USERS\" & sSubkey & "\" & sKeyName,sData,sType
            End If
          Next
          For Each sKey In oUserRegDic.Keys 
           oShell.Run sCommand & "UNLOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34),0,True 
          Next
         End Sub
         

         
        #4
          joshjthomas

          • Total Posts : 1
          • Scores: 0
          • Reward points : 0
          • Joined: 4/6/2010
          • Status: offline
          Re:Set Registry Value for All Users Tuesday, April 06, 2010 2:20 AM (permalink)
          0
          All props to the original poster. However I have edited the script to not be dependent on WMI. This is crucial in dealing with thin clients as WMI is often not baked into the OS image.
           
          I was in a hurry so it is a bit dirty, however it works. Please feel free to clean up / repost.
           
                Sub SetAllUsersRegKey(sKeyName,sData,sType)  
                'Example: SetAllUsersRegKey "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1A00",0000000,"REG_DWORD"      Dim oShell, sCommand, oUserRegDic, oSubFolder, sKey, oReg, sSubKey, aRegKeys(), iKeys, aDesktopKeys, oFSO, oExec, oStdOut, sLine, iErrorLevel  
                
                iKeys = 0
                
                Set oShell = CreateObject("Wscript.Shell")  
                sCommand = "%comspec% /c " & oShell.ExpandEnvironmentStrings("%WINDIR%") & "\System32\Reg.exe "  
                oShell.RegWrite "HKCU\" & sKeyName,sData,sType  
                Set oUserRegDic = CreateObject("Scripting.Dictionary")   
                
                Set oFSO = CreateObject("Scripting.FileSystemObject") 
                
                For Each oSubFolder In oFSO.GetFolder(Left(oShell.SpecialFolders(0),InStr(oShell.SpecialFolders(0),"\All ")-1)).Subfolders   
                 'Look into the users special folder and get a list of all subfolders (existing users)
                 On Error Resume Next '"disable" error handeling      
                 oUserRegDic.Add oSubFolder,oSubFolder.Name    
                 On Error GoTo 0 ' "enable" error handeling   
                Next         For Each sKey In oUserRegDic.Keys 'Slam all user regdata into HKU for editing later
                 oShell.Run sCommand & "LOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34) & " " & chr(34) & sKey & "\NTUser.dat" & Chr(34),0,True    
                Next        Set oExec = oShell.Exec("reg query HKU")      Do While oExec.Status = 0 'holds the script until comand has finished.
                   WScript.Sleep 100
                Loop      Set oStdOut = oExec.StdOut      Do Until oStdOut.AtEndOfStream 'Populates aRegKeys with all sub keys in HKU
                 sLine = Trim(oStdOut.ReadLine)
                 If Len(sLine) > 1 Then 'Thows out empty line
                  Select Case sLine
                   Case "! REG.EXE VERSION 3.0" 'do nothing / remove uneeded data
                   Case "HKEY_USERS" 'do nothing / remove uneeded data
                   Case Else
                    If Not oStdOut.AtEndOfStream then 'prevents extra array element
                     ReDim Preserve aRegKeys(iKeys + 1)
                    end if
                    aRegKeys(iKeys) = sLine
                    iKeys = iKeys + 1
                  End Select
                 End If
                Loop      For Each sSubkey In aRegKeys    
                 Set oExec = oShell.Exec("reg query " & Chr(34) & sSubkey & "\Control Panel\Desktop" & Chr(34))
                 Do While oExec.Status = 0 'holds the script until comand has finished.
                    WScript.Sleep 100
                 Loop       iErrorLevel = oExec.ExitCode       If iErrorLevel = 0 then' if the reg query is sucsessful the key belongs to a user
                  oShell.RegWrite sSubkey & "\" & sKeyName,sData,sType 'do the reg edit 
                 End if
                Next         For Each sKey In oUserRegDic.Keys 'Clean up user regdata entered earlier     
                 oShell.Run sCommand & "UNLOAD " & Chr(34) & "HKU\" & oUserRegDic.Item(sKey) & Chr(34),0,True    
                Next      End Sub     

           
          #5

            Online Bookmarks Sharing: Share/Bookmark

            Jump to:

            Current active users

            There are 0 members and 1 guests.

            Icon Legend and Permission

            • New Messages
            • No New Messages
            • Hot Topic w/ New Messages
            • Hot Topic w/o New Messages
            • Locked w/ New Messages
            • Locked w/o New Messages
            • Read Message
            • Post New Thread
            • Reply to message
            • Post New Poll
            • Submit Vote
            • Post reward post
            • Delete my own posts
            • Delete my own threads
            • Rate post

            2000-2012 ASPPlayground.NET Forum Version 3.9