'* 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
Err.Clear
'* 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
WScript.Echo
'* 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
objFSO.CreateFolder(strProfileFolder)
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
Loop
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
WScript.Echo
Wscript.Quit
'* 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)
Next
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))
Next
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
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.
Comments (2)
Author
Commented:Commented:
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\SOFTWAR
Any ideas on how to fix this?
thanks