home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 2000 Professional Resource Kit / W2KPRK.iso / compmgmt.cab / ListDCs.vbs < prev    next >
Encoding:
Text File  |  1999-11-04  |  15.9 KB  |  453 lines
  1.  
  2. '********************************************************************
  3. '*
  4. '* File:        LISTDCS.VBS
  5. '* Created:     August 1998
  6. '* Version:     1.0
  7. '*
  8. '* Main Function: Lists all domain controllers within a given domain.
  9. '* Usage: LISTDCS.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 blnQuiet, i, strArgumentArray(), intOpMode
  28. ReDim strArgumentArray(0)
  29.  
  30. 'Initialize variables
  31. strArgumentArray(0) = ""
  32. blnQuiet = False
  33. strADsPath = ""
  34. strUserName = ""
  35. strPassword = ""
  36. strOutputFile = ""
  37.  
  38. 'Get the command line arguments
  39. For i = 0 to Wscript.arguments.count - 1
  40.     ReDim Preserve strArgumentArray(i)
  41.     strArgumentArray(i) = Wscript.arguments.item(i)
  42. Next
  43.  
  44. 'Check whether the script is run using CScript
  45. Select Case intChkProgram()
  46.     Case CONST_CSCRIPT
  47.         'Do Nothing
  48.     Case CONST_WSCRIPT
  49.         WScript.Echo "Please run this script using CScript." & vbCRLF & _
  50.             "This can be achieved by" & vbCRLF & _
  51.             "1. Using ""CScript LISTDCS.vbs arguments"" for Windows 95/98 or" & 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.             "    ""LISTDCS.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.             blnQuiet, strUserName, strPassword, strOutputFile)
  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 GetDCs(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 the root of the search
  141. '*          strUserName         name of the current user
  142. '*          strPassword         password of the current user
  143. '*          strOutputFile       an output file name
  144. '*          blnQuiet            specifies whether to suppress messages
  145. '*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
  146. '*
  147. '********************************************************************
  148.  
  149. Private Function intParseCmdLine(strArgumentArray, strADsPath, _
  150.     blnQuiet, strUserName, strPassword, strOutputFile)
  151.  
  152.     ON ERROR RESUME NEXT
  153.  
  154.     Dim i, strFlag
  155.  
  156.     strFlag = strArgumentArray(0)
  157.  
  158.     If strFlag = "" then                'No arguments have been received
  159.         Print "Arguments are required."
  160.         intParseCmdLine = CONST_ERROR
  161.         Exit Function
  162.     End If
  163.  
  164.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  165.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
  166.         intParseCmdLine = CONST_SHOW_USAGE
  167.         Exit Function
  168.     End If
  169.  
  170.     strADsPath = strFlag        'The first parameter must be the ADsPath.
  171.  
  172.     For i = 1 to UBound(strArgumentArray)
  173.         strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)
  174.         If Err.Number Then            'An error occurs if there is no : in the string
  175.             Err.Clear
  176.             Select Case LCase(strArgumentArray(i))
  177.                 Case "/q"
  178.                     blnQuiet = True
  179.                 Case else
  180.                     Print "Invalid flag " & strArgumentArray(i) & "."
  181.                     Print "Please check the input and try again."
  182.                     intParseCmdLine = CONST_ERROR
  183.                     Exit Function
  184.             End Select
  185.         Else
  186.             Select Case LCase(strFlag)
  187.                 Case "/u"
  188.                     strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  189.                 Case "/w"
  190.                     strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  191.                 Case "/o"
  192.                     strOutputFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  193.                 Case else
  194.                     Print "Invalid flag " & strFlag & "."
  195.                     Print "Please check the input and try again."
  196.                     intParseCmdLine = CONST_ERROR
  197.                     Exit Function
  198.             End Select
  199.         End If
  200.     Next
  201.  
  202.     intParseCmdLine = CONST_PROCEED
  203.  
  204. End Function
  205.  
  206. '********************************************************************
  207. '*
  208. '* Sub ShowUsage()
  209. '* Purpose: Shows the correct usage to the user.
  210. '* Input:   None
  211. '* Output:  Help messages are displayed on screen.
  212. '*
  213. '********************************************************************
  214.  
  215. Private Sub ShowUsage()
  216.  
  217.     Wscript.Echo ""
  218.     Wscript.Echo "Lists all domain controllers within a given domain." & vbCRLF
  219.     Wscript.Echo "LISTDCS.VBS adspath [/O:outputfile]"
  220.     Wscript.Echo "[/U:username] [/W:password] [/Q]"
  221.     Wscript.Echo "   /O, /U, /W    Parameter specifiers."
  222.     Wscript.Echo "   adspath       The container of computer objects in a domain."
  223.     Wscript.Echo "   outputfile    The output file name."
  224.     Wscript.Echo "   username      Username of the current user."
  225.     Wscript.Echo "   password      Password of the current user."
  226.     Wscript.Echo "   /Q            Suppresses all output messages." & vbCRLF
  227.     Wscript.Echo "EXAMPLE:"
  228.     Wscript.Echo "LISTDCS.VBS ""LDAP://CN=Computers,DC=FooFoo,DC=Foo,DC=Com"""
  229.     Wscript.Echo "   lists ADsPaths of all DCs of domain FooFoo." & vbCRLF
  230.     Wscript.Echo "NOTE:"
  231.     Wscript.Echo "   This script works only with an LDAP provider."
  232.  
  233. End Sub
  234.  
  235. '********************************************************************
  236. '*
  237. '* Sub GetDCs()
  238. '* Purpose: Lists all domain controllers within a given domain.
  239. '* Input:   strADsPath      ADsPath of the root of the search
  240. '*          strUserName     name of the current user
  241. '*          strPassword     password of the current user
  242. '*          strOutputFile   an output file name
  243. '* Output:  Results of the search are either printed on screen or saved in strOutputFile.
  244. '*
  245. '********************************************************************
  246.  
  247. Private Sub GetDCs(strADsPath, strUserName, strPassword, strOutputFile)
  248.  
  249.     ON ERROR RESUME NEXT
  250.  
  251.     Dim strProvider, strSearchPath, objConnect, objCommand, objFileSystem, objOutputFile
  252.     Dim objRecordSet, strProperties, strCriteria, strScope, intResult
  253.  
  254.     'Make sure that the provide is LDAP
  255.     strProvider = Left(strADsPath, InStr(1, strADsPath, ":"))
  256.     If strProvider <> "LDAP:" then
  257.         Print "The provider is not LDAP."
  258.         Wscript.Quit
  259.     End If
  260.  
  261.     If strOutputFile = "" Then
  262.         objOutputFile = ""
  263.     Else
  264.         'Create a filesystem object
  265.         set objFileSystem = CreateObject("Scripting.FileSystemObject")
  266.         If Err.Number then
  267.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
  268.             If Err.Description <> "" Then
  269.                 Print "Error description: " & Err.Description & "."
  270.             End If
  271.             Exit Sub
  272.         End If
  273.         'Open the file for output
  274.         set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True)
  275.         If Err.Number then
  276.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile
  277.             If Err.Description <> "" Then
  278.                 Print "Error description: " & Err.Description & "."
  279.             End If
  280.             Exit Sub
  281.         End If
  282.     End If
  283.  
  284.     strSearchPath =  "<" & strADsPath & ">;"
  285.     strProperties = "ADsPath;"
  286.     'userAccountControl=8192 indicates that the computer is a DC
  287.     strCriteria = "(&(objectCategory=computer)(userAccountControl=8192));"
  288.     strScope = "OneLevel"
  289.  
  290.     Set objConnect = CreateObject("ADODB.Connection")
  291.     If Err.Number then
  292.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in opening a connection."
  293.         If Err.Description <> "" Then
  294.             Print "Error description: " & Err.Description & "."
  295.         End If
  296.         Exit Sub
  297.     End If
  298.  
  299.     Set objCommand = CreateObject("ADODB.Command")
  300.     If Err.Number then
  301.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in creating the command object."
  302.         If Err.Description <> "" Then
  303.             Print "Error description: " & Err.Description & "."
  304.         End If
  305.         Exit Sub
  306.     End If
  307.  
  308.     objConnect.Provider = "ADsDSOObject"
  309.     If strUserName = "" then
  310.         objConnect.Open "Active Directory Provider"
  311.     Else
  312.         objConnect.Open "Active Directory Provider", strUserName, strPassword
  313.     End If
  314.     If Err.Number then
  315.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred opening a provider."
  316.         If Err.Description <> "" Then
  317.             Print "Error description: " & Err.Description & "."
  318.         End If
  319.         Exit Sub
  320.     End If
  321.  
  322.     Set objCommand.ActiveConnection = objConnect
  323.  
  324.     'Set the query string and other properties
  325.     objCommand.CommandText  = strSearchPath & strCriteria & strProperties & strScope
  326.     objCommand.Properties("Page Size") = 100000                    'reset search properties
  327.     objCommand.Properties("Timeout") = 300000 'seconds
  328. '    objCommand.Properties("SearchScope") = 2
  329.  
  330.     'After setting all the parameter now execute the search and display the results.
  331.     intResult = intExecuteSearch(objRecordSet, objCommand, objOutputFile)
  332.  
  333.     If strOutputFile <> "" Then
  334.         objOutputFile.Close
  335.         If intResult > 0 Then
  336.             Wscript.Echo "Results are saved in file " & strOutputFile & "."
  337.         End If
  338.     End If
  339.  
  340. End Sub
  341.  
  342. '********************************************************************
  343. '*
  344. '* Function intExecuteSearch()
  345. '* Purpose: Performs an LDAP search based on given criteria.
  346. '* Input:   objRecordSet    a recordset to store the info returned
  347. '*          objCommand      the query command object
  348. '*          objOutputFile   an output file object
  349. '* Output:  Results of the search are either printed on screen or saved in objOutputFile.
  350. '*          intExecuteSearch is set to -1 if the search failed or the number of objects
  351. '*          found if succeeded.
  352. '*
  353. '********************************************************************
  354.  
  355. Private Function intExecuteSearch(objRecordSet, objCommand, objOutputFile)
  356.  
  357.     ON ERROR RESUME NEXT
  358.  
  359.     Dim  intNumObjects, i, j , k, intUBound, strMessage
  360.  
  361.     intNumObjects = 0
  362.     intUBound = 0
  363.     intExecuteSearch = 0
  364.  
  365.     'Let the user know what is going on
  366.     Print objCommand.CommandText
  367.  
  368.     'Execute the query
  369.     Set objRecordSet = objCommand.Execute
  370.     Print "Finished the query."
  371.     If Err.Number then
  372.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred during the query."
  373.         If Err.Description <> "" Then
  374.             Print "Error description: " & Err.Description & "."
  375.         End If
  376.         Err.Clear
  377.         intExecuteSearch = -1        'failed
  378.         Exit Function
  379.     End If
  380.  
  381.     'Get the total number of objects found.
  382.     objRecordSet.MoveLast
  383.     intNumObjects = objRecordSet.RecordCount
  384.     intExecuteSearch = intNumObjects    'Succeeded
  385.  
  386.     If intNumObjects Then                'If intNumObjects is not zero
  387.         Wscript.Echo "Found " & intNumObjects & " DCs."
  388.         objRecordSet.MoveFirst
  389.         While Not objRecordSet.EOF
  390.             strMessage = objRecordSet.Fields(0)
  391.             Call WriteLine(strMessage, objOutputFile)
  392.             objRecordSet.MoveNext
  393.         Wend
  394.     Else
  395.         Wscript.Echo "No DC has been found within " & strADsPath & "."
  396.     End If
  397.  
  398. End Function
  399.  
  400. '********************************************************************
  401. '*
  402. '* Sub WriteLine()
  403. '* Purpose: Writes a text line either to a file or on screen.
  404. '* Input:   strMessage  the string to print
  405. '*          objFile     an output file object
  406. '* Output:  strMessage is either displayed on screen or written to a file.
  407. '*
  408. '********************************************************************
  409.  
  410. Sub WriteLine(ByRef strMessage, ByRef objFile)
  411.  
  412.     If IsObject(objFile) then        'objFile should be a file object
  413.         objFile.WriteLine strMessage
  414.     Else
  415.         Wscript.Echo  strMessage
  416.     End If
  417.  
  418. End Sub
  419.  
  420. '********************************************************************
  421. '*
  422. '* Sub Print()
  423. '* Purpose: Prints a message on screen if blnQuiet = False.
  424. '* Input:   strMessage      the string to print
  425. '* Output:  strMessage is printed on screen if blnQuiet = False.
  426. '*
  427. '********************************************************************
  428.  
  429. Sub Print(ByRef strMessage)
  430.     If Not blnQuiet then
  431.         Wscript.Echo  strMessage
  432.     End If
  433. End Sub
  434.  
  435. '********************************************************************
  436. '*                                                                  *
  437. '*                           End of File                            *
  438. '*                                                                  *
  439. '********************************************************************
  440.  
  441. '********************************************************************
  442. '*
  443. '* Procedures calling sequence: LISTDCS.VBS
  444. '*
  445. '*  intChkProgram
  446. '*  intParseCmdLine
  447. '*  ShowUsage
  448. '*  GetDCs
  449. '*      intExecuteSearch
  450. '*          WriteLine
  451. '*
  452. '********************************************************************
  453.