home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 Special
/
chip-cd_2001_spec_05.zip
/
spec_05
/
compmgmt.cab
/
ListMembers.vbs
< prev
next >
Wrap
Text File
|
1999-11-04
|
18KB
|
490 lines
'********************************************************************
'*
'* File: LISTMEMBERS.VBS
'* Created: August 1998
'* Version: 1.0
'*
'* Main Function: Lists all members of a container or a group object.
'* Usage: LISTMEMBERS.VBS adspath [/C:class] [/O:outputfile]
'* [/U:username] [/W:password] [/Q]
'*
'* Copyright (C) 1998 Microsoft Corporation
'*
'********************************************************************
OPTION EXPLICIT
ON ERROR RESUME NEXT
'Define constants
CONST CONST_ERROR = 0
CONST CONST_WSCRIPT = 1
CONST CONST_CSCRIPT = 2
CONST CONST_SHOW_USAGE = 3
CONST CONST_PROCEED = 4
'Declare variables
Dim strADsPath, strClass, strUserName, strPassword, strOutputFile
Dim blnQuiet, i, strArgumentArray(), intOpMode
ReDim strArgumentArray(0)
'Initialize variables
strArgumentArray(0) = ""
blnQuiet = False
strADsPath = ""
strClass = ""
strUserName = ""
strPassword = ""
strOutputFile = ""
'Get the command line arguments
For i = 0 to Wscript.arguments.count - 1
ReDim Preserve strArgumentArray(i)
strArgumentArray(i) = Wscript.arguments.item(i)
Next
'Check whether the script is run using CScript
Select Case intChkProgram()
Case CONST_CSCRIPT
'Do Nothing
Case CONST_WSCRIPT
WScript.Echo "Please run this script using CScript." & vbCRLF & _
"This can be achieved by" & vbCRLF & _
"1. Using ""CScript LISTMEMBERS.vbs arguments"" for Windows 95/98 or" & vbCRLF & _
"2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
" using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
" ""LISTMEMBERS.vbs arguments"" for Windows NT."
WScript.Quit
Case Else
WScript.Quit
End Select
'Parse the command line
intOpMode = intParseCmdLine(strArgumentArray, strADsPath, strClass, _
blnQuiet, strUserName, strPassword, strOutputFile)
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
If Err.Description <> "" Then
Print "Error description: " & Err.Description & "."
End If
WScript.Quit
End If
Select Case intOpMode
Case CONST_SHOW_USAGE
Call ShowUsage()
Case CONST_PROCEED
Call GetMembers(strADsPath, strClass, strUserName, strPassword, strOutputFile)
Case CONST_ERROR
'Do nothing.
Case Else 'Default -- should never happen
Print "Error occurred in passing parameters."
End Select
'********************************************************************
'*
'* Function intChkProgram()
'* Purpose: Determines which program is used to run this script.
'* Input: None
'* Output: intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
'* and CONST_CSCRIPT.
'*
'********************************************************************
Private Function intChkProgram()
ON ERROR RESUME NEXT
Dim strFullName, strCommand, i, j
'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
strFullName = WScript.FullName
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
If Err.Description <> "" Then
Print "Error description: " & Err.Description & "."
End If
intChkProgram = CONST_ERROR
Exit Function
End If
i = InStr(1, strFullName, ".exe", 1)
If i = 0 Then
intChkProgram = CONST_ERROR
Exit Function
Else
j = InStrRev(strFullName, "\", i, 1)
If j = 0 Then
intChkProgram = CONST_ERROR
Exit Function
Else
strCommand = Mid(strFullName, j+1, i-j-1)
Select Case LCase(strCommand)
Case "cscript"
intChkProgram = CONST_CSCRIPT
Case "wscript"
intChkProgram = CONST_WSCRIPT
Case Else 'should never happen
Print "An unexpected program is used to run this script."
Print "Only CScript.Exe or WScript.Exe can be used to run this script."
intChkProgram = CONST_ERROR
End Select
End If
End If
End Function
'********************************************************************
'*
'* Function intParseCmdLine()
'* Purpose: Parses the command line.
'* Input: strArgumentArray an array containing input from the command line
'* Output: strADsPath ADsPath of a group or container object
'* strClass class name of the member objects
'* strUserName name of the current user
'* strPassword password of the current user
'* strOutputFile an output file name
'* blnQuiet specifies whether to suppress messages
'* intParseCmdLine is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
'*
'********************************************************************
Private Function intParseCmdLine(strArgumentArray, strADsPath, strClass, _
blnQuiet, strUserName, strPassword, strOutputFile)
ON ERROR RESUME NEXT
Dim i, strFlag
strFlag = strArgumentArray(0)
If strFlag = "" then 'No arguments have been received
Print "Arguments are required."
intParseCmdLine = CONST_ERROR
Exit Function
End If
If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
intParseCmdLine = CONST_SHOW_USAGE
Exit Function
End If
strADsPath = strFlag 'The first parameter must be the ADsPath.
For i = 1 to UBound(strArgumentArray)
strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)
If Err.Number Then 'An error occurs if there is no : in the string
Err.Clear
Select Case LCase(strArgumentArray(i))
Case "/q"
blnQuiet = True
Case else
Print "Invalid flag " & strArgumentArray(i) & "."
Print "Please check the input and try again."
intParseCmdLine = CONST_ERROR
Exit Function
End Select
Else
Select Case LCase(strFlag)
Case "/c"
strClass = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/u"
strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/o"
strOutputFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case "/w"
strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
Case else
Print "Invalid flag " & strFlag & "."
Print "Please check the input and try again."
intParseCmdLine = CONST_ERROR
Exit Function
End Select
End If
Next
intParseCmdLine = CONST_PROCEED
End Function
'********************************************************************
'*
'* Sub ShowUsage()
'* Purpose: Shows the correct usage to the user.
'* Input: None
'* Output: Help messages are displayed on screen.
'*
'********************************************************************
Sub ShowUsage()
Wscript.Echo ""
Wscript.Echo "Lists all members of a container or a group object." & vbCRLF
Wscript.Echo "LISTMEMBERS.VBS adspath [/C:class] [/O:outputfile]"
Wscript.Echo "[/U:username] [/W:password] [/Q]"
Wscript.Echo " /C, /O, /U, /W"
Wscript.Echo " Parameter specifiers."
Wscript.Echo " adspath The ADsPath of a container or group object."
Wscript.Echo " class The class name of the member objects to be retrived."
Wscript.Echo " outputfile The output file name."
Wscript.Echo " username Username of the current user."
Wscript.Echo " password Password of the current user."
Wscript.Echo " /Q Suppresses all output messages." & vbCRLF
Wscript.Echo "EXAMPLES:"
Wscript.Echo "LISTMEMBERS.VBS WinNT://MyDomain /C:user"
Wscript.Echo " lists ADsPaths of all users of MyDomain."
End Sub
'********************************************************************
'*
'* Sub GetMembers()
'* Purpose: Lists all members of a container or a group object.
'* Input: strADsPath ADsPath of a group or container object
'* strClass class name of the member objects
'* strUserName name of the current user
'* strPassword password of the current user
'* strOutputFile an output file name
'* Output: ADsPaths of the member objects are either printed on screen or
'* saved in strOutputFile.
'*
'********************************************************************
Private Sub GetMembers(strADsPath, strClass, strUserName, strPassword, strOutputFile)
ON ERROR RESUME NEXT
Dim strProvider, objProvider, objADs, objFileSystem, objOutputFile, objSchema, i
Print "Getting object " & strADsPath & "..."
If strUserName = "" then 'The current user is assumed
set objADs = GetObject(strADsPath)
Else 'Credentials are passed
strProvider = Left(strADsPath, InStr(1, strADsPath, ":"))
set objProvider = GetObject(strProvider)
'Use user authentication
set objADs = objProvider.OpenDsObject(strADsPath,strUserName,strPassword,1)
End If
If Err.Number then
If CStr(Hex(Err.Number)) = "80070035" Then
Print "Object " & strADsPath & " is not found."
Else
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " _
& strADsPath & "."
If Err.Description <> "" Then
Print "Error description: " & Err.Description & "."
End If
End If
Err.Clear
Exit Sub
End If
'Get the schema object
set objSchema = GetObject(objADs.Schema)
If Err.Number then 'Can not get the schema for this object
Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting the schema of" _
& strADsPath & "."
If Err.Description <> "" Then
Print "Error description: " & Err.Description & "."
End If
Err.Clear
objSchema = ""
End If
If strOutputFile = "" Then
objOutputFile = ""
Else
'After discovering the object, open a file to save the results
'Create a filesystem object
set objFileSystem = CreateObject("Scripting.FileSystemObject")
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
If Err.Description <> "" Then
Print "Error description: " & Err.Description & "."
End If
Exit Sub
End If
'Open the file for output
set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True)
If Err.Number then
Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile
If Err.Description <> "" Then
Print "Error description: " & Err.Description & "."
End If
Exit Sub
End If
End If
Print "Getting members of " & strADsPath
i = intGetDirectMembers(objADs, objSchema, strClass, objOutputFile)
If i = 0 then 'Nothing has been found
If strClass = "" Then
Print "Object " & objADs.ADsPath & """ does not have any members."
Else
Print "Object " & objADs.ADsPath & """ does not have " & strClass & " any members."
End If
Else
If strClass = "" Then
Print "Object " & objADs.ADsPath & """ has " & i & " members."
Else
Print "Object " & objADs.ADsPath & """ has " & i & " " & strClass & " members."
End If
End If
If strOutputFile <> "" Then
Wscript.Echo "Results are saved in file " & strOutputFile & "."
objOutputFile.Close
End If
End Sub
'********************************************************************
'*
'* Function intGetDirectMembers()
'* Purpose: Gets direct members of a group or container object.
'* Input: objADs an ADs object
'* objSchema the schema object of objADs
'* strClass class name of the member objects
'* objOutputFile an output file object
'* Output: The domain names are either printed on screen or saved in objOutputFile.
'*
'********************************************************************
Private Function intGetDirectMembers(objADs, objSchema, strClass, objOutputFile)
ON ERROR RESUME NEXT
Dim objMember, strMessage, strObjType, i
'Initialize variables
intGetDirectMembers = 0
i = 0
strMessage = ""
strObjType = "container" 'Default this to a container object
If IsObject(objSchema) Then 'The schema object is received
If objSchema.Container Then 'It's a container object
If Not (strClass = "" OR strClass = "*") Then 'If strClass is specified
objADs.Filter = Array(CStr(strClass))
End If
For Each objMember in objADs
If Err.Number then
Err.Clear
Else
i = i + 1
If strClass = "" Then
strMessage = objMember.ADsPath
Else
strMessage = strClass & " " & i & " " & objMember.ADsPath
End If
WriteLine strMessage, objOutputFile
End If
Next
Else 'It's a group object
strClass = "" 'Reset the class string since it can not be used.
strObjType = "group"
For Each objMember in objADs.Members
If Err.Number then
strObjType = "leaf"
Err.Clear
Exit For
Else
i = i + 1
If strClass = "" Then
strMessage = objMember.ADsPath
Else
strMessage = strClass & " " & i & " " & objMember.ADsPath
End If
WriteLine strMessage, objOutputFile
End If
Next
End If
Else 'Could not find the schema object
strClass = "" 'Reset the class string since it can not be used.
'First treat it like a container
i = 0
For Each objMember in objADs
If Err.Number Then
Exit For
End If
i = i + 1
strMessage = objMember.ADsPath
WriteLine strMessage, objOutputFile
Next
If Err.Number then 'It is not a container object
Err.Clear
i = 0
For Each objMember in objADs.Members 'now treat it like a group object
strObjType = "group"
If Err.Number Then
strObjType = "leaf"
Err.Clear
Exit For
End If
i = i + 1
strMessage = objMember.ADsPath
WriteLine strMessage, objOutputFile
Next
End If
End If
intGetDirectMembers = i
End Function
'********************************************************************
'*
'* Sub WriteLine()
'* Purpose: Writes a text line either to a file or on screen.
'* Input: strMessage the string to print
'* objFile an output file object
'* Output: strMessage is either displayed on screen or written to a file.
'*
'********************************************************************
Sub WriteLine(ByRef strMessage, ByRef objFile)
If IsObject(objFile) then 'objFile should be a file object
objFile.WriteLine strMessage
Else
Wscript.Echo strMessage
End If
End Sub
'********************************************************************
'*
'* Sub Print()
'* Purpose: Prints a message on screen if blnQuiet = False.
'* Input: strMessage the string to print
'* Output: strMessage is printed on screen if blnQuiet = False.
'*
'********************************************************************
Sub Print(ByRef strMessage)
If Not blnQuiet then
Wscript.Echo strMessage
End If
End Sub
'********************************************************************
'* *
'* End of File *
'* *
'********************************************************************
'********************************************************************
'*
'* Procedures calling sequence: LISTMEMBERS.VBS
'*
'* intChkProgram
'* intParseCmdLine
'* ShowUsage
'* GetMembers
'* intGetDirectMembers
'* WriteLine
'*
'********************************************************************