vbscript to pre-stage a profile

Published on
10,571 Points
Last Modified:
Here is my process for pre-populating a domain profile on a desktop computer WITHOUT having the user login. This works well for those summer replacements when all the teachers are off.

Change ServerName and DomainName, DC=Domain,DC=Domain to your appropriate values or your appropriate OU.  When the user logs in they will have the same desktop folders and data as well as their bookmarks.  It will go through the initial configuring of Internet Explorer, etc., but the saved data will still be there.

User home directory is on the server, but sometimes folks save stuff to the desktop.  Prior to reimaging the machine, I copy Desktop and favorites from the user's profile.

After the script below  is run the desktop and favorites folder are copied into the user's profile folder.  To create the profile folders and grant rights to the user's AD account I run the following script:
'* Stage Profile written by Scott D 3-31-10
'* Usage: After a machine has been migrated or imaged,
'* this script creates a local profile to which saved data can be copied
'* without the user having to login first.
'* The script creates the registry entries under 
'* HKLM\Software\Microsoft\Windows NT\Current Version\ProfileGUID 
'* and HKLM\Software\Microsoft\Windows NT\Current Version\ProfileList
'* in the form of the users AD Guid and Sid
'* The script also creates the user folder under Documents and Settings.
'* The script copies SubInAcl.exe to the machine and uses it to grant the 
'* AD account full rights to the directory.
'* When run it prompts the tech for the user name to create.
'* The name must match the common name in AD user and computers
'* i.e., Smith John G. (with the period if it has it), or Jones Thadeus L

Option Explicit 

'On Error Resume Next
Dim objUser, objTrans, objOU, objRegistry, objFSO, objWShell, objExecObject
Dim arrSid, strSidHex
Dim  strUserDN, strSidDec, strSelectTemp, strKeyPath, strComputer
Dim strSamAccountName, strSubPath, strValueName, strValue, strProfileFolder
Dim strGuidPath, strGuid, strQuote, strCommand, strTemp, strProfileName

'*  Constants for the NameTranslate object. 
Const ADS_NAME_TYPE_1779 = 1 

'* Constants for Registry object
Const HKEY_LOCAL_MACHINE = &H80000002

'* Constants for file system object
Const OverwriteExisting = True

strComputer = "."
strQuote = Chr(34)

Set objRegistry=GetObject("winmgmts:\\" & _ 
    strComputer & "\root\default:StdRegProv")
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.Copyfile "\\ServerName\shared\Shared\Special Projects\1-N2M-AD MIGRATION\Files\2003tools\subinacl.exe", "c:\Windows\system32\subinacl.exe"
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
strGuidPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileGuid"

'* Get the User Common Name from the tech
strProfileName = InputBox("Enter the AD name of the profile to create (Must match name as displayed in AD Users and Computers, i.e. Smith John A. compltete with period is that is in AD users and computers:")

'* Change the line below to the appropriate school OU
strSelectTemp = "LDAP://CN=" & strProfileName & ",OU=Staff,OU=xxxxxxxx,OU=Elementary Schools,OU=Schools,DC=Domain,DC=Domain"

WScript.Echo strSelectTemp
'* Bind to the OU object
Set objUser=GetObject(strSelectTemp)
If Err.Number <> 0 Then
	WScript.Echo "The connect to container error was " & Err.Description
End If	
WScript.Echo "The user distinguished name is " & objUser.distinguishedName

	'* Retrieve the user's SID and convert to hex string, then to decimal string. 
	arrSid = objUser.objectSid 
	strSidHex = OctetToHexStr(arrSid) 
	Wscript.Echo "StrSidHex is " & strSidHex 
	strSidDec = HexStrToDecStr(strSidHex) 
	Wscript.Echo "StrSidDec is " & strSidDec 
	WScript.Echo "The samAccountName is " & objUser.samAccountName 
	strSamAccountName = objUser.samAccountName 
	WScript.Echo "The distinguishedName is " & objUser.distinguishedName
	'* Create registry entries for Profile
	strProfileFolder = "C:\Documents and Settings\" & strSamAccountName
	strValueName = "ProfileImagePath"
	strValue = "%systemDrive%\Documents and Settings\" & strSamAccountName
    strSubPath = strKeyPath & "\" & strSidDec
    '* Create the Profile Registry key with the object's SID.
    objRegistry.CreateKey HKEY_LOCAL_MACHINE, strSubPath
    '* Set the ProfileImage key with the users profile folder path
    objRegistry.SetExpandedStringValue HKEY_LOCAL_MACHINE, _ 
    	strSubPath, strValueName, strValue
    '* Create the profile's SID key
    strValueName = "SID"
    objRegistry.SetBinaryValue HKEY_LOCAL_MACHINE, strSubPath, strValueName, arrSid
    '* Create the profile folder
    If Not (objFSO.FolderExists (strProfileFolder)) Then
    End If	
    '* subinacl.exe is used to grant the User full rights to the home directory created above
     strCommand = "C:\windows\System32\subinacl.exe /subdirectories "  & strQuote & strProfileFolder & strQuote & " /grant=DomainName\" & _ 
     objUser.samAccountName  & "=F "
	WScript.Echo strCommand    
    Set objWShell = WScript.CreateObject("WScript.Shell")
    Set objExecObject = objWShell.Exec(strCommand) 
    Do While objExecObject.Status <> 1
         WScript.Sleep 100
    strTemp = objExecObject.StdOut.ReadAll() & objExecObject.StdErr.ReadAll()
    WScript.Echo"The results of SubInACL.exe are " & strTemp     
    '* Get the user objects Guid
	strGuid = objUser.GUID
	WScript.Echo "The GUID is " & strGuid
	'* Add Curly braces
	StrGuid = "{" & strGuid & "}"
	WScript.Echo "The strGuid is now " & strGuid
	strValueName = "Guid"
	'* Create Guid registry Value	
   	objRegistry.SetStringValue HKEY_LOCAL_MACHINE, _ 
   		strSubPath, strValueName, strGuid	

	strValueName = "CentralProfile"
	objRegistry.SetStringValue HKEY_LOCAL_MACHINE, _ 
   		strSubPath, strValueName, ""	
   	strValueName = "Flags"
	objRegistry.SetDWordValue HKEY_LOCAL_MACHINE, _ 
   		strSubPath, strValueName, "1"
   	strValueName = "State"
	objRegistry.SetDWordValue HKEY_LOCAL_MACHINE, _ 
   		strSubPath, strValueName, "0"
	strSubPath = strGuidPath &  "\" & strGuid
	WScript.Echo " The strGuidPath is " & strSubPath
	'* Create the key for Profile Guid
    objRegistry.CreateKey HKEY_LOCAL_MACHINE, strSubPath	
    objRegistry.SetStringValue HKEY_LOCAL_MACHINE, strGuidPath, strValueName, strValue
