Here's what I put together for creating and renaming our users. It does the following:
- Creates home drives in two different locations based on the first letter of the SamAccountName (A-L and M-Z). It creates the folders and handles the permissions (so our helpdesk doesn't have to be admin on the home drive server to help with home drives and profiles),
- Creates Terminal Server Roaming Profile folder
- Renames both folders if the user is renamed
- Deletes those same folders when the user is deleted.
You'll need to update the "constants" section to reflect your domain and server name.
Note: This code require that XCACLS.VBS be put into the C:\Windows\System32 folder on the Active Roles Administration Service hosts to take care of the permissions. This is a free download from Microsoft's site (don't use the old xcacls.exe).
Note This code may use functions from the Active Roles Script Policy Best Practices. Please, follow the link to obtain instructions and code for those functions.
SCRIPT
'*********************************************************************************
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
' WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
' IF YOU WANT THIS FUNCTIONALITY TO BE CONDITIONALLY SUPPORTED,
' PLEASE CONTACT ONE IDENTITY PROFESSIONAL SERVICES.
'*********************************************************************************
**********************************
'* This is provided AS-IS.
'*
'* Version 3.3
'*
'* Things Left to Do
'*
'* Done - Set user Home Drive setting during creation
'* Done - Change user Home Drive setting during rename
'* Done - During rename, if old homefolder or ts prof doesn't exist, create it.
'* Done - Check for folder existence during PRECreate and PREModify
'* Done - Put better logic into renaming folders to compare actual user home
'* path And what it SHOULD be.
'* Done - Force UserID, UPN Prefix, and folders to be lower case.
'* Done - Bugfix: Fixed issue where during user delete, if the homefolder
'* wasn't specified, the script would bail.
'* Done - Bugfix: Fixed issue where deleting the user failed if the
'* AdminQuest didn't have permissions to the home folder or TSProfile Folder.
'* Done - Bugfix: Fixed issue where deleting folders populated with Terminal
'* Server profiles failed.
'***********************************
'******************
'Constants
'*******************
'strDomain is the Netbios name for the domain
Const strDomain=""
'strALBasePath is the share where home folders will be
'created For users With a UserID starting With A-L
Const strALBasePath=" \\\usersal$\ "
'strMZBasePath is the share where home folders will be
'created For users With a UserID starting With M-Z And anything else.
Const strMZBasePath=" \\\usersmz$\ "
'strTSProfBasePathis the share where Terminal Server Roaming Profile folders will be
'created all users connecting to Houston Citrix servers
Const strTSProfBasePath=" \\\tsprof$\ "
'*******************
Dim oFSO, wshShell, strUserID, strSkipFolderRename
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
'***********************************
'* onPreCreate -
'* Begin Event Trigger
'* Executed after the user SUBMITS,
'* but JUST prior To creation of the object.
'***********************************
Sub onPreCreate(Request)
'Only run for user accounts
If Request.Class <> "user" Then Exit Sub
Dim strInitial, strPath
'Retrieve the In-Process UserID
strUserID=lcase(Request.get("samaccountname"))
'Check if it's an A-L or M-Z user account
Select Case lcase(Left(strUserID,1))
Case "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l"
'It's A-L. Create the path that will be the user's home folder.
strPath = strALBasePath & strUserID
' fCreateFolder strPath
Case "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"
strPath = strMZBasePath & strUserID
' fCreateFolder strPath
Case Else
strPath = strMZBasePath & strUserID & "."
' fCreateFolder strPath
End Select
'Before we get too far, let's double check that the folder situation is OK...
'First check to make sure there isn't already a home folder in that spot...
If oFSO.FolderExists(strPath) Then
'Folder already exists. Error out.
Err.raise 1, vbcrlf & vbcrlf & "Cannot create home folder", vbcrlf & vbcrlf & _
"The following folder already exists and cannot be created: " & _
vbcrlf & strPath & vbcrlf & vbcrlf & "Please Rectify this before trying again." & vbcrlf
Else
strHomePath = strPath
End If
'Figure out what the TSProfile Path will be...
strPath = strTSProfBasePath & strUserID & "."
'let's check to make sure there isn't already a TSProfile folder in that spot...
If oFSO.FolderExists(strPath) Then
'Folder already exists. Error out.
Err.raise 1, vbcrlf & vbcrlf & "Cannot create Terminal Server Profile folder", vbcrlf & vbcrlf & _
"The following folder already exists and cannot be created: " & _
vbcrlf & strPath & vbcrlf & vbcrlf & "Please Rectify this before trying again." & vbcrlf
End If
'If we get this far, go ahead and stage the user attributes
'for the home drive And path. This will be committed during user creation...
strPath = strHomePath
Request.put "samaccountname", strUserID
Request.put "edsaUPNPrefix", strUserID
Request.put "homeDrive", "V:"
Request.put "homeDirectory", strPath
End Sub
'***********************************
'* End Event Trigger
'***********************************
'***********************************
'* onPostCreate
'* Begin Event Trigger
'* but JUST AFTER creation of the object.
'***********************************
Sub onPostCreate(Request)
'force domain replication
'fReplicateDomain
'Only run for user accounts
If Request.Class <> "user" Then Exit Sub
Dim wshShell, strInitial, strPath
'Wait for any user creations to replicate intra site before creating assigning permissions
sleep 8000
'Retrieve the userID from the newly created In-Process user account...
strUserID=lcase(Request.get("samaccountname"))
'Check if it's an A-L or M-Z user account
Select Case lcase(Left(strUserID,1))
Case "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l"
'It's A-L. Create the path that will be the user's home folder.
strPath = strALBasePath & strUserID
Case "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"
'It's M-Z. Create the path that will be the user's home folder.
strPath = strMZBasePath & strUserID
Case Else
'It's not a letter. Lump it with the M-Zs. Create the path that will be the user's home folder.
strPath = strMZBasePath & strUserID
End Select
'Create the Home folder.
fCreateFolder strPath
'Grand rights to the Home folder for the In-Process user.
fGrantRights strPath, strUserID
'OK, let's get that TSProfile knocked out...
strPath = strTSProfBasePath & strUserID & "."
'Create the TSProfile folder
fCreateFolder strPath
'Grand rights to the folder for the In-Process user.
fGrantRights strPath, strUserID
End Sub
'***********************************
'* End Event Trigger
'***********************************
'***********************************
'* onPreModify
'* Begin Event Trigger
'* Executed after the user SUBMITS,
'* but JUST prior To modification of the object.
'*
'* Checks pre-reqs for renaming Home Drive and TS Profile
'* Changes Home Drive Attribute to point to new setting
'*
'***********************************
Sub onPreModify(Request)
'Only run for user accounts
If Request.Class <> "user" Then
Exit Sub
End If
Dim strPath,strUserParentPath, oUser, strNewUserID, strOldUserID, strCalcOldPath
'Check to make sure the userID is actually changing. If it isn't changing, bail out of this module.
'Determine new UserID
strNewUserID=Request.get("samaccountname")
If strNewUserID = "" Then
strSkipFolderRename = "true"
Exit Sub
End If
'Retrieve the old UserID
Set oUser = GetObject(Request.ADsPath)
oUser.GetInfo
strOldUserID=oUser.Get("samaccountname")
'Just in case the user changes the user name and changes it back, test
'to make sure the old and new username are different before launching into renaming.
If strOldUserID = strNewUserID Then
'The literal UserID text string has NOT changed (even in regards to case)
strSkipFolderRename = "true"
Exit Sub
Else
'Test for case changes only
If lcase(strOldUserID) = lcase(strNewUserID) Then
'If we got here, only the Upper and Lower Case has changed.
'Force it back To Lower Case And skip renaming folders.
strSkipFolderRename = "true"
Request.put "samaccountname", lcase(strNewUserID)
Request.put "edsaUPNPrefix", lcase(strNewUserID)
Exit Sub
Else
'If we have gotten this far, we have an actual userID change. Proceed with pre-processing folders
strSkipFolderRename = "false"
strNewUserID = lcase(strNewUserID)
End If
End If
'Do PreProcessing on Terminal server Roaming Profile Folder
'Construct old and new path for TS Profile
strOldPath = strTSProfBasePath & strOldUserID & "."
strNewPath = strTSProfBasePath & strNewUserID & "."
'If old folder exists, and the new one doesn't exist, proceed with renaming.
If Not oFSO.FolderExists(strNewPath) Then
'New Path doesn't exist yet, so all is good - do nothing for now.
Else
'New Path already exists, so error out.
err.raise 1, vbcrlf & vbcrlf & "Unable to rename Folder.", vbcrlf & vbcrlf & """" & _
strOldPath & """" & vbcrlf & "cannot be renamed to " & vbcrlf & """" & _
strNewPath & """" & vbcrlf & "as the new folder already exists. " & _
"Please rectify this before trying again."
End If
'Do PreProcessing on Home Folder
'Retrieve the user's configured home path....
strOldPath=oUser.Get("homeDirectory")
'If the home folder exist where specified, rename the folder.
'If it DOESN'T exist, don't mess around. Skip To creating it In the CORRECT spot.
If oFSO.FolderExists(strOldPath) Then
' 'Test for folder existence for renaming reasons...
' 'Test to see one of the following conditions exists:
' '1) New exists already = Error out
' '2) Otherwise = OK to proceed
strHomeParentPath = Left(strOldPath, InStrRev(strOldPath, "\"))
strNewPath = strHomeParentPath & strNewUserID
If oFSO.FolderExists(strNewPath) Then
'The new folder already exists, so generate an error.
err.raise 1, vbcrlf & vbcrlf & "Unable to rename Folder.", vbcrlf & vbcrlf & """" & _
strOldPath & """" & vbcrlf & "cannot be renamed to " & vbcrlf & """" & strNewPath & """" & _
vbcrlf & "as the new folder already exists. " & "Please rectify this before trying again."
End If
'Rename the Home folder.
fRenameFolder strOldPath, strNewPath
Else
'Figure out what the home folder SHOULD be ideally...
Select Case lcase(Left(strNewUserID,1))
Case "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l"
strNewPath = strALBasePath & strNewUserID
Case "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"
strNewPath = strMZBasePath & strNewUserID
Case Else
strNewPath = strMZBasePath & strNewUserID
End Select
'...and create that folder.
fCreateFolder strNewPath
'Grand rights to the folder for the In-Process user.
fGrantRights strNewPath, strOldUserID
End If
'If we've made it this far without raising any errors, we can proceed with the
'renaming of the folders.
'Since it's OK to continue, go ahead and set the user attribute at this point.
Request.put "samaccountname", strNewUserID
Request.put "edsaUPNPrefix", strNewUserID
Request.put "homeDirectory", strNewPath
'Re-Construct old and new path for TS Profile
strOldPath = strTSProfBasePath & strOldUserID & "."
strNewPath = strTSProfBasePath & strNewUserID & "."
If oFSO.FolderExists(strOldPath) Then
'Rename the TSProfile folder. No changes to user account are needed for this part.
fRenameFolder strOldPath, strNewPath
Else
'The TSProfile folder doesn't exist, so just create the correct one.
fCreateFolder strNewPath
'Grand rights to the folder for the In-Process user.
fGrantRights strNewPath, strOldUserID
End If
End Sub
'***********************************
'* End Event Trigger
'***********************************
'***********************************
'* onPreRename
'* Begin Event Trigger
'* Executed after the user SUBMITS,
'* but JUST prior To modification of the object.
'* ONLY include CN related things here, as regular attributes are
'* ignored during this Sub-routine
'***********************************
Sub onPreRename(Request)
End Sub
'***********************************
'* End Event Trigger
'***********************************
'***********************************
'* onPreDelete
'* Begin Event Trigger
'* Executed after the user SUBMITS,
'* but JUST prior To deletion of the object.
'*
'***********************************
Sub onPreDelete(Request)
'Only run for user accounts
If Request.Class <> "user" Then Exit Sub
Dim oUser, strTSPath, strHomePath
'Connect to and make accessible the full user attribute set for the in-process user...
Set oUser = GetObject(Request.ADsPath)
oUser.GetInfo
'Retrieve the actual home folder for the user object...
On Error Resume Next
strHomePath = oUser.Get("homeDirectory")
On Error GoTo 0
'Generate the path that the TS Roaming Profile should be at...
strTSPath = strTSProfBasePath & oUser.Get("samaccountname") & "."
'Go ahead and delete both folders...
If strHomePath = null Or strHomePath = "" Then
'Skip the deletion of the folder.
Else
fDeleteFolder strHomePath
End If
fDeleteFolder strTSPath
End Sub
'***********************************
'* End Event Trigger
'***********************************
'***********************************
'***********************************
'***** ******
'***** Functions ******
'***** ******
'***********************************
'***********************************
'***********************************
' Funtion: fDeleteFolder
'***********************************
Function fDeleteFolder(strPath)
' delete the following 1 line after 11/1/06 if not needed
' Dim oFolder
If oFSO.FolderExists(strPath) Then
oFSO.DeleteFolder(strPath),True
Else
'Folder doesn't exist. Don't sweat it.
End If
End Function
'***********************************
' Funtion: fCreateFolder
' Creates folder at the specified path, if it doesn't already exist.
' Input: strPath - The folder path to be assigned rights
' In process "request" object taken from context
' Output: None
'***********************************
Function fCreateFolder(strPath)
Dim oNewfolder
'Check to make sure the folder doesn't already exist.
If oFSO.FolderExists(strPath) Then
'Folder already exists. Error out.
Err.raise 1, "Cannot create folder", "The following folder already exists and cannot be created: " & _
vbcrlf & vbcrlf & strPath
Else
'Folder DOESN'T already exist. Create it...
' Set oNewfolder = oFSO.CreateFolder(strPath)
oFSO.CreateFolder(strPath)
End If
End Function
'***********************************
' Funtion: fGrantRights
' Add 'Change' Permissions and permissions inheritence using xcacls.vbs Version 3
' Input: strPath - The folder path to be assigned rights
' strUserID - The username (without the domain specifier)
' to be granted modify permissions
'
' Output: None
'***********************************
Function fGrantRights(strPath,strUserID)
Dim oOctetString
Dim command_string
'use xcacls.vbs to add the user to the specified path with Change permissions.
command_string = "cscript c:\windows\system32\xcacls.vbs " & strPath & " /P " & strDomain & "\" & _
strUserID & ":M /I ENABLE"
wshShell.run command_string, 7, True
End Function
'***********************************
' Funtion: fRenameFolder
' Input: strOldPath - The folder path before the rename
' strNewPath - The folder path after the rename
' Output: None
'***********************************
Function fRenameFolder(strOldPath, strNewPath)
' err.raise 1,"strSkipFolderRename=", strSkipFolderRename
If lcase(strSkipFolderRename) = "true" Then Exit Function
'Just in case, re-verify that the target folder DOESN'T exist.
If oFSO.FolderExists(strNewPath) Then
err.raise 1, vbcrlf & vbcrlf & "Unable to rename Folder.", vbcrlf & vbcrlf & """" & _
strOldPath & """" & vbcrlf & "cannot be renamed to " & vbcrlf & """" & strNewPath & """" & _
vbcrlf & "as the new folder already exists. Please rectify this before trying again."
End If
'Check to see if the OLD folder DOES exist...
If oFSO.FolderExists(strOldPath) Then
'Old folder DOES exist (and we know from pre-processing that the target DOESN"T exist...)
' So go ahead and rename the folder.
' err.raise 1, "old,new", strOldPath & "," & strNewPath
oFSO.MoveFolder strOldPath, strNewPath
Else
'Old folder doesn't exist. (and we know from pre-processing that the target DOESN"T exist...)
' Create it In the New path instead of renaming.
Dim oNewfolder
Set oNewfolder = oFSO.CreateFolder(strNewPath)
End If
End Function
'***** END OF CODE ***************************************************************