On Error Resume Next
Dim WshShell, RegRoot, objFSO
Set WshShell = CreateObject("WScript.shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
'
Const DAT_NTUSER = &H70000000
Const DAT_USRCLASS = &H70000001
'==============================================
' SCRIPT BEGINS HERE
'==============================================
RegRoot = "HKLM\TEMPHIVE"
'== Loads each user's "HKCU" registry hive
Call Load_Registry_For_Each_User(DAT_NTUSER)
'== Loads each user's "HKCR" registry hive
Call Load_Registry_For_Each_User(DAT_USRCLASS)
WScript.Quit(0)
' |
' |
'====================================================================
Sub KeysToModify(sRegistryRootToUse, DAT_FILE)
'==============================================
' Change variables here, or add additional keys
'==============================================
'
On Error Resume Next
If DAT_FILE = DAT_NTUSER Then 'This is for updating HKCU keys
Dim strRegPathParent01
Dim strRegPathParent02
Dim strRegPathParent03
strRegPathParent01 = "Software\Microsoft\Active Setup\Installed Components\ETS-ENG-OneDrive-17.3.6390.0509-GBL-R1\"
strRegPathParent02 = "Software\Wow6432Node\Microsoft\Active Setup\Installed Components\ETS-ENG-OneDrive-17.3.6390.0509-GBL-R1\"
strRegPathParent03 = "Software\Microsoft\Active Setup\Installed Components\{8A69D345-D564-463c-AFF1-A69D9E530F96}\"
WshShell.regdelete sRegistryRootToUse & "\" & strRegPathParent01
WshShell.regdelete sRegistryRootToUse & "\" & strRegPathParent02
WshShell.regdelete sRegistryRootToUse & "\" & strRegPathParent03
End If
End Sub
Function GetDefaultUserPath
On Error Resume Next
Dim objRegistry
Dim strKeyPath
Dim strDefaultUser
Dim strDefaultPath
Dim strResult
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,"DefaultUserProfile",strDefaultUser
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,"ProfilesDirectory",strDefaultPath
If Len(strDefaultUser) < 1 or IsEmpty(strDefaultUser) or IsNull(strDefaultUser) Then
'must be on Vista or newer
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,"Default",strDefaultPath
strResult = strDefaultPath
Else
'must be on XP
strResult = strDefaultPath & "\" & strDefaultUser
End If
GetDefaultUserPath = strResult
End Function
Function RetrieveUsernameFromPath(sTheProfilePath)
On Error Resume Next
Dim lstPath
Dim sTmp
Dim sUsername
lstPath = Split(sTheProfilePath,"\")
For each sTmp in lstPath
sUsername = sTmp
'last split is our username
Next
RetrieveUsernameFromPath = sUsername
End Function
Sub LoadProfileHive(sProfileDatFilePath, sCurrentUser, DAT_FILE)
On Error Resume Next
Dim intResultLoad, intResultUnload, sUserSID
'Load user's HKCU into temp area under HKLM
intResultLoad = WshShell.Run("reg.exe load " & RegRoot & " " & chr(34) & sProfileDatFilePath & chr(34), 0, True)
If intResultLoad <> 0 Then
' This profile appears to already be loaded...lets update it under the HKEY_USERS hive
Dim objRegistry2, objSubKey2
Dim strKeyPath2, strValueName2, strValue2
Dim strSubPath2, arrSubKeys2
Set objRegistry2 = GetObject("winmgmts:\\.\root\default:StdRegProv")
strKeyPath2 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry2.EnumKey HKEY_LOCAL_MACHINE, strKeyPath2, arrSubkeys2
sUserSID = ""
For Each objSubkey2 In arrSubkeys2
strValueName2 = "ProfileImagePath"
strSubPath2 = strKeyPath2 & "\" & objSubkey2
objRegistry2.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath2,strValueName2,strValue2
If Right(UCase(strValue2),Len(sCurrentUser)+1) = "\" & UCase(sCurrentUser) Then
'this is the one we want
sUserSID = objSubkey2
End If
Next
If Len(sUserSID) > 1 Then
'WScript.Echo " Updating another logged-on user: " & sCurrentUser & vbCrLf
If DAT_FILE = DAT_NTUSER Then
Call KeysToModify("HKEY_USERS\" & sUserSID, DAT_FILE)
ElseIf DAT_FILE = DAT_USRCLASS Then
Call KeysToModify("HKEY_USERS\" & sUserSID & "_Classes", DAT_FILE)
End If
Else
'WScript.Echo(" *** An error occurred while loading HKCU for this user: " & sCurrentUser)
End If
Else
'WScript.Echo(" HKCU loaded for this user: " & sCurrentUser)
End If
''
If sUserSID = "" then 'check to see if we just updated this user b/c they are already logged on
Call KeysToModify(RegRoot, DAT_FILE) ' update registry settings for this selected user
End If
''
If sUserSID = "" then 'check to see if we just updated this user b/c they are already logged on
intResultUnload = WshShell.Run("reg.exe unload " & RegRoot,0, True) 'Unload HKCU from HKLM
If intResultUnload <> 0 Then
'WScript.Echo(" *** An error occurred while unloading HKCU for this user: " & sCurrentUser & vbCrLf)
Else
'WScript.Echo(" HKCU UN-loaded for this user: " & sCurrentUser & vbCrLf)
End If
End If
End Sub
Function GetUserRunningScript()
On Error Resume Next
Dim sUserRunningScript, sComputerName
sUserRunningScript = WshShell.ExpandEnvironmentStrings("%USERNAME%") 'Holds name of current logged on user running this script
sComputerName = UCase(WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%"))
If sUserRunningScript = "%USERNAME%" or sUserRunningScript = sComputerName & "$" Then
' This script might be run by the SYSTEM account or a service account
Dim sTheProfilePath
sTheProfilePath = WshShell.ExpandEnvironmentStrings("%USERPROFILE%") 'Holds name of current logged on user running this script
sUserRunningScript = RetrieveUsernameFromPath(sTheProfilePath)
End If
GetUserRunningScript = sUserRunningScript
End Function
Function RemoveTrailingPathDelimiter(sPath)
On Error Resume Next
Dim sUpdatedPath
sUpdatedPath = sPath
If Right(sUpdatedPath,1) = "\" Then
sUpdatedPath = Left(sUpdatedPath,Len(sUpdatedPath)-1)
End If
RemoveTrailingPathDelimiter = sUpdatedPath
End Function
Function GetPathToDatFileToUpdate(sProfilePath, DAT_FILE)
On Error Resume Next
Dim sDatFile, sPathToDat, sTrimmedProfilePath
Dim bFoundDatFile
sPathToDat = "" 'default
sTrimmedProfilePath = RemoveTrailingPathDelimiter(sProfilePath)
If DAT_FILE = DAT_NTUSER Then
sDatFile = "NTUSER.DAT"
If objFSO.FileExists(sTrimmedProfilePath & "\" & sDatFile) or objFSO.FileExists(chr(34) & sTrimmedProfilePath & "\" & sDatFile & chr(34)) Then
sPathToDat = sTrimmedProfilePath & "\" & sDatFile
End If
ElseIf DAT_FILE = DAT_USRCLASS Then
sDatFile = "USRCLASS.DAT"
If objFSO.FileExists(sTrimmedProfilePath & "\AppData\Local\Microsoft\Windows\" & sDatFile) OR _
objFSO.FileExists(chr(34) & sTrimmedProfilePath & "\AppData\Local\Microsoft\Windows\" & sDatFile & chr(34)) Then
sPathToDat = sTrimmedProfilePath & "\AppData\Local\Microsoft\Windows\" & sDatFile
ElseIf objFSO.FileExists(sTrimmedProfilePath & "\Local Settings\Application Data\Microsoft\Windows\" & sDatFile) OR _
objFSO.FileExists(chr(34) & sTrimmedProfilePath & "\Local Settings\Application Data\Microsoft\Windows\" & sDatFile & chr(34)) Then
sPathToDat = sTrimmedProfilePath & "\Local Settings\Application Data\Microsoft\Windows\" & sDatFile
End If
End If
GetPathToDatFileToUpdate = sPathToDat
End Function
Sub Load_Registry_For_Each_User(DAT_FILE)
On Error Resume Next
Dim sUserRunningScript
Dim objRegistry, objSubkey
Dim strKeyPath, strValueName, strValue, strSubPath, arrSubKeys
Dim sCurrentUser, sProfilePath, sNewUserProfile
Dim sPathToDatFile
sUserRunningScript = GetUserRunningScript
'WScript.Echo "Updating the logged-on user: " & sUserRunningScript & vbCrLf
''
If DAT_FILE = DAT_NTUSER Then
Call KeysToModify("HKCU", DAT_FILE) 'Update registry settings for the user running the script
ElseIf DAT_FILE = DAT_USRCLASS Then
Call KeysToModify("HKCR", DAT_FILE) 'Update registry settings for the user running the script
End If
''
sNewUserProfile = GetDefaultUserPath
sPathToDatFile = GetPathToDatFileToUpdate(sNewUserProfile, DAT_FILE)
If Len(sPathToDatFile) > 0 Then
'WScript.Echo "Updating the DEFAULT user profile which affects newly created profiles." & vbCrLf
Call LoadProfileHive(sPathToDatFile, "Default User Profile", DAT_FILE)
End If
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each objSubkey In arrSubkeys
strValueName = "ProfileImagePath"
strSubPath = strKeyPath & "\" & objSubkey
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
sProfilePath = strValue
sCurrentUser = RetrieveUsernameFromPath(strValue)
If ((UCase(sCurrentUser) <> "ALL USERS") and _
(UCase(sCurrentUser) <> UCase(sUserRunningScript)) and _
(UCase(sCurrentUser) <> "LOCALSERVICE") and _
(UCase(sCurrentUser) <> "SYSTEMPROFILE") and _
(UCase(sCurrentUser) <> "NETWORKSERVICE")) then
sPathToDatFile = GetPathToDatFileToUpdate(sProfilePath, DAT_FILE)
If Len(sPathToDatFile) > 0 Then
'WScript.Echo "Preparing to update the user: " & sCurrentUser
Call LoadProfileHive(sPathToDatFile, sCurrentUser, DAT_FILE)
End If
End If
Next
End Sub
Dim WshShell, RegRoot, objFSO
Set WshShell = CreateObject("WScript.shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
'
Const DAT_NTUSER = &H70000000
Const DAT_USRCLASS = &H70000001
'==============================================
' SCRIPT BEGINS HERE
'==============================================
RegRoot = "HKLM\TEMPHIVE"
'== Loads each user's "HKCU" registry hive
Call Load_Registry_For_Each_User(DAT_NTUSER)
'== Loads each user's "HKCR" registry hive
Call Load_Registry_For_Each_User(DAT_USRCLASS)
WScript.Quit(0)
' |
' |
'====================================================================
Sub KeysToModify(sRegistryRootToUse, DAT_FILE)
'==============================================
' Change variables here, or add additional keys
'==============================================
'
On Error Resume Next
If DAT_FILE = DAT_NTUSER Then 'This is for updating HKCU keys
Dim strRegPathParent01
Dim strRegPathParent02
Dim strRegPathParent03
strRegPathParent01 = "Software\Microsoft\Active Setup\Installed Components\ETS-ENG-OneDrive-17.3.6390.0509-GBL-R1\"
strRegPathParent02 = "Software\Wow6432Node\Microsoft\Active Setup\Installed Components\ETS-ENG-OneDrive-17.3.6390.0509-GBL-R1\"
strRegPathParent03 = "Software\Microsoft\Active Setup\Installed Components\{8A69D345-D564-463c-AFF1-A69D9E530F96}\"
WshShell.regdelete sRegistryRootToUse & "\" & strRegPathParent01
WshShell.regdelete sRegistryRootToUse & "\" & strRegPathParent02
WshShell.regdelete sRegistryRootToUse & "\" & strRegPathParent03
End If
End Sub
Function GetDefaultUserPath
On Error Resume Next
Dim objRegistry
Dim strKeyPath
Dim strDefaultUser
Dim strDefaultPath
Dim strResult
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,"DefaultUserProfile",strDefaultUser
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,"ProfilesDirectory",strDefaultPath
If Len(strDefaultUser) < 1 or IsEmpty(strDefaultUser) or IsNull(strDefaultUser) Then
'must be on Vista or newer
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,"Default",strDefaultPath
strResult = strDefaultPath
Else
'must be on XP
strResult = strDefaultPath & "\" & strDefaultUser
End If
GetDefaultUserPath = strResult
End Function
Function RetrieveUsernameFromPath(sTheProfilePath)
On Error Resume Next
Dim lstPath
Dim sTmp
Dim sUsername
lstPath = Split(sTheProfilePath,"\")
For each sTmp in lstPath
sUsername = sTmp
'last split is our username
Next
RetrieveUsernameFromPath = sUsername
End Function
Sub LoadProfileHive(sProfileDatFilePath, sCurrentUser, DAT_FILE)
On Error Resume Next
Dim intResultLoad, intResultUnload, sUserSID
'Load user's HKCU into temp area under HKLM
intResultLoad = WshShell.Run("reg.exe load " & RegRoot & " " & chr(34) & sProfileDatFilePath & chr(34), 0, True)
If intResultLoad <> 0 Then
' This profile appears to already be loaded...lets update it under the HKEY_USERS hive
Dim objRegistry2, objSubKey2
Dim strKeyPath2, strValueName2, strValue2
Dim strSubPath2, arrSubKeys2
Set objRegistry2 = GetObject("winmgmts:\\.\root\default:StdRegProv")
strKeyPath2 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry2.EnumKey HKEY_LOCAL_MACHINE, strKeyPath2, arrSubkeys2
sUserSID = ""
For Each objSubkey2 In arrSubkeys2
strValueName2 = "ProfileImagePath"
strSubPath2 = strKeyPath2 & "\" & objSubkey2
objRegistry2.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath2,strValueName2,strValue2
If Right(UCase(strValue2),Len(sCurrentUser)+1) = "\" & UCase(sCurrentUser) Then
'this is the one we want
sUserSID = objSubkey2
End If
Next
If Len(sUserSID) > 1 Then
'WScript.Echo " Updating another logged-on user: " & sCurrentUser & vbCrLf
If DAT_FILE = DAT_NTUSER Then
Call KeysToModify("HKEY_USERS\" & sUserSID, DAT_FILE)
ElseIf DAT_FILE = DAT_USRCLASS Then
Call KeysToModify("HKEY_USERS\" & sUserSID & "_Classes", DAT_FILE)
End If
Else
'WScript.Echo(" *** An error occurred while loading HKCU for this user: " & sCurrentUser)
End If
Else
'WScript.Echo(" HKCU loaded for this user: " & sCurrentUser)
End If
''
If sUserSID = "" then 'check to see if we just updated this user b/c they are already logged on
Call KeysToModify(RegRoot, DAT_FILE) ' update registry settings for this selected user
End If
''
If sUserSID = "" then 'check to see if we just updated this user b/c they are already logged on
intResultUnload = WshShell.Run("reg.exe unload " & RegRoot,0, True) 'Unload HKCU from HKLM
If intResultUnload <> 0 Then
'WScript.Echo(" *** An error occurred while unloading HKCU for this user: " & sCurrentUser & vbCrLf)
Else
'WScript.Echo(" HKCU UN-loaded for this user: " & sCurrentUser & vbCrLf)
End If
End If
End Sub
Function GetUserRunningScript()
On Error Resume Next
Dim sUserRunningScript, sComputerName
sUserRunningScript = WshShell.ExpandEnvironmentStrings("%USERNAME%") 'Holds name of current logged on user running this script
sComputerName = UCase(WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%"))
If sUserRunningScript = "%USERNAME%" or sUserRunningScript = sComputerName & "$" Then
' This script might be run by the SYSTEM account or a service account
Dim sTheProfilePath
sTheProfilePath = WshShell.ExpandEnvironmentStrings("%USERPROFILE%") 'Holds name of current logged on user running this script
sUserRunningScript = RetrieveUsernameFromPath(sTheProfilePath)
End If
GetUserRunningScript = sUserRunningScript
End Function
Function RemoveTrailingPathDelimiter(sPath)
On Error Resume Next
Dim sUpdatedPath
sUpdatedPath = sPath
If Right(sUpdatedPath,1) = "\" Then
sUpdatedPath = Left(sUpdatedPath,Len(sUpdatedPath)-1)
End If
RemoveTrailingPathDelimiter = sUpdatedPath
End Function
Function GetPathToDatFileToUpdate(sProfilePath, DAT_FILE)
On Error Resume Next
Dim sDatFile, sPathToDat, sTrimmedProfilePath
Dim bFoundDatFile
sPathToDat = "" 'default
sTrimmedProfilePath = RemoveTrailingPathDelimiter(sProfilePath)
If DAT_FILE = DAT_NTUSER Then
sDatFile = "NTUSER.DAT"
If objFSO.FileExists(sTrimmedProfilePath & "\" & sDatFile) or objFSO.FileExists(chr(34) & sTrimmedProfilePath & "\" & sDatFile & chr(34)) Then
sPathToDat = sTrimmedProfilePath & "\" & sDatFile
End If
ElseIf DAT_FILE = DAT_USRCLASS Then
sDatFile = "USRCLASS.DAT"
If objFSO.FileExists(sTrimmedProfilePath & "\AppData\Local\Microsoft\Windows\" & sDatFile) OR _
objFSO.FileExists(chr(34) & sTrimmedProfilePath & "\AppData\Local\Microsoft\Windows\" & sDatFile & chr(34)) Then
sPathToDat = sTrimmedProfilePath & "\AppData\Local\Microsoft\Windows\" & sDatFile
ElseIf objFSO.FileExists(sTrimmedProfilePath & "\Local Settings\Application Data\Microsoft\Windows\" & sDatFile) OR _
objFSO.FileExists(chr(34) & sTrimmedProfilePath & "\Local Settings\Application Data\Microsoft\Windows\" & sDatFile & chr(34)) Then
sPathToDat = sTrimmedProfilePath & "\Local Settings\Application Data\Microsoft\Windows\" & sDatFile
End If
End If
GetPathToDatFileToUpdate = sPathToDat
End Function
Sub Load_Registry_For_Each_User(DAT_FILE)
On Error Resume Next
Dim sUserRunningScript
Dim objRegistry, objSubkey
Dim strKeyPath, strValueName, strValue, strSubPath, arrSubKeys
Dim sCurrentUser, sProfilePath, sNewUserProfile
Dim sPathToDatFile
sUserRunningScript = GetUserRunningScript
'WScript.Echo "Updating the logged-on user: " & sUserRunningScript & vbCrLf
''
If DAT_FILE = DAT_NTUSER Then
Call KeysToModify("HKCU", DAT_FILE) 'Update registry settings for the user running the script
ElseIf DAT_FILE = DAT_USRCLASS Then
Call KeysToModify("HKCR", DAT_FILE) 'Update registry settings for the user running the script
End If
''
sNewUserProfile = GetDefaultUserPath
sPathToDatFile = GetPathToDatFileToUpdate(sNewUserProfile, DAT_FILE)
If Len(sPathToDatFile) > 0 Then
'WScript.Echo "Updating the DEFAULT user profile which affects newly created profiles." & vbCrLf
Call LoadProfileHive(sPathToDatFile, "Default User Profile", DAT_FILE)
End If
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each objSubkey In arrSubkeys
strValueName = "ProfileImagePath"
strSubPath = strKeyPath & "\" & objSubkey
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
sProfilePath = strValue
sCurrentUser = RetrieveUsernameFromPath(strValue)
If ((UCase(sCurrentUser) <> "ALL USERS") and _
(UCase(sCurrentUser) <> UCase(sUserRunningScript)) and _
(UCase(sCurrentUser) <> "LOCALSERVICE") and _
(UCase(sCurrentUser) <> "SYSTEMPROFILE") and _
(UCase(sCurrentUser) <> "NETWORKSERVICE")) then
sPathToDatFile = GetPathToDatFileToUpdate(sProfilePath, DAT_FILE)
If Len(sPathToDatFile) > 0 Then
'WScript.Echo "Preparing to update the user: " & sCurrentUser
Call LoadProfileHive(sPathToDatFile, sCurrentUser, DAT_FILE)
End If
End If
Next
End Sub
No comments:
Post a Comment