' Use the NameTranslate object to convert objectSid to 
' Distinguished Name. 
'Set objTrans = CreateObject("NameTranslate") 
' Initialize NameTranslate by locating the Global Catalog. 
'objTrans.Init ADS_NAME_INITTYPE_GC, "" 
' Use the Set method to specify the SID format of the object name. 
' Use the Get method to retrieve the Distinguished Name of the user object. 
' strUserDN = objTrans.Get(ADS_NAME_TYPE_1779) 
'* Wscript.Echo "The value of strUserDN is " & strUserDN 

'* Function to convert OctetString (byte array) to Hex string. 
Function OctetToHexStr(arrbytOctet) 

Dim k 
OctetToHexStr = "" 
For k = 1 To Lenb(arrbytOctet) 
OctetToHexStr = OctetToHexStr _ 
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2) 
End Function 

'* Function to convert hex Sid to decimal (SDDL) Sid. 
Function HexStrToDecStr(strSid) 

Dim arrbytSid, lngTemp, j 
ReDim arrbytSid(Len(strSid)/2 - 1) 
For j = 0 To UBound(arrbytSid) 
	arrbytSid(j) = CInt("&H" & Mid(strSid, 2*j + 1, 2)) 
HexStrToDecStr = "S-" & arrbytSid(0) & "-" _ 
& arrbytSid(1) & "-" & arrbytSid(8) 
lngTemp = arrbytSid(15) 
lngTemp = lngTemp * 256 + arrbytSid(14) 
lngTemp = lngTemp * 256 + arrbytSid(13) 
lngTemp = lngTemp * 256 + arrbytSid(12) 
HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp) 
lngTemp = arrbytSid(19) 
lngTemp = lngTemp * 256 + arrbytSid(18) 
lngTemp = lngTemp * 256 + arrbytSid(17) 
lngTemp = lngTemp * 256 + arrbytSid(16) 
HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp) 
lngTemp = arrbytSid(23) 
lngTemp = lngTemp * 256 + arrbytSid(22) 
lngTemp = lngTemp * 256 + arrbytSid(21) 
lngTemp = lngTemp * 256 + arrbytSid(20) 
HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp) 
lngTemp = arrbytSid(25) 
lngTemp = lngTemp * 256 + arrbytSid(24) 
HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp) 
End Function 

Open in new window


Author Comment

Every thing that is preceded by a '* is a comment.  I thought the comments at the top explained it very well.  Feel free to delete it.  I just thought that someone searching for pre stage a profile might find it use full.  I found numerous people  looking for an answer, but never actually found one, so I thought I would post it here.  With all the code comments, it is assumed a vbscripter would be able to customize it.

Expert Comment

I tried your script but did not have any luck. I got "...no domain available...." message after running your script and when I tried to logon.
I am providing user's logon name as input to the script. The script finds the user account in AD, creates the profile folder and all the registry values properly except HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\S-1-x-xx-yyyyyyyyy-zzzzzzzzzz-xxxxxxxxxx-zzzzz\Guid. The HexToDecStr function is not properly converting the GUID value. So instead of {xxxxxxxx-zzzzz-yyyy-xxxx-zzzzzzzzzzzz} format I am seeing {xxxxxxxxzzzzzyyyyxxxxzzzzzzzzzzzz} and the left side of xx & zz string set are not correct, and the reason why I am saying that is because I did a GUID comparison for the same domain user on two different PCs, one where I ran this script and the other where I actually logged on using that same domain user account.
Any ideas on how to fix this?

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Join & Write a Comment

Attackers love to prey on accounts that have privileges. Reducing privileged accounts and protecting privileged accounts therefore is paramount. Users, groups, and service accounts need to be protected to help protect the entire Active Directory …
This video shows how to use Hyena, from SystemTools Software, to update 100 user accounts from an external text file. View in 1080p for best video quality.

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month