Roberto Alves

Scripting and server based computing

.VBS to search non-auto created printers on profiles

I made little modifications on this script created by Jakob Heidelberg to search for printers manually created on user profiles. This is very usefull when you wanna ensure that eveybody has only auto created printers, from Citrix or ThinPrint.

This script load ntuser.dat on each profile, check some registry keys, write a log and unload ntuser.dat. Some users can have problems to load their profiles if you use this script on the same time that they try logon.

‘ ——————————————— ‘
‘ —– By Jakob H. Heidelberg 09-05-2007 —– ‘
‘ —– – - – - – - – - – - – - – - – - – —– ‘
‘ —–      Registry Profile Cleanup     —– ‘
‘ —–           Developed for:          —– ‘
‘ —–       www.windowsecurity.com      —– ‘
‘ —– – - – - – - – - – - – - – - – - – —– ‘
‘ —–           version 1.0            —– ‘
‘ —–    Last rev. date: 10-07-2007     —– ‘
‘ ——————————————— ‘
‘ changes:
‘———
’1.0 Basic functionality:
‘    a) Browse all profiles on local computer by use of the registry
‘    b) Ignores built-in OS profiles, including local administrator account
‘    c) Loads the registry Hive from ntuser.dat files of all local user profiles (that are not loaded)
‘    d) Deletes a registry key, including all sub-keys, values etc. for each user profile
‘    NB! Must be run with System rights, no users should be logged on, e.g. Computer Startup script

On Error Resume Next

Dim strRun, intReturn
Dim strComputer : strComputer = “.” ‘local computer
Dim strRegistryKeyAndSubsToDelete : strRegistryKeyAndSubsToDelete = “SoftwareWindowsecurity.com”
Dim strRegistryKeyToDelete : strRegistryKeyToDelete = “SoftwareMicrosoftWindowsCurrentVersionRun”
Dim strKeyNameToDelete : strKeyNameToDelete = “VirusExecutable”
Dim objFSO : Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Dim oShell : Set oShell = WScript.CreateObject(“WScript.Shell”)
Dim arrProfilePaths(200)
‘: arrProfilePaths = Split(GetUserProfileDirsFromRegistry(strComputer),”|”)
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Const HKEY_USERS = &H80000003

Set profs = objFSO.OpenTextFile(“profs.txt”, 1)
i=0
Do Until profs.AtEndOfStream
arrProfilePaths(i) = “W:” & trim(profs.Readline)
i=i+1
Loop

Set objResult = objFSO.OpenTextFile(“result.txt”, 2)

Dim strNTUserDatPath, i
For i = 0 To UBound(arrProfilePaths)
strNTUserDatPath = arrProfilePaths(i) & “” & “ntuser.dat”
If objFSO.FileExists(strNTUserDatPath) = True Then
‘LOAD the HIVE from the current ntuser.dat file into “TmpLoadHive”
strRun = “REG.EXE load HKUTmpLoadHive ” & Chr(34) & strNTUserDatPath & Chr(34)
intReturn = oShell.Run(strRun, 0, True)
‘DELETE the key and subkeys in the TmpLoadHive
‘DeleteKeyAndSubsFromTmpLoadHive “TmpLoadHive” & strRegistryKeyAndSubsToDelete
‘DELETE a single registry value in the TmpLoadHive
‘DeleteSingleValueFromTmpLoadHive “TmpLoadHive” & strRegistryKeyToDelete, strKeyNameToDelete
‘UNLOAD “TmpLoadHive” from memory

Dim arrSubkeys, strSubkey
Dim strKeyPath : strKeyPath = Trim(KeyPath)
Dim objRegistry : Set objRegistry = GetObject(“Winmgmts:\.RootDefault:StdRegProv”)
‘objRegistry.EnumValues HKEY_USERS, “TmpLoadHivePrintersConnections”, values

objregistry.EnumKey HKEY_USERS, “TmpLoadHivePrintersConnections”, arrSubKeys

For Each subkey In arrSubKeys
If trim(subkey)<>”" then objResult.WriteLine arrProfilePaths(i) & ” Printer: ” & subkey
Next

