'===========================================================================
'
' DESC: Create Computer Accounts in Active Directory based off of input questions
'		Inputs:
'		Computer Name Prefix:PCNAMEWKS
'		Starting Number:35
'		Ending Number
'
' AUTHOR: Todd Woolums (twoolums@toddwoolums.com)
' DATE Created : 05/19/2004
' DATE Modified: 05/20/2004
' VERSION: 1.0
' Version: 1.1 - Fixed Logging Bug
' Version: 1.2 - Added ability to have either 12 or 13 char prefix 
' Version: 1.3 - Added ability to enter Laptop/Desktops into different OU based off 
'		 the computer name prefix
'		 Added a DateTimestamp on the Results File.
'		 Added username who ran the script
'===========================================================================



On Error Resume Next
Set WSHShell = WScript.CreateObject("WScript.Shell")
Const ADS_UF_PASSWD_NOTREQD = &h0020
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &h1000 
Set objRootDSE = GetObject("LDAP://rootDSE") 
strDate = GetDateTimeStamp 
Dim fso, ts 
Const ForWriting = 2 
Set WshNetwork = WScript.CreateObject("WScript.Network")
strUser =  UCase(WshNetwork.UserName)
Set fso = CreateObject("Scripting.FileSystemObject")
strPath = fso.GetParentFolderName(WScript.ScriptFullName)
If fso.FileExists(strPath & "\Results.txt") Then 
Set ts = fso.OpenTextFile(strPath & "\Results_" & strDate & ".txt",ForWriting)
Else
Set ts = fso.CreateTextFile(strPath & "\Results_" & strDate & ".txt") 
End If
ts.WriteLine("--------------------------------------------------")
ts.WriteBlankLines(1)
ts.WriteLine("Started at: " & Now)
ts.WriteBlankLines(1)
ts.WriteLine("Username who ran: " & strUser)
ts.WriteBlankLines(1)
ts.WriteLine("--------------------------------------------------")
ts.WriteBlankLines(1)
Message = "Please Enter The PC Name Prefix" 
Title = "Computer Account Creation Tool"
strName = InputBox(Message,Title,"PCNAMEWKS", 100, 100) 
ts.WriteLine("PC Name Prefix: " & strName) 
Message = "Please Enter The Starting Number"
numStart = InputBox(Message,Title,"35", 100, 100) + 0 
ts.WriteLine("Starting Number: " & numStart) 
Message = "Please Enter The Ending Number"
numEnd = InputBox(Message,Title,"45", 100, 100) + 0 
ts.WriteLine("Ending Number: " & numEnd)
ts.WriteBlankLines(1)
ts.WriteLine("--------------------------------------------------")
ts.WriteBlankLines(1)
strType = Mid(strName, 10, 3)
If Ucase(strType) = "WKS" Then
Set objContainer = GetObject("LDAP://OU=Desktop, OU=Computers," & _
    objRootDSE.Get("defaultNamingContext"))
Else
Set objContainer = GetObject("LDAP://OU=Laptop, OU=Computers," & _
    objRootDSE.Get("defaultNamingContext"))
End If
While numStart <= numEnd

	If Len(strName) = 13 then
		strPCName = strName & Right("00" & numStart, 2)
	Else
		strPCName = strName & Right("000" & numStart, 3)
	End If
        ts.WriteLine("Creating: " & strPCName) 
	Set objComputer = objContainer.Create("Computer", "cn=" & strPCName)
	objComputer.Put "sAMAccountName", strPCName & "$"
	objComputer.Put "userAccountControl", _
    		ADS_UF_PASSWD_NOTREQD Or ADS_UF_WORKSTATION_TRUST_ACCOUNT
	objComputer.SetInfo

	IF Err.Number = -2147019886 then
  		ts.WriteLine("Comptuer Account is already created")
		ts.WriteBlankLines(1)
  		Err.Clear
	Else

		sUserOrGroup = "DOMAIN\Authenticated Users"
		Set secDescriptor = objComputer.Get("ntSecurityDescriptor")
		Set dACL = secDescriptor.DiscretionaryAcl
		Set ACE = CreateObject("AccessControlEntry")
		ACE.AccessMask = -1
		ACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED
		ACE.AceFlags = ADS_ACEFLAG_INHERIT_ACE
		ACE.Trustee = sUserOrGroup
		dACL.AddAce ACE
		secDescriptor.DiscretionaryAcl = dACL
		objComputer.Put "ntSecurityDescriptor", Array(secDescriptor)
		objComputer.SetInfo

		objComputer.Put "Description", "Created Date: " & Now
		objComputer.SetInfo
		ts.WriteLine(strPCName & " was created successfully") 
		ts.WriteBlankLines(1)

	End IF

	numStart = numStart + 1

WEnd
ts.WriteLine("--------------------------------------------------")
ts.WriteBlankLines(1)
ts.WriteLine("The command completed successfully.")
ts.WriteBlankLines(1)
ts.WriteLine("--------------------------------------------------")
ts.Close

Function GetDateTimeStamp
  Dim strNow
  strNow = Now()
  GetDateTimeStamp = Year(strNow) & Pad2(Month(strNow)) _
        & Pad2(Day(StrNow)) & Pad2(Hour(strNow)) _
        & Pad2(Minute(strNow)) & Pad2(Second(strNow)) End Function

Function Pad2(strIn)
  Do While Len(strIn) < 2
    strIn = "0" & strIn
  Loop
  Pad2 = strIn
End Function

MsgBox "Finished processing.  Results saved to " & strPath & "\Results_" & strDate & ".txt"