/build/static/layout/Breadcrumb_cap_w.png

VB script to ADD/Delete registry to ALL USERS HKCU profile during installation.

Option Explicit
On error resume next
Dim oFSO,oShell,oNetwork 

' Set Registry Constants
Const HKEY_CLASSES_ROOT =&H80000000
Const HKEY_CURRENT_USER =&H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oNetwork = CreateObject("WScript.Network")

 '###################################################################################
' -----------Edit below section As per HKCU registry key ------------------------
'###################################################################################      

AddToUserHives "SOFTWARE\TEST\Google\Chrome","UpdateDisabled","REG_DWORD", "1"
AddToUserHives "SOFTWARE\TEST2\Google\Chrome","UpdateDisabled","REG_SZ", "1"
AddToUserHives "SOFTWARE\TEST1\Google\Chrome","UpdateDisabled","REG_DWORD", "1"

DeleteFromUserHives "SOFTWARE\TEST1\Google\Chrome"



'###################################################################################
' -----------Below are the function dont edit below section-------------------------
'###################################################################################

Function FileExist(sFilePath)
If oFSO.FileExists(sFilePath) Then
FileExist = True
Else
FileExist = False
End If
End Function

Function IsRegKeyExist(sRootKey,sSubKey)
Dim sKeyName,iRetVal
sKeyName = sRootKey & "\" & sSubKey
    iRetVal = oShell.Run("REG QUERY" & " " & chr(34) &  sKeyName & chr(34),0,True)
    If iRetVal <> 0 Then
        IsRegKeyExist = False
    Else
        IsRegKeyExist = True
    End If
End Function

Function IsRegValNameExist(sRootKey,sSubKey,sValueName)
Dim sKeyName,iRetVal
sKeyName = sRootKey & "\" & sSubKey
    iRetVal = oShell.Run("REG QUERY " & chr(34) & sKeyName & chr(34) & " /v " & chr(34) & sValueName & chr(34),0,True)
    If iRetVal <> 0 Then
        IsRegValNameExist = False
    Else
        IsRegValNameExist = True
    End If
End Function


Sub CreateKey(sRootKey,sSubKey)
Dim sKeyName,iRetVal
sKeyName = sRootKey & "\" & sSubKey
    If Not IsRegKeyExist(sRootKey,sSubKey) Then
        ''''LogItem "About to create: " & chr(34) & sKeyName & chr(34),True,False
        iRetVal = oShell.Run("REG ADD " & chr(34) &  sKeyName & chr(34) & " /f",0,True)
        If iRetVal <> 0 Then
            ''''LogItem chr(34) & sKeyName & chr(34) & " was not created",True,False
        Else
            ''''LogItem chr(34) & sKeyName & chr(34) & " has been created",True,False
        End If
    Else
        '''LogItem chr(34) & sKeyName & chr(34) & " already exists",True,False
    End If
End Sub

Sub DeleteKey(sRootKey,sSubKey)
Dim sKeyName,iRetVal
sKeyName = sRootKey & "\" & sSubKey
    If IsRegKeyExist(sRootKey,sSubKey) Then
        ''''LogItem "About to delete: " & chr(34) & sKeyName & chr(34),True,False
        iRetVal = oShell.Run("REG DELETE " & chr(34) &  sKeyName & chr(34) & " /f",0,True)
        If iRetVal <> 0 Then
            ''''LogItem chr(34) & sKeyName & chr(34) & " was not deleted",True,False
        Else
            ''''LogItem chr(34) & sKeyName & chr(34) & " has been deleted",True,False
        End If
    Else
        ''''LogItem chr(34) & sKeyName & chr(34) & " does not exist.",True,False
    End If
End Sub
 
Sub SetRegVal(sRootKey,sSubKey,sValueName,sDataType,sValue)
    Dim sKeyName
