Profile Cleanup V2

[scythe944]

This script checkes in the profile folder for foldernames
' which are not corresponding with a user in Active Directory. You will be
' asked te reset the rights on the folder who doesn't have a matching
' Username.


**Please note*** - This doesn't really remove the information about the profiles from the registry.  All it does is remove the user's folder from the "Documents and Settings" folder (and all data contained within).  I haven't tested this with Vista / 7, so be very careful about this and all scripts!

I am not responsible for any damage done by this or any other script on this site!

Code Select Expand

'============================================================================
' VBScript Source File
' NAME: Rechten Home-Directory
' AUTHOR: Ruudvdh (WASTEIL)
' WEBSITE: http://wasteil.blogspot.com
' DATE  : 05-04-2007
' COMMENT: This script checkes in the profile folder for foldernames
' which are not corresponding with a user in Active Directory. You will be
' asked te reset the rights on the folder who doesn't have a matching
' Username.
'
'============================================================================

' DECLARING VARIABLES
Option Explicit
DIM answer, commando, colProcess, collection
DIM counter1, counter2, counter3
DIM Folder, FSO
DIM intReturnValue, iReturn
DIM objCommand, objConnection, objFSO
DIM objRecordSet, objRootDSE, objShell
DIM objWMIService, objProcess
DIM processrun, rootFolder
DIM strObjectName, strComputer, strFold
DIM strRootSearch, SubFolders

' INSTANTIATING AN OBJECT
SET objFSO = CreateObject("Scripting.FileSystemObject")
SET objShell = wscript.createObject("wscript.shell")
SET objRootDSE = GetObject("LDAP://RootDSE")
SET collection = CreateObject("Scripting.Dictionary")

' ASSIGNING VALUES TO CONSTANTS
CONST strObjectType =    "user"
CONST strFile1 = "C:\Windows\system32\takeown.exe"
CONST strFile2 = "C:\Program Files\Support Tools\xcacls.exe"

' ASSIGNING VALUES TO VARIABLES
strFold = Lcase(Inputbox(Ucase("Enter path profile folder") &VbCr &VbCr _
&"Use the following style:" &VbCr _
&"D:\Profiles\","Profile Folder","D:\Profiles\"))
DIM process(2)
process(1) = "takeown.exe"
process(2) = "xcacls.exe"

strRootSearch = objRootDSE.Get("RootDomainNamingContext")
strComputer = "."
counter2 = 1
counter3 = 0

'================================SUBS=========================================
' SUB-procedure for checking folder name with user in Active Directory
SUB ADcheck()
SET objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"   
SET objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
"<LDAP://" & strRootSearch & ">;(&(objectCategory=" & strObjectType & ")" & _
"(samAccountName=" & strObjectName & "));samAccountName,distinguishedName;subtree"

SET objRecordSet = objCommand.Execute
IF objRecordset.RecordCount = 0 THEN
answer = MsgBox("Would you reset rights  and delete folder "_
&Ucase(strObjectName),4,"Reset rights and Delete Folder")
IF answer = 6 THEN
collection.Add counter2,strObjectName
counter2 = counter2 + 1
END IF
intReturnValue=0
ELSE
objRecordSet.MoveFirst
intReturnValue=1
END IF
objConnection.Close
END SUB

' SUB-procedure for checking running process
SUB processCHK()
DO
processrun = 0
SET objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
SET colProcess = objWMIService.ExecQuery ("Select * from Win32_Process")
FOR Each objProcess in colProcess
IF objProcess.Name = process(counter1) THEN
processrun = processrun + 1
END IF
NEXT
IF processrun > 0 THEN
wscript.sleep(5000)
END IF

SET objWMIService = nothing
SET colProcess = nothing
Loop Until processrun = 0
END SUB

' SUB-procedure for reading folder names
SUB strControl()
SET rootFolder = objFSO.GetFolder(strFold)
SET SubFolders = rootFolder.SubFolders
FOR Each Folder IN SubFolders
strObjectName = replace(Lcase(Folder),strFold,"")
CALL ADcheck()
NEXT
SET rootFolder = NOTHING
SET SubFolders = NOTHING
END SUB

SUB ResetRights()
counter3 = counter3 + 1
commando = "takeown /F " &strFold &collection.Item(counter2) &" /R /A /D Y"
iReturn = objShell.Run(commando)
counter1 = 1
CALL processCHK()

commando = "xcacls " &strFold &collection.Item(counter2) &" /g ""Domain Admins"":F /T /C /Y"
iReturn = objShell.Run(commando)
counter1 = 2
CALL processCHK()
objFSO.DeleteFolder strFold &collection.Item(counter2),TRUE
END SUB

'=============================END=OF=SUBS=====================================
'
'================================CODE=========================================

IF objFSO.FolderExists(strFold) THEN
IF objFSO.FileExists(strFile2) THEN
IF objFSO.FileExists(strFile1) THEN
CALL strControl()
FOR counter2 = 1 to collection.Count
CALL ResetRights()
NEXT
answer = MsgBox(counter3 &" Folders reset and deleted",0,"Finished")
ELSE
answer = MsgBox(strFile1 &" not found." &VbCr _
&"Press [YES] to open website to to download",4,strFile1 &" not found!")
IF answer = 6 THEN
iReturn = objShell.Run("http://www.petri.co.il/download_free_reskit_tools.htm")
END IF
END IF
ELSE
answer = MsgBox(strFile2 &" not found." &VbCr _
&"Press [YES] to open website to to download",4,strFile2 &" not found!")
IF answer = 6 THEN
iReturn = objShell.Run("http://support.microsoft.com/kb/892777")
END IF
END IF
ELSE
wscript.Echo "Folder: " &Ucase(strFold) &" doesn't exist." &VbCr _
&"Verify the location and try again."
END IF

SET objCommand = NOTHING
SET objConnection = NOTHING
SET objFSO = NOTHING
SET objRecordSet = NOTHING
SET objShell = NOTHING
SET rootFolder = NOTHING
SET SubFolders = NOTHING

'=============================END=OF=CODE=====================================
wscript.quit