home *** CD-ROM | disk | FTP | other *** search
/ ftp.ac-grenoble.fr / 2015.02.ftp.ac-grenoble.fr.tar / ftp.ac-grenoble.fr / assistance.logicielle / XP_ServicePack-3.iso / support / tools / support.cab / search.vbs < prev    next >
Text File  |  2001-07-22  |  20KB  |  535 lines
  1.  
  2. '********************************************************************
  3. '*
  4. '* File:        SEARCH.VBS
  5. '* Created:     August 1998
  6. '* Version:     1.0
  7. '*
  8. '* Main Function: Performs an LDAP search based on given criteria.
  9. '* Usage: SEARCH.VBS adspath [/C:criteria] [/S:scope] [/P:properties]
  10. '*        [/O:outputfile] [/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 strOutputFile, intOpMode, blnQuiet, i
  28. Dim strADsPath, strCriteria, strProperties,  strScope, strUserName, strPassword
  29. ReDim strArgumentArray(0)
  30.  
  31. 'Initialize variables
  32. strArgumentArray(0) = ""
  33. blnQuiet = False
  34. strADsPath = ""
  35. strCriteria = "ObjectCategory=*"
  36. strProperties = "ADsPath;"
  37. strScope = "OneLevel"
  38. strUserName = ""
  39. strPassword = ""
  40. strOutputFile = ""
  41.  
  42. 'Get the command line arguments
  43. For i = 0 to Wscript.arguments.count - 1
  44.     ReDim Preserve strArgumentArray(i)
  45.     strArgumentArray(i) = Wscript.arguments.Item(i)
  46. Next
  47.  
  48. 'Check whether the script is run using CScript
  49. Select Case intChkProgram()
  50.     Case CONST_CSCRIPT
  51.         'Do Nothing
  52.     Case CONST_WSCRIPT
  53.         WScript.Echo "Please run this script using CScript." & vbCRLF & _
  54.             "This can be achieved by" & vbCRLF & _
  55.             "1. Using ""CScript SEARCH.vbs arguments"" for Windows 95/98 or" & vbCRLF & _
  56.             "2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
  57.             "    using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
  58.             "    ""SEARCH.vbs arguments"" for Windows NT."
  59.         WScript.Quit
  60.     Case Else
  61.         WScript.Quit
  62. End Select
  63.  
  64.  
  65. 'Parse the command line
  66. intOpMode = intParseCmdLine(strArgumentArray, strADsPath, strCriteria, strProperties, _
  67.             strScope, blnQuiet, strUserName, strPassword, strOutputFile)
  68. If Err.Number then
  69.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
  70.     If Err.Description <> "" Then
  71.         Print "Error description: " & Err.Description & "."
  72.     End If
  73.     WScript.Quit
  74. End If
  75.  
  76. Select Case intOpMode
  77.     Case CONST_SHOW_USAGE
  78.         Call ShowUsage()
  79.     Case CONST_PROCEED
  80.         Call Search(strADsPath, strCriteria, strProperties, _
  81.              strScope, strUserName, strPassword, strOutputFile)
  82.     Case CONST_ERROR
  83.         'Do nothing.
  84.     Case Else                    'Default -- should never happen
  85.         Print "Error occurred in passing parameters."
  86. End Select
  87.  
  88. '********************************************************************
  89. '*
  90. '* Function intChkProgram()
  91. '* Purpose: Determines which program is used to run this script.
  92. '* Input:   None
  93. '* Output:  intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
  94. '*          and CONST_CSCRIPT.
  95. '*
  96. '********************************************************************
  97.  
  98. Private Function intChkProgram()
  99.  
  100.     ON ERROR RESUME NEXT
  101.  
  102.     Dim strFullName, strCommand, i, j
  103.  
  104.     'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
  105.     strFullName = WScript.FullName
  106.     If Err.Number then
  107.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
  108.         If Err.Description <> "" Then
  109.             If Err.Description <> "" Then
  110.                 Print "Error description: " & Err.Description & "."
  111.             End If
  112.         End If
  113.         intChkProgram =  CONST_ERROR
  114.         Exit Function
  115.     End If
  116.  
  117.     i = InStr(1, strFullName, ".exe", 1)
  118.     If i = 0 Then
  119.         intChkProgram =  CONST_ERROR
  120.         Exit Function
  121.     Else
  122.         j = InStrRev(strFullName, "\", i, 1)
  123.         If j = 0 Then
  124.             intChkProgram =  CONST_ERROR
  125.             Exit Function
  126.         Else
  127.             strCommand = Mid(strFullName, j+1, i-j-1)
  128.             Select Case LCase(strCommand)
  129.                 Case "cscript"
  130.                     intChkProgram = CONST_CSCRIPT
  131.                 Case "wscript"
  132.                     intChkProgram = CONST_WSCRIPT
  133.                 Case Else       'should never happen
  134.                     Print "An unexpected program is used to run this script."
  135.                     Print "Only CScript.Exe or WScript.Exe can be used to run this script."
  136.                     intChkProgram = CONST_ERROR
  137.             End Select
  138.         End If
  139.     End If
  140.  
  141. End Function
  142.  
  143. '********************************************************************
  144. '*
  145. '* Function intParseCmdLine()
  146. '* Purpose: Parses the command line.
  147. '* Input:   strArgumentArray    an array containing input from the command line
  148. '* Output:  strADsPath          ADsPath of the root of the search
  149. '*          strCriteria         the search criteria
  150. '*          strProperties       properties to be retrieved
  151. '*          strScope            the search scope
  152. '*          strUserName         name of the current user
  153. '*          strPassword         password of the current user
  154. '*          strOutputFile       an output file name
  155. '*          blnQuiet            specifies whether to suppress messages
  156. '*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
  157. '*
  158. '********************************************************************
  159.  
  160. Private Function intParseCmdLine(strArgumentArray, strADsPath, strCriteria, _
  161.         strProperties, strScope, blnQuiet, strUserName, strPassword, strOutputFile)
  162.  
  163.     ON ERROR RESUME NEXT
  164.  
  165.     Dim strFlag, i
  166.  
  167.     strFlag = strArgumentArray(0)
  168.  
  169.     If strFlag = "" then                'No arguments have been received
  170.         Print "Arguments are required."
  171.         intParseCmdLine = CONST_ERROR
  172.         Exit Function
  173.     End If
  174.  
  175.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  176.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
  177.         intParseCmdLine = CONST_SHOW_USAGE
  178.         Exit Function
  179.     End If
  180.  
  181.     strADsPath = FormatProvider(strFlag)    'The first parameter must be the ADsPath.
  182.  
  183.     For i = 1 to UBound(strArgumentArray)
  184.         strFlag = LCase(Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1))
  185.         If Err.Number Then            'An error occurs if there is no : in the string
  186.             Err.Clear
  187.             If LCase(strArgumentArray(i)) = "/q" Then
  188.                 blnQuiet = True
  189.             Else
  190.                 Print strArgumentArray(i) & " is not recognized as a valid input."
  191.                 intParseCmdLine = CONST_ERROR
  192.                 Exit Function
  193.             End If
  194.         Else
  195.             Select Case strFlag
  196.                 Case "/c"
  197.                     strCriteria = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  198.                 Case "/p"
  199.                     strProperties = Right(strArgumentArray(i), Len(strArgumentArray(i))-3) & ";"
  200.                 Case "/s"
  201.                     strScope = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  202.                 Case "/u"
  203.                     strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  204.                 Case "/w"
  205.                     strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  206.                 Case "/o"
  207.                     strOutputFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  208.                 Case else
  209.                     Print "Invalid flag " & """" & strFlag & """" & "."
  210.                     Print "Please check the input and try again."
  211.                     intParseCmdLine = CONST_ERROR
  212.                     Exit Function
  213.                 End Select
  214.         End If
  215.     Next
  216.  
  217.     intParseCmdLine = CONST_PROCEED
  218.  
  219. End Function
  220.  
  221. '********************************************************************
  222. '*
  223. '* Sub ShowUsage()
  224. '* Purpose: Shows the correct usage to the user.
  225. '* Input:   None
  226. '* Output:  Help messages are displayed on screen.
  227. '*
  228. '********************************************************************
  229.  
  230. Private Sub ShowUsage()
  231.  
  232.     Wscript.Echo ""
  233.     Wscript.Echo "Performs an LDAP search based on a given criteria." & vbCRLF
  234.     Wscript.Echo "SEARCH.VBS adspath [/C:criteria] [/S:scope] [/P:properties]"
  235.     Wscript.Echo "[/O:outputfile] [/U:username] [/W:password] [/Q]"
  236.     Wscript.echo "   /C, /S, /P, /O, /U, /W"
  237.     Wscript.Echo "                 Parameter specifiers."
  238.     Wscript.echo "   adspath       ADsPath of a user object container."
  239.     Wscript.echo "   criteria      Criteria of the search."
  240.     Wscript.echo "   scope         Sope of the search."
  241.     Wscript.echo "   properties    Properties to be retrieved."
  242.     Wscript.Echo "   outputfile    The output file name."
  243.     Wscript.echo "   username      Username of the current user."
  244.     Wscript.echo "   password      Password of the current user."
  245.     Wscript.echo "   /Q            Suppresses all output messages." & vbCRLF
  246.     Wscript.Echo "DEFAULT VALUES:"
  247.     Wscript.Echo "   If /C is not specified the default is ObjectCategory=*."
  248.     Wscript.Echo "   If /S is not specified the default is OneLevel."
  249.     Wscript.Echo "   If /P is not specified the default is ADsPath." & vbCRLF
  250.     Wscript.Echo "EXAMPLE:"
  251.     Wscript.Echo "SEARCH.VBS ""LDAP://DC=FooFoo,DC=Foo,DC=Com"""
  252.     Wscript.Echo "   /C:""&(ObjectCategory=user)(cn=b*)"" /P:Name /S:SubTree"
  253.     Wscript.Echo "   lists names of all users in domain FooFoo with"
  254.     Wscript.Echo "   cn starting with ""b""." & vbCRLF
  255.     Wscript.Echo "NOTE:"
  256.     Wscript.Echo "   This script requires an LDAP provider."
  257.  
  258. End Sub
  259.  
  260. '********************************************************************
  261. '*
  262. '* Sub Search()
  263. '* Purpose: Performs an LDAP search based on a given criteria.
  264. '* Input:   strADsPath      ADsPath of the root of the search
  265. '*          strCriteria     the search criteria
  266. '*          strProperties   properties to be retrieved
  267. '*          strScope        the search scope
  268. '*          strUserName     name of the current user
  269. '*          strPassword     password of the current user
  270. '*          strOutputFile   an output file name
  271. '* Output:  Results of the search are either printed on screen or saved in strOutputFile.
  272. '*
  273. '********************************************************************
  274.  
  275. Private Sub Search(strADsPath, strCriteria, strProperties, _
  276.     strScope, strUserName, strPassword, strOutputFile)
  277.  
  278.     ON ERROR RESUME NEXT
  279.  
  280.     Dim strProvider, strSearchPath, objConnect, objCommand
  281.     Dim  objFileSystem, objOutputFile, objRecordSet, intResult
  282.  
  283.     'Make sure that the provide is LDAP
  284.     strProvider = Left(strADsPath, InStr(1, strADsPath, ":"))
  285.     If strProvider <> "LDAP:" then
  286.         Print "The provider is not LDAP:."
  287.         Wscript.Quit
  288.     End If
  289.  
  290.     If strOutputFile = "" Then
  291.         objOutputFile = ""
  292.     Else
  293.         'Create a filesystem object
  294.         set objFileSystem = CreateObject("Scripting.FileSystemObject")
  295.         If Err.Number then
  296.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object."
  297.             If Err.Description <> "" Then
  298.                 Print "Error description: " & Err.Description & "."
  299.             End If
  300.             Exit Sub
  301.         End If
  302.         'Open the file for output
  303.         set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True)
  304.         If Err.Number then
  305.             Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile
  306.             If Err.Description <> "" Then
  307.                 Print "Error description: " & Err.Description & "."
  308.             End If
  309.             Exit Sub
  310.         End If
  311.     End If
  312.  
  313.     strSearchPath =  "<" & strADsPath & ">;"
  314.     strCriteria = "(" & strCriteria & ");"
  315.  
  316.     Set objConnect = CreateObject("ADODB.Connection")
  317.     If Err.Number then
  318.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in opening a connection."
  319.         If Err.Description <> "" Then
  320.             Print "Error description: " & Err.Description & "."
  321.         End If
  322.         Exit Sub
  323.     End If
  324.  
  325.     Set objCommand = CreateObject("ADODB.Command")
  326.     If Err.Number then
  327.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in creating the command object."
  328.         If Err.Description <> "" Then
  329.             Print "Error description: " & Err.Description & "."
  330.         End If
  331.         Exit Sub
  332.     End If
  333.  
  334.     objConnect.Provider = "ADsDSOObject"
  335.     If strUserName = "" then
  336.         objConnect.Open "Active Directory Provider"
  337.     Else
  338.         objConnect.Open "Active Directory Provider", strUserName, strPassword
  339.     End If
  340.     If Err.Number then
  341.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred opening a provider."
  342.         If Err.Description <> "" Then
  343.             Print "Error description: " & Err.Description & "."
  344.         End If
  345.         Exit Sub
  346.     End If
  347.  
  348.     Set objCommand.ActiveConnection = objConnect
  349.  
  350.     'Set the query string and other properties
  351.     objCommand.CommandText  = strSearchPath & strCriteria & strProperties & strScope
  352.     objCommand.Properties("Page Size") = 100000                    'reset search properties
  353.     objCommand.Properties("Timeout") = 300000 'seconds
  354. '    objCommand.Properties("SearchScope") = 2
  355.  
  356.     'After setting all the parameter now execute the search and display the results.
  357.     intResult = intExecuteSearch(objRecordSet, objCommand, objOutputFile)
  358.  
  359.     If strOutputFile <> "" Then
  360.         objOutputFile.Close
  361.         If intResult > 0 Then
  362.             Wscript.Echo "Results are saved in file " & strOutputFile & "."
  363.         End If
  364.     End If
  365.  
  366. End Sub
  367.  
  368. '********************************************************************
  369. '*
  370. '* Function intExecuteSearch()
  371. '* Purpose: Performs an LDAP search based on given criteria
  372. '* Input:   objRecordSet    a recordset to store the info returned
  373. '*          objCommand      the query command object
  374. '*          objOutputFile   an output file object
  375. '* Output:  Results of the search are either printed on screen or saved in objOutputFile.
  376. '*          intExecuteSearch is set to -1 if the search failed or the number of objects
  377. '*          found if succeeded.
  378. '*
  379. '********************************************************************
  380.  
  381. Private Function intExecuteSearch(objRecordSet, objCommand, objOutputFile)
  382.  
  383.     ON ERROR RESUME NEXT
  384.  
  385.     Dim  intNumObjects, i, j , k, intUBound, strMessage
  386.  
  387.     intNumObjects = 0
  388.     intUBound = 0
  389.     intExecuteSearch = 0
  390.  
  391.     'Let the user know what is going on
  392.     Print objCommand.CommandText
  393.  
  394.     'Execute the query
  395.     Set objRecordSet = objCommand.Execute
  396.     Print "Finished the query."
  397.     If Err.Number then
  398.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred during the query."
  399.         If Err.Description <> "" Then
  400.             Print "Error description: " & Err.Description & "."
  401.         End If
  402.         Err.Clear
  403.         intExecuteSearch = -1        'failed
  404.         Exit Function
  405.     End If
  406.  
  407.     'Get the total number of objects found.
  408.     objRecordSet.MoveLast
  409.     intNumObjects = objRecordSet.RecordCount
  410.     intExecuteSearch = intNumObjects    'Succeeded
  411.  
  412.     If intNumObjects Then                'If intNumObjects is not zero
  413.         Wscript.Echo "Found " & intNumObjects & " objects."
  414.         objRecordSet.MoveFirst
  415.         k = 1
  416.         While Not objRecordSet.EOF
  417.             For i = 0 To objRecordSet.Fields.Count - 1
  418.                 intUBound = UBound(objRecordSet.Fields(i).Value)
  419.  
  420.                 If Err.Number Then
  421.                     'This means that it is a single valued property.
  422.                     Err.Clear
  423.                     strMessage = objRecordSet.Fields(i).Name & " " & k & " = " _
  424.                         & objRecordSet.Fields(i).Value
  425.                 Else                            'It is a multivalued property.
  426.                     If intUBound = 0 Then        'There is only one implemented
  427.                         strMessage = objRecordSet.Fields(i).Name & " " & k & " = " _
  428.                             & objRecordSet.Fields(i).Value(0)
  429.                     Else                        'It is truely multivalued.
  430.                         strMessage = objRecordSet.Fields(i).Name & " " & k
  431.                         For j = 0 to intUBound
  432.                             strMessage = strMessage & vbCRLF & "     " & j+1 & " " _
  433.                                 & objRecordSet.Fields(i).Value(j)
  434.                         Next
  435.                     End If
  436.                 End If
  437.                 WriteLine strMessage, objOutputFile
  438.             Next
  439.             objRecordSet.MoveNext
  440.             k = k + 1
  441.         Wend
  442.     Else
  443.         Wscript.Echo "No object satisfying the criteria has been found within " _
  444.             & strADsPath & "."
  445.     End If
  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 if blnQuiet = False.
  473. '* Input:   strMessage      the string to print
  474. '* Output:  strMessage is printed on screen if blnQuiet = False.
  475. '*
  476. '********************************************************************
  477.  
  478. Sub Print(ByRef strMessage)
  479.     If Not blnQuiet then
  480.         Wscript.Echo  strMessage
  481.     End If
  482. End Sub
  483.  
  484. '********************************************************************
  485. '*
  486. '* Function FormatProvider
  487. '* Purpose: Formats Provider so it is not case sensitive
  488. '* Input:   Provider    a string
  489. '* Output:  FormatProvider is the Provider with the correct Case
  490. '*
  491. '********************************************************************
  492.  
  493. Private Function FormatProvider(Provider)
  494.     FormatProvider = ""
  495.     I = 1
  496.     Do Until Mid(Provider, I, 1) = ":"
  497.         If I = Len(Provider) Then
  498.             'This Provider is Probabaly not valid, but we'll let it pass anyways.
  499.             FormatProvider = Provider
  500.             Exit Function
  501.         End If
  502.         I = I + 1
  503.     Loop
  504.  
  505.     Select Case LCase(Left(Provider, I - 1))
  506.         Case "winnt"
  507.             FormatProvider = "WinNT" & Right(Provider,Len(Provider) - (I - 1))
  508.         Case "ldap"
  509.             FormatProvider = "LDAP" & Right(Provider,Len(Provider) - (I - 1))            
  510.     End Select
  511.  
  512.  
  513. End Function
  514.  
  515.  
  516. '********************************************************************
  517. '*                                                                  *
  518. '*                           End of File                            *
  519. '*                                                                  *
  520. '********************************************************************
  521.  
  522. '********************************************************************
  523. '*
  524. '* Procedures calling sequence: SEARCH.VBS
  525. '*
  526. '*    intParseCmdLine
  527. '*    ShowUsage
  528. '*    Search
  529. '*        intExecuteSearch
  530. '*            WriteLine
  531. '*
  532. '********************************************************************
  533.  
  534. '********************************************************************
  535.