home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 May / W2KPRK.iso / netmgmt.cab / createusers.vbs < prev    next >
Text File  |  1999-11-04  |  30KB  |  771 lines

  1.  
  2. '********************************************************************
  3. '*
  4. '* File:        CREATEUSERS.VBS
  5. '* Created:     August 1998
  6. '* Version:     1.0
  7. '*
  8. '* Main Function: Creates multiple user accounts in a domain.
  9. '* Usage: CREATEUSERS.VBS adspath <property1:propertyvalue1 
  10. '*        [property2:propertyvalue2 [...]] | /I:inputfile> [/U:username] [/W:password] [/Q]
  11. '*
  12. '* Copyright (C) 1998 Microsoft Corporation
  13. '*
  14. '********************************************************************
  15.  
  16. OPTION EXPLICIT
  17. ON ERROR RESUME NEXT
  18.  
  19. 'Define constants
  20. CONST CONST_ERROR                       = 0
  21. CONST CONST_WSCRIPT                     = 1
  22. CONST CONST_CSCRIPT                     = 2
  23. CONST CONST_SHOW_USAGE                  = 3
  24. CONST CONST_PROCEED                     = 4
  25. CONST CONST_STRING_NOT_FOUND            = -1
  26. CONST CONST_UF_PASSWORD_CANT_CHANGE     = 64                'constants for setting user flags
  27. CONST CONST_UF_PASSWORD_CAN_CHANGE      = 131007
  28. CONST CONST_UF_DONT_EXPIRE_PASSWORD     = 65536
  29. CONST CONST_UF_DO_EXPIRE_PASSWORD       = 65535
  30.  
  31. 'Declare variables
  32. Dim strDomain, strFile, strCurrentUser, strPassword, blnQuiet, intOpMode, i
  33. Dim strArgumentArray(), strPropertyArray(), strPropertyValueArray()
  34. ReDim strArgumentArray(0), strPropertyArray(0), strPropertyValueArray(0)
  35.  
  36. 'Initialize variables
  37. intOpMode = 0
  38. blnQuiet = False
  39. strDomain = ""
  40. strFile = ""
  41. strCurrentUser = ""
  42. strPassword = ""
  43. strArgumentArray(0) = ""
  44. strPropertyArray(0) = ""
  45. strPropertyValueArray(0) = ""
  46.  
  47. 'Get the command line arguments
  48. For i = 0 to Wscript.arguments.count - 1
  49.     ReDim Preserve strArgumentArray(i)
  50.     strArgumentArray(i) = Wscript.arguments.item(i)
  51. Next
  52.  
  53. 'Check whether the script is run using CScript
  54. Select Case intChkProgram()
  55.     Case CONST_CSCRIPT
  56.         'Do Nothing
  57.     Case CONST_WSCRIPT
  58.         WScript.Echo "Please run this script using CScript." & vbCRLF & _
  59.             "This can be achieved by" & vbCRLF & _
  60.             "1. Using ""CScript CREATEUSERS.vbs arguments"" for Windows 95/98 or" & vbCRLF & _
  61.             "2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
  62.             "    using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
  63.             "    ""CREATEUSERS.vbs arguments"" for Windows NT."
  64.         WScript.Quit
  65.     Case Else
  66.         WScript.Quit
  67. End Select
  68.  
  69. 'Parse the command line
  70. intOpMode = intParseCmdLine(strArgumentArray, strDomain, strFile, strCurrentUser, _
  71.             strPassword, blnQuiet, strPropertyArray, strPropertyValueArray)
  72. If Err.Number Then
  73.     Print "Error 0X" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
  74.     If Err.Description <> "" Then
  75.         Print "Error description: " & Err.Description & "."
  76.     End If
  77.     WScript.quit
  78. End If
  79.  
  80. Select Case intOpMode
  81.     Case CONST_SHOW_USAGE
  82.         Call ShowUsage()
  83.     Case CONST_PROCEED
  84.         Print " Working ... "
  85.         Call CreateUsers(strDomain, strFile, strCurrentUser, strPassword, _
  86.              strPropertyArray, strPropertyValueArray)
  87.     Case CONST_ERROR
  88.         'Do nothing.
  89.     Case Else
  90.         Print "Error occurred in passing parameters."
  91. End Select
  92.  
  93. '********************************************************************
  94. '*
  95. '* Function intChkProgram()
  96. '* Purpose: Determines which program is used to run this script.
  97. '* Input:   None
  98. '* Output:  intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
  99. '*          and CONST_CSCRIPT.
  100. '*
  101. '********************************************************************
  102.  
  103. Private Function intChkProgram()
  104.  
  105.     ON ERROR RESUME NEXT
  106.  
  107.     Dim strFullName, strCommand, i, j
  108.  
  109.     'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
  110.     strFullName = WScript.FullName
  111.     If Err.Number then
  112.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
  113.         If Err.Description <> "" Then
  114.             Print "Error description: " & Err.Description & "."
  115.         End If
  116.         intChkProgram =  CONST_ERROR
  117.         Exit Function
  118.     End If
  119.  
  120.     i = InStr(1, strFullName, ".exe", 1)
  121.     If i = 0 Then
  122.         intChkProgram =  CONST_ERROR
  123.         Exit Function
  124.     Else
  125.         j = InStrRev(strFullName, "\", i, 1)
  126.         If j = 0 Then
  127.             intChkProgram =  CONST_ERROR
  128.             Exit Function
  129.         Else
  130.             strCommand = Mid(strFullName, j+1, i-j-1)
  131.             Select Case LCase(strCommand)
  132.                 Case "cscript"
  133.                     intChkProgram = CONST_CSCRIPT
  134.                 Case "wscript"
  135.                     intChkProgram = CONST_WSCRIPT
  136.                 Case Else       'should never happen
  137.                     Print "An unexpected program is used to run this script."
  138.                     Print "Only CScript.Exe or WScript.Exe can be used to run this script."
  139.                     intChkProgram = CONST_ERROR
  140.             End Select
  141.         End If
  142.     End If
  143.  
  144. End Function
  145.  
  146. '********************************************************************
  147. '*
  148. '* Function intParseCmdLine()
  149. '* Purpose: Parses the command line.
  150. '* Input:   strArgumentArray    an array containing input from the command line
  151. '* Output:  strDomain           the ADsPath of a user object container
  152. '*          strFile             the input file name including the path
  153. '*          strCurrentUser      the name or cn of the current user
  154. '*          strPassword         the current user password
  155. '*          blnQuiet            specifies whether to suppress messages
  156. '*          strPropertyArray        an array containing names of user properties
  157. '*          strPropertyValueArray   an array of the corresponding user properties
  158. '*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
  159. '*
  160. '********************************************************************
  161.  
  162. Private Function intParseCmdLine(strArgumentArray, strDomain, strFile, strCurrentUser, _
  163.     strPassword, blnQuiet, strPropertyArray, strPropertyValueArray)
  164.  
  165.     ON ERROR RESUME NEXT
  166.  
  167.     Dim i, j, strFlag
  168.  
  169.     strFlag = strArgumentArray(0)
  170.  
  171.     If strFlag = "" then                    'No arguments have been received
  172.         Print "Arguments are required."
  173.         intParseCmdLine = CONST_ERROR
  174.         Exit Function
  175.     End If
  176.  
  177.     'Help is needed
  178.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  179.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
  180.         intParseCmdLine = CONST_SHOW_USAGE
  181.         Exit Function
  182.     End If
  183.  
  184.     strDomain = strFlag  'The first parameter must be ADsPath of the domain.
  185.  
  186.     j = 0
  187.     For i = 1 to UBound(strArgumentArray)
  188.         strFlag = LCase(Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1))
  189.         If Err.Number Then            'An error occurs if there is no : in the string
  190.             Err.Clear
  191.             If     LCase(strArgumentArray(i)) = "/q" Then
  192.                 blnQuiet = True
  193.             Else
  194.                 Print strArgumentArray(i) & " is not recognized as a valid input."
  195.                 intParseCmdLine = CONST_ERROR
  196.                 Exit Function
  197.             End If
  198.         Else
  199.             Select Case strFlag
  200.                 Case "/i"
  201.                     strFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  202.                 Case "/u"
  203.                     strCurrentUser = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  204.                 Case "/w"
  205.                     strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  206.                 Case else
  207.                     ReDim Preserve strPropertyArray(j), strPropertyValueArray(j)
  208.                     strPropertyArray(j) = strFlag
  209.                     strPropertyValueArray(j) = Right(strArgumentArray(i), _
  210.                         Len(strArgumentArray(i))-InStr(1, strArgumentArray(i), ":"))
  211.                     If strPropertyValueArray(j) = ""  Then
  212.                         Print "Warning: property " & strFlag & " does not have a value!"
  213.                     End If
  214.                     j = j + 1
  215.             End Select
  216.         End If
  217.     Next
  218.  
  219.     If (strFile = "") and (strPropertyArray(0) = "") Then
  220.         Print "The user account name is missing."
  221.         intParseCmdLine = CONST_ERROR
  222.         Exit Function
  223.     End If
  224.  
  225.     intParseCmdLine = CONST_PROCEED
  226.  
  227. End Function
  228.  
  229. '********************************************************************
  230. '*
  231. '* Sub ShowUsage()
  232. '* Purpose: Shows the correct usage to the user.
  233. '* Input:   None
  234. '* Output:  Help messages are displayed on screen.
  235. '*
  236. '********************************************************************
  237.  
  238. Private Sub ShowUsage()
  239.  
  240.     Wscript.echo " "
  241.     Wscript.echo "Creates multiple user accounts in a domain." & vbCRLF
  242.     Wscript.echo "CREATEUSERS.VBS adspath <property1:propertyvalue1"
  243.     Wscript.echo "   [property2:propertyvalue2 [...]] | /I:inputfile>"
  244.     Wscript.echo "   [/U:username] [/W:password] [/Q]"
  245.     Wscript.echo "   /I, /U, /W"
  246.     Wscript.Echo "                 Parameter specifiers."
  247.     Wscript.echo "   adspath       ADsPath of a user object container."
  248.     Wscript.echo "   inputfile     A text file with each line in the following format:"
  249.     Wscript.echo "                 property1:propertyvalue1 property2:propertyvalue2..."
  250.     Wscript.echo "   username      Username of the current user."
  251.     Wscript.echo "   password      Password of the current user."
  252.     Wscript.echo "   property[i], propertyvalue[i]"
  253.     Wscript.echo "                 Name and value of a user property."
  254.     Wscript.echo "   /Q            Suppresses all output messages." & vbCRLF
  255.     Wscript.Echo "EXAMPLE:"
  256.     Wscript.echo "CREATEUSERS.VBS WinNT://FooFoo name:jsmith"
  257.     Wscript.echo "   fullname:""James Smith"" password:NewPassword"
  258.     Wscript.echo "   creates user jsmith with fullname James Smith in FooFoo." & vbCRLF
  259.     Wscript.Echo "NOTES:"
  260.     Wscript.echo "1. Password is required for every new user."
  261.     Wscript.echo "2. Enclose any strings with empty spaces in double quotes."
  262.  
  263. End Sub
  264.  
  265. '********************************************************************
  266. '*
  267. '* Sub CreateUsers()
  268. '* Purpose: Creates one or more users in a domain.
  269. '* Input:   strDomain           the ADsPath of a user object container
  270. '*          strFile             the input file name including the path
  271. '*          strCurrentUser      the name or cn of the current user
  272. '*          strPassword         the current user password
  273. '*          blnQuiet            specifies whether to suppress messages
  274. '*          strPropertyArray    an array containing names of user properties
  275. '*          strPropertyValueArray    an array of the corresponding user properties
  276. '* Output:  None
  277. '*
  278. '********************************************************************
  279.  
  280. Private Sub CreateUsers(strDomain, strFile, strCurrentUser, strPassword, _
  281.     strPropertyArray, strPropertyValueArray)
  282.  
  283.     ON ERROR RESUME NEXT
  284.  
  285.     Dim strProvider, objProvider, objDomain, i, objFileSystem, objInputFile, strInput
  286.  
  287.     'Check the provider passed
  288.     strProvider = Left(strDomain, InStr(1, strDomain, ":")-1)
  289.     If Err.Number Then                'This ocurrs when there is no : in the string
  290.         Print "The ADsPath " & strDomain & " of the container object is incorrect!"
  291.         Err.Clear
  292.         Exit Sub
  293.     End If
  294.     If (strProvider <> "WinNT") And (strProvider <> "LDAP") Then
  295.         Print "The provider " & strProvider & " is not supported."
  296.         Exit Sub
  297.     End If
  298.  
  299.     Print "Getting domain " & strDomain & "..."
  300.     'objDomain is created here so it would be faster to create multiple users.
  301.     If strCurrentUser = "" Then            'no user credential is passed
  302.         Set objDomain = GetObject(strDomain)
  303.     Else
  304.         Set objProvider = GetObject(strProvider & ":")
  305.         'Use user authentication
  306.         Set objDomain = objProvider.OpenDsObject(strDomain, strCurrentUser, strPassword, 1)
  307.     End If
  308.     If Err.Number then
  309.         If CStr(Hex(Err.Number)) = "80070035" Then
  310.             Print "Object " & strDomain & " is not found."
  311.         Else
  312.             Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " _
  313.                 & strDomain & "."
  314.             If Err.Description <> "" Then
  315.                 Print "Error description: " & Err.Description & "."
  316.             End If
  317.         End If
  318.         Err.Clear
  319.         Exit Sub
  320.     End If
  321.  
  322.     'Use arguments passed from the command line.
  323.     If strPropertyArray(0) <> "" Then
  324.         Call blnCreateOneUser(objDomain, strProvider, strPropertyArray, strPropertyValueArray)
  325.     End If
  326.  
  327.     'Use arguments passed from the file.
  328.     If strFile <> "" Then
  329.  
  330.         'Create a filesystem object
  331.         set objFileSystem = CreateObject("Scripting.FileSystemObject")
  332.         If Err.Number Then
  333.             Print "Error 0X" & CStr(Hex(Err.Number)) & _
  334.                 " occurred in creating a filesystem object."
  335.             If Err.Description <> "" Then
  336.                 Print "Error description: " & Err.Description & "."
  337.             End If
  338.             Exit Sub
  339.         End If
  340.  
  341.         'Opens the input file
  342.         set objInputFile = objFileSystem.OpenTextFile(strFile)
  343.         If Err.Number Then
  344.             Print "Error 0X" & CStr(Hex(Err.Number)) & " occurred in opening file " & strFile
  345.             If Err.Description <> "" Then
  346.                 Print "Error description: " & Err.Description & "."
  347.             End If
  348.             Exit Sub
  349.         End If
  350.  
  351.         'Read the input file
  352.         i = 0
  353.         While not objInputFile.AtEndOfStream
  354.             strInput = Trim(objInputFile.ReadLine)    'Get rid of leading and trailing spaces
  355.             If Not (strInput = "") Then
  356.                 If blnParseInputFile(strInput, strPropertyArray, strPropertyValueArray) Then
  357.                     Print "Error occurred in parsing the input line " & vbCRLF _
  358.                         & "    " & strInput & "."
  359.                     Print "No user account is created."
  360.                 Else
  361.                     Call blnCreateOneUser(objDomain, strProvider, strPropertyArray, _
  362.                         strPropertyValueArray)
  363.                 End If
  364.             End If
  365.         Wend
  366.         objInputFile.Close
  367.     End If
  368.  
  369. End Sub
  370.  
  371. '********************************************************************
  372. '*
  373. '* Function blnParseInputFile()
  374. '* Purpose: Parses a line of input from the input file.
  375. '* Input:   strInput                a string to be parsed
  376. '* Output:  blnParseInputFile       is set to True if an error occurred and False otherwise
  377. '*          strPropertyArray        an array of user properties names
  378. '*          strPropertyValueArray   an array of the corresponding user properties
  379. '*
  380. '********************************************************************
  381.  
  382. Function blnParseInputFile(strInput, strPropertyArray, strPropertyValueArray)
  383.  
  384.     ON ERROR RESUME NEXT
  385.  
  386.     Dim strSpace, strQuote, strColon, i, intSpace, intQuote, intColon
  387.  
  388.     strSpace = chr(32)                'space
  389.     strQuote = chr(34)                'double quote
  390.     strColon = chr(58)                'colon
  391.     blnParseInputFile = False         'No error
  392.  
  393.     i = 0
  394.     Do While Len(strInput)        'if strInput is not empty
  395.         ReDim Preserve strPropertyArray(i), strPropertyValueArray(i)
  396.         'The property name is up to the first colon
  397.         intColon = InStr(1, strInput, strColon)
  398.         If intColon = 0 Then    'There is no colon in the input line.
  399.             blnParseInputFile = True        'This is an error
  400.             Exit Do
  401.         End If
  402.         strPropertyArray(i) = Trim(Left(strInput, intColon-1))
  403.         strInput = Trim(Right(strInput, Len(strInput)-intColon))
  404.         If InStr(1, strPropertyArray(i), strQuote) or _
  405.             InStr(1, strPropertyArray(i), strSpace)    or _
  406.             InStr(1, strPropertyArray(i), strColon) or _
  407.             strInput = "" or strPropertyArray(i) = "" Then
  408.             blnParseInputFile = True        'This is an error.
  409.             Exit Do
  410.         End If
  411.  
  412.         'If there is a quote for this property value
  413.         If Left(strInput, 1) = strQuote Then
  414.             'The property value is from the first quote to the second quote
  415.             intQuote = InStr(2, strInput, strQuote)
  416.             If intQuote = 0 Then        'There is no second quote in the string.
  417.                 blnParseInputFile = True        'This is an error
  418.                 Exit Do
  419.             End If
  420.             strPropertyValueArray(i) = Trim(Mid(strInput, 2, intQuote-2))
  421.             strInput = Trim(Right(strInput, Len(strInput)-intQuote))
  422.         Else
  423.             'If this property value does not start with a quote it must end with a space
  424.             'unless it is at the end of the input string.
  425.             intSpace = InStr(1, strInput, strSpace)
  426.             If intSpace = 0 Then        'There is no space in the string.
  427.                 'Simply assign strInput to the property value.
  428.                 strPropertyValueArray(i) = strInput
  429.                 strInput = ""            'The allows the loop to come to a stop normally.
  430.             Else
  431.                 'The property value is up to the first space
  432.                 strPropertyValueArray(i) = Left(strInput, intSpace-1)
  433.                 strInput = Trim(Right(strInput, Len(strInput)-intSpace))
  434.             End If
  435.         End If
  436.         i = i + 1
  437.     Loop
  438.  
  439. End Function
  440.  
  441. '********************************************************************
  442. '*
  443. '* Function blnCreateOneUser()
  444. '* Purpose: Creates a user with given properties.
  445. '* Input:   objDomain               a domain object
  446. '*          strProvider             an ADSI provider name
  447. '*          strPropertyArray        an array of user properties names.
  448. '*          strPropertyValueArray   an array of the corresponding user properties
  449. '* Output:  If successful blnCreateOneUser is set to True.
  450. '*          Otherwise it is set to False.
  451. '*
  452. '********************************************************************
  453.  
  454. Private Function blnCreateOneUser(objDomain, strProvider, strPropertyArray, _
  455.     strPropertyValueArray)
  456.  
  457.     ON ERROR RESUME NEXT
  458.  
  459.     Dim strUser, strSamAccountName, objUser, i, j
  460.  
  461.     blnCreateOneUser = True
  462.  
  463.     'First check for information needed to create an account
  464.     If strProvider = "WinNT" Then
  465.         strUser = strGetUser("name", strPropertyArray, strPropertyValueArray)
  466.         If strUser = "" Then
  467.             Print "The account name is not provided."
  468.             Print "No user account is created."
  469.             blnCreateOneUser = False
  470.             Exit Function
  471.         End If
  472.     Else                'must be LDAP
  473.         'Check whether samaccountname is provided
  474.         strSamAccountName = strGetUser("samaccountname", strPropertyArray, _
  475.         strPropertyValueArray)
  476.         If strSamAccountName = "" Then
  477.             Print "The samaccountname of the user is not provided."
  478.             Print "No user account is created."
  479.             blnCreateOneUser = False
  480.             Exit Function
  481.         End If
  482.         strUser = strGetUser("cn", strPropertyArray, strPropertyValueArray)
  483.         If strUser = "" Then
  484.             Print "The cn of the user is not provided."
  485.             Print "No user account is created."
  486.             blnCreateOneUser = False
  487.             Exit Function
  488.         Else
  489.             strUser = "CN=" & strUser
  490.         End If
  491.     End If
  492.  
  493.     'Check whether the password is provided
  494.     If intSearchArray("password",  strPropertyArray) = CONST_STRING_NOT_FOUND Then
  495.         Print "The password of the user is not provided."
  496.         Print "No user account is created."
  497.         blnCreateOneUser = False
  498.         Exit Function
  499.     End If
  500.  
  501.     strUser = LCase(strUser)        'make sure that the user name is lower cased
  502.  
  503.     If Err.Number Then                'clear all possible errors
  504.         Err.Clear
  505.     End If
  506.     'Check whether the user already exists
  507.     set objUser = objDomain.GetObject("user", strUser)
  508.     If Err.Number Then    'Error should occur if the user does not exist
  509.         Err.Clear
  510.     Else
  511.         Print "User " & strUser & " already exists in " & objDomain.ADsPath & "."
  512.         blnCreateOneUser = False
  513.         Exit Function
  514.     End If
  515.  
  516.     'Now create this user
  517.     Print "Creating user " & strUser
  518.     Set objUser = objDomain.Create("user", strUser)
  519.     If Err.Number Then
  520.         Print "Error 0X" & CStr(Hex(Err.Number)) & " occurred in creating user account " _
  521.             & strUser & "."
  522.         Print "Failed to create user " & strUser & "."
  523.         Err.Clear
  524.         blnCreateOneUser = False
  525.         Exit Function
  526.     Else
  527.         'Let's set additional mandatory properties before committing the creation
  528.         If strProvider = "WinNT" Then
  529.             objUser.SetInfo                'commit the changes
  530.         Else
  531.             objUser.samAccountName = strSamAccountName
  532.             objUser.SetInfo
  533.         End If
  534.         If Err.Number Then
  535.             Print "Error 0X" & CStr(Hex(Err.Number)) & " occurred in creating user " _
  536.                 & strUser & "."
  537.             If Err.Description <> "" Then
  538.                 Print "Error description: " & Err.Description & "."
  539.             End If
  540.             Err.Clear
  541.             blnCreateOneUser = False
  542.             Exit Function
  543.         End If
  544.     End If
  545.  
  546.     'Now make necessary changes to the user properties
  547.     For i = 0 To UBound(strPropertyArray)
  548.         'First let's deal with several special properties.
  549.         Select Case LCase(strPropertyArray(i))
  550.             Case "password"
  551.                 objUser.SetPassword strPropertyValueArray(i)
  552.                 'Force user to change password at next logon
  553.                 If strProvider = "WinNT" Then
  554.                     objUser.Put "PasswordExpired", CLng(1)
  555.                 Else                'must be LDAP
  556.                     objUser.put "pwdLastSet", CLng(0)
  557.                 End If
  558.             Case "passwordexpired"
  559.                 If CBool(strPropertyValueArray(i)) Then
  560.                     'do nothing here
  561.                 Else
  562.                     Print "        The password can not be set to ""expired"""
  563.                     Print "        while creating an account"
  564.                 End If
  565.             Case "accountdisabled"
  566.                 Print "        The user's account can not be set to be disabled at creation."
  567.             Case "accountexpirationdate"
  568.                 If IsDate(strPropertyValueArray(i)) Then
  569.                     If DateDiff("d", now, CDate(strPropertyValueArray(i))) < 2 Then
  570.                         Print "        Expiration date is too close."
  571.                     Else
  572.                         objUser.AccountExpirationDate = CDate(strPropertyValueArray(i))
  573.                         Print "        AccountExpirationDate = " & _
  574.                             CDate(strPropertyValueArray(i))
  575.                     End If
  576.                 Else
  577.                     Print "        Warning: " & strPropertyValueArray(i) & _
  578.                         " is not a valid date."
  579.                     Print "        The expiration date is not set."
  580.                 End If
  581.             Case "accountlockout"
  582.                 If CBool(strPropertyValueArray(i)) Then
  583.                     Print "        The user account's lockout state cannot be set to be true."
  584.                 Else
  585.                     'This is the default so nothing needs to be done
  586.                     'objUser.IsAccountLocked = False
  587.                 End If
  588.             Case "usercannotchangepassword"
  589.                 'The default is false.
  590.                 'We only need to do something if this needs to be set to true
  591.                 If strPropertyValueArray(i) Then
  592.                     Print "        " & "User must be allowed to change the password!"
  593.                 End If
  594.             Case "passwordneverexpires"
  595.                 If strPropertyValueArray(i) Then
  596.                     Print "        The password can not be set to ""never expires"""
  597.                     Print "        while creating an account"
  598.                 End If
  599.             Case "userflag"            'this must be for WinNT
  600.                     Print "        The userflag can not be changed while creating an account."
  601.             Case "useraccountcontrol"            'this must be for LDAP
  602.                     Print "        The useraccountcontrol can not be changed"
  603.                     Print "        while creating an account."
  604.             Case Else
  605.                 Print "        " & strPropertyArray(i) & " = " &  _
  606.                     CStr(strPropertyValueArray(i))
  607.                 objUser.Put strPropertyArray(i), CStr(strPropertyValueArray(i))
  608.         End Select
  609.         If Err.Number Then
  610.             Print "Error 0X" & CStr(Hex(Err.Number)) & " occurred in setting property " _
  611.                 & strPropertyArray(i) & " for user " & strUser & "."
  612.             Err.Clear
  613.         End If
  614.     Next
  615.     'Before commit the changes make sure that the user account is not disabled.
  616.     If objUser.AccountDisabled then
  617.         objUser.AccountDisabled = False
  618.     End If
  619.     objUser.SetInfo                'commit the changes
  620.     If Err.Number Then
  621.         Print "Error 0X" & CStr(Hex(Err.Number)) & _
  622.             " occurred in setting properties for user " & strUser & "."
  623.         If Err.Description <> "" Then
  624.             Print "Error description: " & Err.Description & "."
  625.         End If
  626.         Err.Clear
  627.         blnCreateOneUser = False
  628.     Else
  629.         Wscript.echo "Succeeded in creating user " & strUser & " in " & objDomain.Name & "."
  630.     End If
  631.  
  632. End Function
  633.  
  634. '********************************************************************
  635. '*
  636. '* Function strGetUser()
  637. '* Purpose: Searches for an element in strArray1 and strArray2.
  638. '* Input:   strArray1   an array of user properties names
  639. '*          strArray2   an array of the corresponding user properties
  640. '* Output:  If strTarget is found in strArray1 as element i then strGetUser is set to
  641. '*          strArray2(i) and then the i-th element of both strArray1 and strArray2 are deleted.
  642. '*          Otherwise strGetUser = "" and strArray1 and strArray2 are unchanged.
  643. '*
  644. '********************************************************************
  645.  
  646. Private Function strGetUser(ByVal strTarget, strArray1, strArray2)
  647.  
  648.     Dim i
  649.  
  650.     i = intSearchArray(strTarget, strArray1)
  651.     If i = CONST_STRING_NOT_FOUND Then
  652.         strGetUser = ""
  653.     Else
  654.         strGetUser = strArray2(i)
  655.         Call DeleteOneElement(i, strArray1)
  656.         Call DeleteOneElement(i, strArray2)
  657.     End If
  658.  
  659. End Function
  660.  
  661. '********************************************************************
  662. '*
  663. '* Sub DeleteOneElement()
  664. '* Purpose: Deletes one element from an array.
  665. '* Input:   i           the index of the element to be deleted
  666. '*          strArray    the array to work on
  667. '* Output:  strArray    the array with the i-th element deleted
  668. '*
  669. '********************************************************************
  670.  
  671. Private Sub DeleteOneElement(ByVal i, strArray)
  672.  
  673.     Dim j, intUbound
  674.  
  675.     If Not IsArray(strArray) Then
  676.         Print "Argument is not an array!"
  677.         Exit Sub
  678.     End If
  679.  
  680.     intUbound = UBound(strArray)
  681.  
  682.     If i > intUBound or i < 0 Then
  683.         Print "Array index out of range!"
  684.         Exit Sub
  685.     ElseIf i < intUBound Then
  686.         For j = i To intUBound - 1
  687.             strArray(j) = strArray(j+1)
  688.         Next
  689.         j = j - 1
  690.     Else                            'i = intUBound
  691.         If intUBound = 0 Then        'There is only one element in the array
  692.             strArray(0) = ""        'set it to empty
  693.             j = 0
  694.         Else                        'Need to delete the last element (i-th element)
  695.             j = intUBound - 1
  696.         End If
  697.     End If
  698.  
  699.     ReDim Preserve strArray(j)
  700.  
  701. End Sub
  702.  
  703. '********************************************************************
  704. '*
  705. '* Function intSearchArray()
  706. '* Purpose: Searches an array for a given string.
  707. '* Input:   strTarget       the string to look for
  708. '*          strArray        an array of strings to search against
  709. '* Output:  If a match is found intSearchArray is set to the index of the element,
  710. '*          otherwise it is set to CONST_STRING_NOT_FOUND.
  711. '*
  712. '********************************************************************
  713.  
  714. Private Function intSearchArray(ByVal strTarget, ByVal strArray)
  715.  
  716.     Dim i
  717.  
  718.     intSearchArray = CONST_STRING_NOT_FOUND
  719.  
  720.     If Not IsArray(strArray) Then
  721.         Print "Argument is not an array!"
  722.         Exit Function
  723.     End If
  724.  
  725.     strTarget = LCase(strTarget)
  726.     For i = 0 To UBound(strArray)
  727.         If LCase(strArray(i)) = strTarget Then
  728.             intSearchArray = i
  729.         End If
  730.     Next
  731.  
  732. End Function
  733.  
  734. '********************************************************************
  735. '*
  736. '* Sub Print()
  737. '* Purpose: Prints a message on screen if blnQuiet = False.
  738. '* Input:   strMessage      the string to print
  739. '* Output:  strMessage is printed on screen if blnQuiet = False.
  740. '*
  741. '********************************************************************
  742.  
  743. Sub Print(ByRef strMessage)
  744.     If Not blnQuiet then
  745.         Wscript.Echo  strMessage
  746.     End If
  747. End Sub
  748.  
  749. '********************************************************************
  750. '*                                                                  *
  751. '*                           End of File                            *
  752. '*                                                                  *
  753. '********************************************************************
  754.  
  755. '********************************************************************
  756. '*
  757. '* Procedures calling sequence: CREATEUSERS.VBS
  758. '*
  759. '*  intChkProgram
  760. '*  intParseCmdLine
  761. '*  ShowUsage
  762. '*  CreateUsers
  763. '*      blnCreateOneUser
  764. '*          strGetUser
  765. '*              intSearchArray
  766. '*              DeleteOneElement
  767. '*          intSearchArray
  768. '*      blnParseInputFile
  769. '*
  770. '********************************************************************
  771.