vbscript to pre-stage a profile

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_INITTYPE_GC = 3 
                      Const ADS_NAME_TYPE_1779 = 1 
                      Const ADS_NAME_TYPE_SID_OR_SID_HISTORY_NAME = 12 
                      '* 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. 
                      'objTrans.Set ADS_NAME_TYPE_SID_OR_SID_HISTORY_NAME, strSidDec 
                      ' 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


Comments (2)


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.
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?

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.