home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 May / W2KPRK.iso / compmgmt.cab / ListMembers.vbs < prev    next >
Text File  |  1999-11-04  |  18KB  |  490 lines
  1.  
  2. '********************************************************************
  3. '*
  4. '* File:        LISTMEMBERS.VBS
  5. '* Created:     August 1998
  6. '* Version:     1.0
  7. '*
  8. '* Main Function: Lists all members of a container or a group object.
  9. '* Usage: LISTMEMBERS.VBS adspath [/C:class] [/O:outputfile]
  10. '*        [/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.  
  26. 'Declare variables
  27. Dim strADsPath, strClass, strUserName, strPassword, strOutputFile
  28. Dim blnQuiet, i, strArgumentArray(), intOpMode
  29. ReDim strArgumentArray(0)
  30.  
  31. 'Initialize variables
  32. strArgumentArray(0) = ""
  33. blnQuiet = False
  34. strADsPath = ""
  35. strClass = ""
  36. strUserName = ""
  37. strPassword = ""
  38. strOutputFile = ""
  39.  
  40. 'Get the command line arguments
  41. For i = 0 to Wscript.arguments.count - 1
  42.     ReDim Preserve strArgumentArray(i)
  43.     strArgumentArray(i) = Wscript.arguments.item(i)
  44. Next
  45.  
  46. 'Check whether the script is run using CScript
  47. Select Case intChkProgram()
  48.     Case CONST_CSCRIPT
  49.         'Do Nothing
  50.     Case CONST_WSCRIPT
  51.         WScript.Echo "Please run this script using CScript." & vbCRLF & _
  52.             "This can be achieved by" & vbCRLF & _
  53.             "1. Using ""CScript LISTMEMBERS.vbs arguments"" for Windows 95/98 or" & vbCRLF & _
  54.             "2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
  55.             "    using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
  56.             "    ""LISTMEMBERS.vbs arguments"" for Windows NT."
  57.         WScript.Quit
  58.     Case Else
  59.         WScript.Quit
  60. End Select
  61.  
  62. 'Parse the command line
  63. intOpMode = intParseCmdLine(strArgumentArray, strADsPath, strClass, _
  64.             blnQuiet, strUserName, strPassword, strOutputFile)
  65. If Err.Number then
  66.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
  67.     If Err.Description <> "" Then
  68.         Print "Error description: " & Err.Description & "."
  69.     End If
  70.     WScript.Quit
  71. End If
  72.  
  73. Select Case intOpMode
  74.     Case CONST_SHOW_USAGE
  75.         Call ShowUsage()
  76.     Case CONST_PROCEED
  77.         Call GetMembers(strADsPath, strClass, strUserName, strPassword, strOutputFile)
  78.     Case CONST_ERROR
  79.         'Do nothing.
  80.     Case Else                    'Default -- should never happen
  81.         Print "Error occurred in passing parameters."
  82. End Select
  83.  
  84. '********************************************************************
  85. '*
  86. '* Function intChkProgram()
  87. '* Purpose: Determines which program is used to run this script.
  88. '* Input:   None
  89. '* Output:  intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
  90. '*          and CONST_CSCRIPT.
  91. '*
  92. '********************************************************************
  93.  
  94. Private Function intChkProgram()
  95.  
  96.     ON ERROR RESUME NEXT
  97.  
  98.     Dim strFullName, strCommand, i, j
  99.  
  100.     'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
  101.     strFullName = WScript.FullName
  102.     If Err.Number then
  103.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
  104.         If Err.Description <> "" Then
  105.             Print "Error description: " & Err.Description & "."
  106.         End If
  107.         intChkProgram =  CONST_ERROR
  108.         Exit Function
  109.     End If
  110.  
  111.     i = InStr(1, strFullName, ".exe", 1)
  112.     If i = 0 Then
  113.         intChkProgram =  CONST_ERROR
  114.         Exit Function
  115.     Else
  116.         j = InStrRev(strFullName, "\", i, 1)
  117.         If j = 0 Then
  118.             intChkProgram =  CONST_ERROR
  119.             Exit Function
  120.         Else
  121.             strCommand = Mid(strFullName, j+1, i-j-1)
  122.             Select Case LCase(strCommand)
  123.                 Case "cscript"
  124.                     intChkProgram = CONST_CSCRIPT
  125.                 Case "wscript"
  126.                     intChkProgram = CONST_WSCRIPT
  127.                 Case Else       'should never happen
  128.                     Print "An unexpected program is used to run this script."
  129.                     Print "Only CScript.Exe or WScript.Exe can be used to run this script."
  130.                     intChkProgram = CONST_ERROR
  131.             End Select
  132.         End If
  133.     End If
  134.  
  135. End Function
  136.  
  137. '********************************************************************
  138. '*
  139. '* Function intParseCmdLine()
  140. '* Purpose: Parses the command line.
  141. '* Input:   strArgumentArray    an array containing input from the command line
  142. '* Output:  strADsPath          ADsPath of a group or container object
  143. '*          strClass            class name of the member objects
  144. '*          strUserName         name of the current user
  145. '*          strPassword         password of the current user
  146. '*          strOutputFile       an output file name
  147. '*          blnQuiet            specifies whether to suppress messages
  148. '*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
  149. '*
  150. '********************************************************************
  151.  
  152. Private Function intParseCmdLine(strArgumentArray, strADsPath, strClass, _
  153.         blnQuiet, strUserName, strPassword, strOutputFile)
  154.  
  155.     ON ERROR RESUME NEXT
  156.  
  157.     Dim i, strFlag
  158.  
  159.     strFlag = strArgumentArray(0)
  160.  
  161.     If strFlag = "" then                'No arguments have been received
  162.         Print "Arguments are required."
  163.         intParseCmdLine = CONST_ERROR
  164.         Exit Function
  165.     End If
  166.  
  167.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  168.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
  169.         intParseCmdLine = CONST_SHOW_USAGE
  170.         Exit Function
  171.     End If
  172.  
  173.     strADsPath = strFlag    'The first parameter must be the ADsPath.
  174.  
  175.     For i = 1 to UBound(strArgumentArray)
  176.         strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)
  177.         If Err.Number Then            'An error occurs if there is no : in the string
  178.             Err.Clear
  179.             Select Case LCase(strArgumentArray(i))
  180.                 Case "/q"
  181.                     blnQuiet = True
  182.                 Case else
  183.                     Print "Invalid flag " & strArgumentArray(i) & "."
  184.                     Print "Please check the input and try again."
  185.                     intParseCmdLine = CONST_ERROR
  186.                     Exit Function
  187.             End Select
  188.         Else
  189.             Select Case LCase(strFlag)
  190.                 Case "/c"
  191.                     strClass = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  192.                 Case "/u"
  193.                     strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  194.                 Case "/o"
  195.                     strOutputFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  196.                 Case "/w"
  197.                     strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  198.                 Case else
  199.                     Print "Invalid flag " & strFlag & "."
  200.                     Print "Please check the input and try again."
  201.                     intParseCmdLine = CONST_ERROR
  202.                     Exit Function
  203.             End Select
  204.         End If
  205.     Next
  206.  
  207.     intParseCmdLine = CONST_PROCEED
  208.  
  209. End Function
  210.  
  211. '********************************************************************
  212. '*
  213. '* Sub ShowUsage()
  214. '* Purpose: Shows the correct usage to the user.
  215. '* Input:   None
  216. '* Output:  Help messages are displayed on screen.
  217. '*
  218. '********************************************************************
  219.  
  220. Sub ShowUsage()
  221.  
  222.     Wscript.Echo ""
  223.     Wscript.Echo "Lists all members of a container or a group object." & vbCRLF
  224.     Wscript.Echo "LISTMEMBERS.VBS adspath [/C:class] [/O:outputfile]"
  225.     Wscript.Echo "[/U:username] [/W:password] [/Q]"
  226.     Wscript.Echo "   /C, /O, /U, /W"
  227.     Wscript.Echo "                 Parameter specifiers."
  228.     Wscript.Echo "   adspath       The ADsPath of a container or group object."
  229.     Wscript.Echo "   class         The class name of the member objects to be retrived."
  230.     Wscript.Echo "   outputfile    The output file name."
  231.     Wscript.Echo "   username      Username of the current user."
  232.     Wscript.Echo "   password      Password of the current user."
  233.     Wscript.Echo "   /Q            Suppresses all output messages." & vbCRLF
  234.     Wscript.Echo "EXAMPLES:"
  235.     Wscript.Echo "LISTMEMBERS.VBS WinNT://MyDomain /C:user"
  236.     Wscript.Echo "   lists ADsPaths of all users of MyDomain."
  237.  
  238. End Sub
  239.  
  240. '********************************************************************
  241. '*
  242. '* Sub GetMembers()
  243. '* Purpose: Lists all members of a container or a group object.
  244. '* Input:   strADsPath      ADsPath of a group or container object
  245. '*          strClass        class name of the member objects
  246. '*          strUserName     name of the current user
  247. '*          strPassword     password of the current user
  248. '*          strOutputFile   an output file name
  249. '* Output:  ADsPaths of the member objects are either printed on screen or
  250. '*          saved in strOutputFile.
  251. '*
  252. '********************************************************************
  253.  
  254. Private Sub GetMembers(strADsPath, strClass, strUserName, strPassword, strOutputFile)
  255.  
  256.     ON ERROR RESUME NEXT
  257.  
  258.     Dim strProvider, objProvider, objADs, objFileSystem, objOutputFile, objSchema, i
  259.  
  260.     Print "Getting object " & strADsPath & "..."
  261.     If strUserName = ""    then        'The current user is assumed
  262.         set objADs = GetObject(strADsPath)
  263.     Else                        'Credentials are passed
  264.         strProvider = Left(strADsPath, InStr(1, strADsPath, ":"))
  265.         set objProvider = GetObject(strProvider)
  266.         'Use user authentication
  267.         set objADs = objProvider.OpenDsObject(strADsPath,strUserName,strPassword,1)
  268.     End If
  269.     If Err.Number then
  270.         If CStr(Hex(Err.Number)) = "80070035" Then
  271.             Print "Object " & strADsPath & " is not found."
  272.         Else
  273.             Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " _
  274.                 & strADsPath & "."
  275.             If Err.Description <> "" Then
  276.                 Print "Error description: " & Err.Description & "."
  277.             End If
  278.         End If
  279.         Err.Clear
  280.         Exit Sub
  281.     End If
  282.  
  283.     'Get the schema object
  284.     set objSchema = GetObject(objADs.Schema)
  285.     If Err.Number then                'Can not get the schema for this object
  286.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting the schema of" _
  287.               & strADsPath & "."
  288.         If Err.Description <> "" Then
  289.             Print "Error description: " & Err.Description & "."
  290.         End If
  291.         Err.Clear
  292.         objSchema = ""
  293.     End If
  294.  
  295.     If strOutputFile = "" Then
  296.         objOutputFile = ""
  297.     Else
  298.         'After discovering the object, open a file to save the results
  299.         'Create a filesystem object
  300.         set objFileSystem = CreateObject("Scripting.FileSystemObject")
  301.         If Err.Number then
  302.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
  303.             If Err.Description <> "" Then
  304.                 Print "Error description: " & Err.Description & "."
  305.             End If
  306.             Exit Sub
  307.         End If
  308.         'Open the file for output
  309.         set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True)
  310.         If Err.Number then
  311.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile
  312.             If Err.Description <> "" Then
  313.                 Print "Error description: " & Err.Description & "."
  314.             End If
  315.             Exit Sub
  316.         End If
  317.     End If
  318.  
  319.     Print "Getting members of " & strADsPath
  320.     i = intGetDirectMembers(objADs, objSchema, strClass, objOutputFile)
  321.     If i = 0 then                        'Nothing has been found
  322.         If strClass = "" Then
  323.             Print "Object " & objADs.ADsPath & """ does not have any members."
  324.         Else
  325.             Print "Object " & objADs.ADsPath & """ does not have " & strClass & " any members."
  326.         End If
  327.     Else
  328.         If strClass = "" Then
  329.             Print "Object " & objADs.ADsPath & """ has " & i & " members."
  330.         Else
  331.             Print "Object " & objADs.ADsPath & """ has " & i & " " & strClass & " members."
  332.         End If
  333.     End If
  334.  
  335.  
  336.     If strOutputFile <> "" Then
  337.         Wscript.Echo "Results are saved in file " & strOutputFile & "."
  338.         objOutputFile.Close
  339.     End If
  340.  
  341. End Sub
  342.  
  343. '********************************************************************
  344. '*
  345. '* Function intGetDirectMembers()
  346. '* Purpose: Gets direct members of a group or container object.
  347. '* Input:   objADs          an ADs object
  348. '*          objSchema       the schema object of objADs
  349. '*          strClass        class name of the member objects
  350. '*          objOutputFile   an output file object
  351. '* Output:  The domain names are either printed on screen or saved in objOutputFile.
  352. '*
  353. '********************************************************************
  354.  
  355. Private Function intGetDirectMembers(objADs, objSchema, strClass, objOutputFile)
  356.  
  357.     ON ERROR RESUME NEXT
  358.  
  359.     Dim objMember, strMessage, strObjType, i
  360.  
  361.     'Initialize variables
  362.     intGetDirectMembers = 0
  363.     i = 0
  364.     strMessage = ""
  365.     strObjType = "container"    'Default this to a container object
  366.  
  367.     If IsObject(objSchema) Then        'The schema object is received
  368.         If objSchema.Container Then        'It's a container object
  369.             If Not (strClass = "" OR strClass = "*") Then    'If strClass is specified
  370.                 objADs.Filter = Array(CStr(strClass))
  371.             End If
  372.             For Each objMember in objADs
  373.                 If Err.Number then
  374.                     Err.Clear
  375.                 Else
  376.                     i = i + 1
  377.                     If strClass = "" Then
  378.                         strMessage = objMember.ADsPath
  379.                     Else
  380.                         strMessage = strClass & " " & i & "     " & objMember.ADsPath
  381.                     End If
  382.                     WriteLine strMessage, objOutputFile
  383.                 End If
  384.             Next
  385.         Else                            'It's a group object
  386.             strClass = ""                'Reset the class string since it can not be used.
  387.             strObjType = "group"
  388.             For Each objMember in objADs.Members
  389.                 If Err.Number then
  390.                     strObjType = "leaf"
  391.                     Err.Clear
  392.                     Exit For
  393.                 Else
  394.                     i = i + 1
  395.                     If strClass = "" Then
  396.                         strMessage = objMember.ADsPath
  397.                     Else
  398.                         strMessage = strClass & " " & i & "     " & objMember.ADsPath
  399.                     End If
  400.                     WriteLine strMessage, objOutputFile
  401.                 End If
  402.             Next
  403.         End If
  404.     Else            'Could not find the schema object
  405.         strClass = ""        'Reset the class string since it can not be used.
  406.         'First treat it like a container
  407.         i = 0
  408.         For Each objMember in objADs
  409.             If Err.Number Then
  410.                 Exit For
  411.             End If
  412.             i = i + 1
  413.             strMessage = objMember.ADsPath
  414.             WriteLine strMessage, objOutputFile
  415.         Next
  416.         If Err.Number then                    'It is not a container object
  417.             Err.Clear
  418.             i = 0
  419.             For Each objMember in objADs.Members      'now treat it like a group object
  420.                 strObjType = "group"
  421.                 If Err.Number Then
  422.                     strObjType = "leaf"
  423.                     Err.Clear
  424.                     Exit For
  425.                 End If
  426.                 i = i + 1
  427.                 strMessage = objMember.ADsPath
  428.                 WriteLine strMessage, objOutputFile
  429.             Next
  430.         End If
  431.     End If
  432.  
  433.     intGetDirectMembers = i
  434.  
  435. End Function
  436.  
  437. '********************************************************************
  438. '*
  439. '* Sub WriteLine()
  440. '* Purpose: Writes a text line either to a file or on screen.
  441. '* Input:   strMessage  the string to print
  442. '*          objFile     an output file object
  443. '* Output:  strMessage is either displayed on screen or written to a file.
  444. '*
  445. '********************************************************************
  446.  
  447. Sub WriteLine(ByRef strMessage, ByRef objFile)
  448.  
  449.     If IsObject(objFile) then        'objFile should be a file object
  450.         objFile.WriteLine strMessage
  451.     Else
  452.         Wscript.Echo  strMessage
  453.     End If
  454.  
  455. End Sub
  456.  
  457. '********************************************************************
  458. '*
  459. '* Sub Print()
  460. '* Purpose: Prints a message on screen if blnQuiet = False.
  461. '* Input:   strMessage      the string to print
  462. '* Output:  strMessage is printed on screen if blnQuiet = False.
  463. '*
  464. '********************************************************************
  465.  
  466. Sub Print(ByRef strMessage)
  467.     If Not blnQuiet then
  468.         Wscript.Echo  strMessage
  469.     End If
  470. End Sub
  471.  
  472. '********************************************************************
  473. '*                                                                  *
  474. '*                           End of File                            *
  475. '*                                                                  *
  476. '********************************************************************
  477.  
  478. '********************************************************************
  479. '*
  480. '* Procedures calling sequence: LISTMEMBERS.VBS
  481. '*
  482. '*  intChkProgram
  483. '*  intParseCmdLine
  484. '*  ShowUsage
  485. '*  GetMembers
  486. '*      intGetDirectMembers
  487. '*          WriteLine
  488. '*
  489. '********************************************************************
  490.