'Script Name 		: CreateUserAccount.vbs
'Category			: Local User Management
'Creation date 		: 1 Feb 2018
'Author 			: JWM
'Version 			: 1.0
'Execution			: cscript.exe CreateUserAccount.vbs "username=[New Username]" "password=[password]"
'Example			: cscript.exe CreateUserAccount.vbs "username=John Doe" "password=abcd"
'Description 		: This script creates single user, puts it in the local user group and assigns password from parameter
'Supported OSes		: Windows Vista, Windows 7, Windows XP, Windows Server 2003 (all), Windows Server 2008 (all)
'---------------------------------------------------

Option Explicit
'On Error Resume Next

Dim exitcode : exitcode = 0

Class ErrorHandlingClass
   Private Sub Class_Initialize()
   End Sub

   ' Class_Terminate is called whenever the progam exit including when a Err.Raise is called.
   Private Sub Class_Terminate()
      exitcode = Err.Number
      ' Exit with the appropriate code.
      WScript.Quit exitcode

   End Sub
End Class
Dim Main : Set Main = New ErrorHandlingClass

Dim objShNwk,strComputerName,objComputer,objUsr,objUser, objGrp,strFlgs,keys, options, defaults, values(2)
Dim  lstArgmnts

set lstArgmnts = WScript.Arguments

keys = Array("username", "password")
options = Array(0,0)
defaults = Array("default1", "default2")

Call extractParameters(lstArgmnts, 2, keys, options, defaults, values)
'On Error Resume Next

'RegExp to validate password with minimum length of 6 characters
dim strpassword
strpassword = (values(1))
Function CheckString(strpassword, strRegExp)
Dim re
Set re = new RegExp
re.Pattern = strRegExp
CheckString = re.Test(strpassword)
End Function

'Make sure it's in the format of 7 to 99 characters
If Not CheckString(strpassword, "^(?=.*\w).{6,99}$") then
	Call Err.Raise(1015, WScript.Scriptname, "Password does not meet the password policy requirements")
End If


'Create User '
    Set objShNwk = Wscript.CreateObject("WScript.Network")
    strComputerName = objShNwk.ComputerName
    Set objComputer = GetObject("WinNT://" & strComputerName)
    On Error Resume Next
    Set objUser = GetObject("WinNT://" & strComputerName & "/" & (values(0))& ", user")
    On Error Goto 0
    If IsObject(objUser) Then
    	Call Err.Raise(1014, WScript.Scriptname, "Username: "& (values(0)) &" already exists")
    Else
    Set objUsr = objComputer.Create("user",(values(0)) )
    objUsr.SetPassword (values(1))
    objUsr.Setinfo
    strFlgs = objUsr.get("UserFlags")
    objUsr.Put "UserFlags", strFlgs OR &H10000
    objUsr.Fullname = (values(0))
    objUsr.Description = "User Created by Script :CreateLocalAdminUserAccount.vbs"
    objUsr.Setinfo
    ' Add the user to the group
    Set objGrp = GetObject("WinNT://" & strComputerName & "/" & "Users")
    objGrp.Add(objUsr.ADsPath)

'---------------------------------------------------
'JWM Added:
    Set objLocalAdmGroup = GetObject("WinNT://" & strComputerName & "/Administrators,group")
    objLocalAdmGroup.Add(objUsr.AdsPath)
'---------------------------------------------------

	End If
'End here

'echo output
If exitcode = 0 Then
	WScript.Echo "User account " &(values(0))& " has been created successfully."
End If


Set objShNwk = Nothing
Set objComputer = Nothing
Set objUsr = Nothing
Set objGrp = Nothing
Set lstArgmnts = Nothing

'Sub to extract the command line parameters
Sub extractParameters(ByVal args, ByVal numKeys, ByVal keys, ByVal options, ByVal defaults, ByRef outVals)
   Dim i, j, inKeys(2), inVals(2), hasValue, tokenArray(2)
   Dim tokens, keyCount, arg, token, index
'Only 2 arguments allowed
   If args.Count > 2 Then
      Call Err.Raise(12003, WScript.Scriptname, "Too many arguments")
   End If
'Split arg token at "="
   keyCount = 0
   For Each arg In args
      tokens = Split(arg, "=")

      ' Convert the list to an array for access purposes
      index = 0
      For Each token In tokens
         tokenArray(index) = token
	 index = index + 1
      Next

      ' There must be two tokens (key and value) in each parameter
      If index <> 2 Then
      	  Call Err.Raise(12001, WScript.Scriptname, "Parameter format error parsing: " & arg)
      End If

      inKeys(keyCount) = tokens(0)
      inVals(keycount) = tokens(1)

      keyCount = keyCount + 1
   Next

   ' Now that we have the keys and values extracted from the parameters, match them to the
   ' the expected keys
   For i = 0 To (numKeys - 1)
      hasValue = 0
      outVals(i) = defaults(i)
      For j = 0 To keyCount
        If keys(i) = inKeys(j) Then
	    outVals(i) = inVals(j)
	    hasValue = 1
	 	End If
      Next

      ' If the parameter is not optional, has not been provided and there is no
      ' default value then this is an error (exit loop)
      If options(i) = 0 Then
	 	If hasValue = 0 Then
	    	Call Err.Raise(12002, WScript.Scriptname, "Missing required parameter: " & keys(i))
	Exit For
	 	End If
      End If

   Next

End Sub