Setting HKCU Array Values

This was a request from someone on an example for creating array registry values for all users on a computer.  I hope it us useful to others!

'==========================================================================
' NAME: HKCU_array.vbs
' VERSION: 1.0
' AUTHOR: Nick Moseley, http://t3chn1ck.wordpress.com
' DATE  : 8/10/2010
' COMMENT: This script will parse all User profiles on the computer, load their
'     HKCU hive, then set the sample array values in the sample keys
'==========================================================================
Const ForAppending = 8
Const HKLM = &H80000002
Dim oReg, oFSO, oFile, oUserSubkey, aUserProfiles
Dim sProfileLCase, sValue, sRegExe, sRegLoad, sRegUnload, sHiveName, sSubPath, sProfile, sValueName, sKeyPathUserProfiles, sSampleKeyPath1, sSampleKeyPath2 
Dim aRegKey1, aRegKey2, sRegValue1, sRegValue2
Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' First array sample
sRegValue1 = "Sample1"
aRegKey1 = Array(&H27,&H00,&H00,&H00)
' Second array sample
sRegValue2 = "Sample2"
aRegKey2 = Array(&H77,&H00,&H65,&H00,&H62,&H00,&H6d)
sValueName = "ProfileImagePath"
sKeyPathUserProfiles = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
sRegExe = "C:\Windows\system32\reg.exe"
sSampleKeyPath1 = "Software\Sample1"
sSampleKeyPath2 = "Software\Sample2"
' Begin log file entries
If Not oFSO.FileExists("C:\SampleLog.txt") Then
    oFSO.CreateTextFile "C:\SampleLog.txt"
End If
Set oFile = oFSO.OpenTextFile ("C:\SampleLog.txt", ForAppending, True)
oFile.WriteLine "Sample set HKCU array registry values"
oFile.WriteLine "  => Install began at " & Date & " " & Time
oFile.WriteLine "  => HKCU registry key modified: " & sSampleKeyPath1 & " and " & sSampleKeyPath2 
oFile.WriteLine "     Set value " & sRegValue1 & " (binary) to 27:00:00:00"
oFile.WriteLine "     Set value " & sRegValue2 & " (binary) to 77:00:65:00:62:00:6d"
oReg.EnumKey HKLM, sKeyPathUserProfiles, aUserProfiles
For Each oUserSubkey In aUserProfiles
    sSubPath = sKeyPathUserProfiles & "\" & oUserSubkey
   oReg.GetExpandedStringValue HKLM,sSubPath,sValueName,sValue
   sProfile = Split(sValue, "\")
   sProfileLCase = LCase(sProfile(2))
   
   If sProfileLCase = "administrator" Then 
       oFile.WriteLine "  => Skipping profile: administrator"
   ElseIf sProfileLCase = "system32" Then 
       oFile.WriteLine "  => Skipping profile: system32"
   ElseIf sProfileLCase = "localservice" Then 
       oFile.WriteLine "  => Skipping profile: localservice"
   ElseIf sProfileLCase = "networkservice" Then 
       oFile.WriteLine "  => Skipping profile: networkservice"
   ElseIf sProfileLCase = "serviceprofiles" Then 
       oFile.WriteLine "  => Skipping profile: serviceprofiles"
   Else
       sHiveName = "TempHive_" & sProfileLCase
       
       ' Load user's profile hive into a temp location
       sRegLoad = " LOAD HKLM\" & sHiveName & " """ & sValue & "\ntuser.dat"""
       oShell.Run sRegExe & sRegLoad, 0, True
       oFile.WriteLine "  => User: " & sProfileLCase
       
        ' Delete the old values
        oReg.DeleteValue HKLM, sSampleKeyPath1, sRegValue1
        oReg.DeleteValue HKLM, sSampleKeyPath2, sRegValue2
        
        ' Create/set the new values
        oReg.SetBinaryValue HKLM, sSampleKeyPath1, sRegValue1, aRegKey1
        oReg.SetBinaryValue HKLM, sSampleKeyPath2, sRegValue2, aRegKey2
       
       ' Unload user's profile hive
       sRegUnload = " UNLOAD HKLM\" & sHiveName
       oShell.Run sRegExe & sRegUnload, 0, True
       
       
   End If    
Next
' End logging
oFile.WriteLine "  => Install completed at " & Date & " " & Time
WScript.Quit (oFile.Close)

About these ads