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