sKeyName = sRootKey & "\" & sSubKey
    
    If Not IsRegKeyExist(sRootKey,sSubKey) Then
        CreateKey sRootKey,sSubKey
    End If
    
    If Right(sValue,1) = "\" Then
    sValue = sValue & "\"
    End If

    Dim iRetVal
    iRetVal = oShell.Run("REG ADD " & chr(34) & sKeyName & chr(34) & " /v " & chr(34) & sValueName & chr(34) & " /t " & sDataType & " /d " & chr(34) &  sValue & chr(34) & " /f",0,True)
    If iRetVal <> 0 Then
        '''LogItem "The value of " & chr(34) & sValueName & chr(34) & " under " & sKeyName & " was not set to " & chr(34) & sValue & chr(34) & " as " &  sDataType,True,False
        '''LogItem "The process returned: " & iRetVal,True,False
    Else
        '''LogItem "The value of " & chr(34) & sValueName & chr(34) & " under " & sKeyName & " was set to " & chr(34) & sValue & chr(34) & " as " &  sDataType,True,False
    End If
End Sub

Sub DelRegValName(sRootKey,sSubKey,sValueName)
Dim iRetVal,sKeyName
sKeyName = sRootKey & "\" & sSubKey
    If IsRegValNameExist(sRootKey,sSubKey,sValueName) Then
        '''LogItem "About to delete " & chr(34) & sValueName & chr(34) & " under " & chr(34) & sRootKey & "\" & sSubKey & chr(34),True,False
        iRetVal = oShell.Run("REG DELETE " & chr(34) &  sKeyName & chr(34) & " /v " & sValueName & " /f",0,True)
        If iRetVal <> 0 Then
            '''LogItem chr(34) & sKeyName & "\" & sValueName & chr(34) & " was not deleted",True,False
        Else
            '''LogItem chr(34) & sKeyName & "\" & sValueName & chr(34) & " has been deleted",True,False
        End If
    Else
        '''LogItem chr(34) & sKeyName & "\" & sValueName & chr(34) & " does not exist.",True,False
    End If
End Sub

Sub AddToUserHives(sUserRegPath,sValueName,sType,sValue)
    Dim oReg
    Set oReg = GetObject("winmgmts://./root/default:StdRegProv")

    Dim sProListRegPath
    sProListRegPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"

    ' Enumerate profile list from registry
    Dim oProfile,oProfiles,sProfileDir
oReg.EnumKey HKEY_LOCAL_MACHINE, sProListRegPath, oProfiles

    Dim sProfile,sProfileName
    Dim iRetVal
    For Each oProfile In oProfiles
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, sProListRegPath & "\" & oProfile, "ProfileImagePath", sProfileDir

        sProfile = Split(sProfileDir, "\")
        sProfileName = sProfile(2)

        ' filter out unnecessary profiles 
     If (sProfileName <> "config") And (sProfileName <> "system32") And (sProfileName <> "ServiceProfiles") And (sProfileName <> "Administrator") And (sProfileName <> "localservice")And (sProfileName <> "networkservice") Then
    If FileExist(sProfileDir & "\NTuser.dat") Then
''''LogItem "Will try to mount user hive: " & sProfileDir & "\NTuser.dat",True,False
If MountHive(sProfileDir & "\NTuser.dat") Then
SetRegVal "HKU","CUSTOM\" & sUserRegPath,sValueName,sType,sValue
UnmountHive
Else
Dim oWMI
Set oWMI = GetObject("winmgmts://./root/cimv2")
Dim sDomain
sDomain = oNetwork.UserDomain
Dim oAccount
'Set oAccount = oWMI.Get("Win32_UserAccount.Name='" & sProfileName & "',Domain='" & sDomain & "'")
Dim sSID 
'sSID = oAccount.SID
sSID = oProfile
SetRegVal "HKU",sSID & "\" & sUserRegPath,sValueName,sType,sValue
End If
End If
End If
Next

    MountDefaultHive
    ''''LogItem "Will now update default user hive for all users.",True,False
SetRegVal "HKU","CUSTOM\" & sUserRegPath,sValueName,sType,sValue
    '''LogItem "Default user hive is now updated for all users.",True,False
