Article: 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

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 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

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

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

Comments

Posted by:

View More Blogs from Vbscripter

Related Posts

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

Comments

Posted by:

Don't be a Stranger!

View More Blogs from Vbscripter

Related Posts

Share