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