UnmountHive
End Sub

Sub DeleteFromUserHives(sUserRegPath)
    Dim oReg
    Set oReg = GetObject("winmgmts://./root/default:StdRegProv")

    Dim sProListRegPath
    sProListRegPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"

    ' Enumerate profile list from registry
    Dim oProfile,oProfiles,sProfileDir
oReg.EnumKey HKEY_LOCAL_MACHINE, sProListRegPath, oProfiles

    Dim sProfile,sProfileName
    Dim iRetVal
    For Each oProfile In oProfiles
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, sProListRegPath & "\" & oProfile, "ProfileImagePath", sProfileDir

        sProfile = Split(sProfileDir, "\")
        sProfileName = sProfile(2)

        ' filter out unnecessary profiles 
If (sProfileName <> "config") And (sProfileName <> "system32") And (sProfileName <> "ServiceProfiles") And (sProfileName <> "Administrator") And (sProfileName <> "localservice")And (sProfileName <> "networkservice") Then
         If FileExist(sProfileDir & "\NTuser.dat") Then
                ''''LogItem "Will try to mount user hive: " & sProfileDir & "\NTuser.dat",True,False
                If MountHive(sProfileDir & "\NTuser.dat") Then
                    DeleteKey "HKU","CUSTOM\" & sUserRegPath
                    UnmountHive
                Else
                    Dim oWMI
Set oWMI = GetObject("winmgmts://./root/cimv2")
                    
                    Dim sDomain
                    sDomain = oNetwork.UserDomain

                    Dim oAccount
                    'Set oAccount = oWMI.Get("Win32_UserAccount.Name='" & sProfileName & "',Domain='" & sDomain & "'")

                    Dim sSID 
                    'sSID = oAccount.SID
sSID = oProfile



                    DeleteKey "HKU",sSID & "\" & sUserRegPath
                End If
            End If
        End If
    Next

    MountDefaultHive
    '''LogItem "Will now update default user hive for all users.",True,False
DeleteKey "HKU","CUSTOM\" & sUserRegPath
    ''''LogItem "Default user hive is now updated for all users.",True,False
UnmountHive
End Sub
 
Function MountHive(sHivePath)
Dim sCmd,iRetVal
sCmd = "REG.EXE LOAD HKEY_USERS\CUSTOM " & chr(34) & sHivePath & chr(34)
''''LogItem "About to run: " & sCmd,True,False
iRetVal = oShell.Run(sCmd,0,True)
    If iRetVal <> 0 Then
        MountHive = False
        ''''LogItem chr(34) & sHivePath & chr(34) & " is currently in use.",True,False
    Else
        MountHive = True
        ''''LogItem chr(34) & sHivePath & chr(34) & " is now mounted.",True,False
    End If
End Function

Sub UnmountHive
Dim sCmd
sCmd = "REG UNLOAD HKEY_USERS\CUSTOM"
Dim iRetVal
iRetVal = oShell.Run(sCmd,0,True)
    If iRetVal <> 0 Then
        ''''LogItem "Unable to unmount user hive. Exit code: " & iRetVal,True,False
        QuitScript(1603)
    Else
        '''LogItem "Unmounted user hive. Exit code: " & iRetVal,True,False
    End If
End Sub

Sub MountDefaultHive
Dim sCmd
sCmd = "REG LOAD HKEY_USERS\CUSTOM " & chr(34) & "%SYSTEMDRIVE%\Users\Default\NTUSER.DAT" & chr(34)
Dim iRetVal
iRetVal = oShell.Run(sCmd,0,True)
End Sub

Comments

  • VB script to ADD/Delete registry to ALL USERS HKCU profile during installation. - Vbscripter 4 years ago
  • Hi, is there a way to import whole reg key using the function above - crt_tweakpackage 3 weeks ago
This post is locked

Don't be a Stranger!

Sign up today to participate, stay informed, earn points and establish a reputation for yourself!

Sign up! or login

Share

 
This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