' --------------------------------------------- '
' ----- 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 = "\Software\Windowsecurity.com"
Dim strRegistryKeyToDelete : strRegistryKeyToDelete = "\Software\Microsoft\Windows\CurrentVersion\Run"
Dim strKeyNameToDelete : strKeyNameToDelete = "VirusExecutable"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim oShell : Set oShell = WScript.CreateObject("WScript.Shell")
Dim arrProfilePaths : arrProfilePaths = Split(GetUserProfileDirsFromRegistry(strComputer),"|")

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 HKU\TmpLoadHive " & 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
        strRun = "REG.EXE unload HKU\TmpLoadHive"
        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
Set oShell = Nothing
Set objFSO = Nothing

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 & "\root\default:StdRegProv")
  Dim strKeyPath : strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
  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:\\.\Root\Default: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:\\.\Root\Default:StdRegProv")
  objRegistry.DeleteValue HKEY_USERS, KeyPath, KeyName
  Set objRegistry = Nothing
End Sub