‘For x=0 To UBound(Values)
‘   objResult.WriteLine “Value Name: ” & values(x)

‘Next

strRun = “REG.EXE unload HKUTmpLoadHive”
intReturn = oShell.Run(strRun, 0, True)
Else
‘In this case the ntuser.dat file can not be found
‘The script will cycle to the next profile…
End If
Next

objresult.writeline “Profiles reviewed: ” & UBound(arrProfilePaths)
objresult.close
Set oShell = Nothing
Set objFSO = Nothing

msgbox “Done!”

Function GetUserProfileDirsFromRegistry(strComputer)
‘ Author  : Jakob H. Heidelberg
‘ Version : 1.1
‘ Usage   : arrProfilePaths = Split(GetUserProfileDirsFromRegistry(strComputer),”|”)
‘ Returns : Text string of user profiles on the addressed computer, separated by PIPE char (“|”).
‘           Excludes profiles of the System, LocalService, NetworkService and the Local Administrator account
‘  On Error Resume Next
Const HKEY_LOCAL_MACHINE = &H80000002
Dim strReturn, arrSubkeys
Dim objRegistry : Set objRegistry = GetObject(“winmgmts:\” & strComputer & “rootdefault:StdRegProv”)
Dim strKeyPath : strKeyPath = “SOFTWAREMicrosoftWindows NTCurrentVersionProfileList”
Dim strValueName : strValueName = “ProfileImagePath”
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each objSubkey In arrSubkeys
strSubPath = strKeyPath & “” & objSubkey
If objSubkey = “S-1-5-18″ Then
‘ This is the System profile/SID – leave alone!
ElseIf objSubkey = “S-1-5-19″ Then
‘ This is the LocalService profile/SID – leave alone!
ElseIf objSubkey = “S-1-5-20″ Then
‘ This is the NetworkService profile/SID – leave alone!
ElseIf Left(objSubkey,9) = “S-1-5-21-” And Right(objSubkey,4) = “-500″ Then
‘ This is the builtin Administrator account profile/SID – leave alone!
‘ If you want to hit the Local Admin also, just comment the above ElseIf Statement
Else
‘ This must be a “normal” users profile/SID
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE, strSubPath, strValueName, strValue
strReturn = strReturn & strValue & “|” ‘Set PIPE char for SPLIT
End If
Next
Set objRegistry = Nothing
strReturn = Left(strReturn,Len(strReturn)-1) ‘Get rid of the last PIPE char (|)
GetUserProfileDirsFromRegistry = strReturn ‘Return value of function
End Function

Sub DeleteKeyAndSubsFromTmpLoadHive(KeyPath)
‘ Author  : Jakob H. Heidelberg
‘ Version : 1.2
‘  On Error Resume Next
Const HKEY_USERS = &H80000003
Dim arrSubkeys, strSubkey
Dim strKeyPath : strKeyPath = Trim(KeyPath)
Dim objRegistry : Set objRegistry = GetObject(“Winmgmts:\.RootDefault:StdRegProv”)
objRegistry.EnumKey HKEY_USERS, strKeyPath, arrSubkeys
If IsArray(arrSubkeys) Then
For Each strSubkey In arrSubkeys
DeleteKeyAndSubsFromTmpLoadHive strKeyPath & “” & strSubkey
Next
End If
objRegistry.DeleteKey HKEY_USERS, strKeyPath
Set objRegistry = Nothing
End Sub

Sub DeleteSingleValueFromTmpLoadHive(KeyPath,KeyName)
‘ Author  : Jakob H. Heidelberg
‘ Version : 1.0
‘  On Error Resume Next
Const HKEY_USERS = &H80000003
Dim strKeyPath : strKeyPath = Trim(KeyPath)
Dim objRegistry : Set objRegistry = GetObject(“Winmgmts:\.RootDefault:StdRegProv”)
objRegistry.DeleteValue HKEY_USERS, KeyPath, KeyName
Set objRegistry = Nothing
End Sub

Category: Scripts

Your email address will not be published. Required fields are marked *

*