home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 Special / chip-cd_2001_spec_05.zip / spec_05 / compmgmt.cab / ModifyLDAP.vbs < prev    next >
Text File  |  1999-11-04  |  42KB  |  1,124 lines
  1.  
  2. '********************************************************************
  3. '*
  4. '* File:        MODIFYLDAP.VBS
  5. '* Created:     January 1999
  6. '* Version:     1.0
  7. '*
  8. '* Main Function: Modifies LDAP Parameters.
  9. '* Usage: MODIFYLDAP.VBS /A|T|C|D|M|P|R [/O:policy] [property1:propertyvalue1]
  10. '*        [property2:propertyvalue2 ...] [/U:username] [/W:password] [/S:server|site] [/Q]
  11. '*
  12. '* Copyright (C) 1999 Microsoft Corporation
  13. '*
  14. '********************************************************************
  15.  
  16. OPTION EXPLICIT
  17. ON ERROR RESUME NEXT
  18.  
  19. 'Define constants
  20. CONST CONST_STRING_NOT_FOUND            = -1
  21. CONST CONST_ERROR                       = 0
  22. CONST CONST_WSCRIPT                     = 1
  23. CONST CONST_CSCRIPT                     = 2
  24. CONST CONST_SHOW_USAGE                  = 3
  25. CONST CONST_PROCEED                     = 4
  26. CONST CONST_MODIFY                      = 5
  27. CONST CONST_CREATE                      = 6
  28. CONST CONST_DELETE                      = 7
  29. CONST CONST_ASSIGN                      = 8
  30. CONST CONST_PRINT                       = 9
  31. CONST CONST_SITE                        = 10
  32. CONST CONST_REMOVE                      = 11
  33.  
  34.  
  35. CONST ADS_OBJECT_NOTFOUND               = &H80072030
  36. CONST ADS_OBJECT_EXISTS                 = &H80071392
  37. CONST ADS_PROPERTY_CLEAR                = 1
  38. CONST ADS_PROPERTY_UPDATE               = 2
  39. CONST ADS_PROPERTY_APPEND               = 3
  40. CONST ADS_PROPERTY_DELETE               = 4
  41.  
  42. 'Declare variables
  43. Dim strDomain, strFile, strCurrentUser, strPassword, strPolicy, strServer, blnQuiet, intOpMode, i
  44. ReDim strArgumentArray(0), strPropertyArray(0), strPropertyValueArray(0)
  45.  
  46. 'Initialize variables
  47. intOpMode = 0
  48. blnQuiet = False
  49. strPolicy = ""
  50. strFile = ""
  51. strCurrentUser = ""
  52. strPassword = ""
  53. strServer = ""
  54. strArgumentArray(0) = ""
  55. strPropertyArray(0) = ""
  56. strPropertyValueArray(0) = ""
  57.  
  58. 'Get the command line arguments
  59. For i = 0 to Wscript.arguments.count - 1
  60.     ReDim Preserve strArgumentArray(i)
  61.     strArgumentArray(i) = Wscript.arguments.item(i)
  62. Next
  63.  
  64. 'Check whether the script is run using CScript
  65. Select Case intChkProgram()
  66.     Case CONST_CSCRIPT
  67.         'Do Nothing
  68.     Case CONST_WSCRIPT
  69.         WScript.Echo "Please run this script using CScript." & vbCRLF & _
  70.             "This can be achieved by" & vbCRLF & _
  71.             "1. Using ""CScript MODIFYLDAP.vbs arguments"" for Windows 95/98 or" & vbCRLF & _
  72.             "2. Changing the default Windows Scripting Host setting to CScript" & vbCRLF & _
  73.             "    using ""CScript //H:CScript //S"" and running the script using" & vbCRLF & _
  74.             "    ""MODIFYLDAP.vbs arguments"" for Windows NT."
  75.         WScript.Quit
  76.     Case Else
  77.         WScript.Quit
  78. End Select
  79.  
  80. 'Parse the command line
  81. intOpMode = intParseCmdLine(strArgumentArray, strPolicy, strFile, strCurrentUser,_
  82.         strPassword, blnQuiet, strServer, strPropertyArray, strPropertyValueArray)
  83. If Err.Number Then
  84.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line."
  85.     If Err.Description <> "" Then  Print "Error description: " & Err.Description & "."
  86.     WScript.quit
  87. End If
  88.  
  89. Select Case intOpMode
  90.     Case CONST_SHOW_USAGE
  91.         Call ShowUsage()
  92.     Case CONST_CREATE
  93.         Call CREATELDAP(strPolicy, strCurrentUser, strPassword, strPropertyArray, strPropertyValueArray, blnQuiet)
  94.     Case CONST_MODIFY
  95.         Call MODIFYLDAP(strPolicy, strFile, strCurrentUser,_
  96.              strPassword, blnQuiet, strPropertyArray, strPropertyValueArray)
  97.     Case CONST_DELETE
  98.         Call DELETELDAP(strPolicy, strCurrentUser, strPassword, blnQuiet)
  99.     Case CONST_ASSIGN
  100.         Call ASSIGNLDAP(strPolicy, strServer, strCurrentUser, strPassword, blnQuiet)
  101.     Case CONST_PRINT
  102.         Call PRINTLDAP(strPolicy, strFile, strCurrentUser, strPassword, blnQuiet)
  103.     Case CONST_REMOVE
  104.         Call REMOVELDAP(strServer, strCurrentUser, strPassword, blnQuiet)
  105.     Case CONST_ERROR
  106.         'Do nothing.
  107.     Case Else
  108.         Wscript.Echo "Error occurred in passing parameters."
  109. End Select
  110.  
  111. WScript.Quit
  112.  
  113. '********************************************************************
  114. '*
  115. '* Function intChkProgram()
  116. '* Purpose: Determines which program is used to run this script.
  117. '* Input:   None
  118. '* Output:  intChkProgram is set to one of CONST_ERROR, CONST_WSCRIPT,
  119. '*          and CONST_CSCRIPT.
  120. '*
  121. '********************************************************************
  122.  
  123. Private Function intChkProgram()
  124.  
  125.     ON ERROR RESUME NEXT
  126.  
  127.     Dim strFullName, strCommand, i, j
  128.  
  129.     'strFullName should be something like C:\WINDOWS\COMMAND\CSCRIPT.EXE
  130.     strFullName = WScript.FullName
  131.     If Err.Number then
  132.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred."
  133.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  134.         intChkProgram =  CONST_ERROR
  135.         Exit Function
  136.     End If
  137.  
  138.     i = InStr(1, strFullName, ".exe", 1)
  139.     If i = 0 Then
  140.         intChkProgram =  CONST_ERROR
  141.         Exit Function
  142.     Else
  143.         j = InStrRev(strFullName, "\", i, 1)
  144.         If j = 0 Then
  145.             intChkProgram =  CONST_ERROR
  146.             Exit Function
  147.         Else
  148.             strCommand = Mid(strFullName, j+1, i-j-1)
  149.             Select Case LCase(strCommand)
  150.                 Case "cscript"
  151.                     intChkProgram = CONST_CSCRIPT
  152.                 Case "wscript"
  153.                     intChkProgram = CONST_WSCRIPT
  154.                 Case Else       'should never happen
  155.                     Print "An unexpected program is used to run this script."
  156.                     Print "Only CScript.Exe or WScript.Exe can be used to run this script."
  157.                     intChkProgram = CONST_ERROR
  158.             End Select
  159.         End If
  160.     End If
  161.  
  162. End Function
  163.  
  164. '********************************************************************
  165. '*
  166. '* Function intParseCmdLine()
  167. '* Purpose: Parses the command line.
  168. '* Input:   strArgumentArray    an array containing input from the command line
  169. '* Output:  strPolicy           the name of the policy object
  170. '*          strFile             the input file name including the path
  171. '*          strCurrentUser      the name or cn of the current user
  172. '*          strPassword         the current user password
  173. '*          blnQuiet            specifies whether to suppress messages
  174. '*          strServer           server name
  175. '*          strPropertyArray    an array of ldap parameters
  176. '*          strPropertyValueArray    an array of the corresponding ldap parameter values
  177. '*          intParseCmdLine     is set to one of CONST_ERROR, CONST_SHOW_USAGE, CONST_PROCEED.
  178. '*
  179. '********************************************************************
  180.  
  181. Private Function intParseCmdLine(strArgumentArray, strPolicy, strFile, strCurrentUser,_
  182.         strPassword, blnQuiet, strServer, strPropertyArray, strPropertyValueArray)
  183.  
  184.     ON ERROR RESUME NEXT
  185.  
  186.     Dim i, j, strFlag
  187.  
  188.     intParseCmdLine = CONST_ERROR
  189.  
  190.     strFlag = strArgumentArray(0)
  191.     If strFlag = "" then                    'No arguments have been received
  192.         Print "Arguments are required."
  193.         intParseCmdLine = CONST_ERROR
  194.         Exit Function
  195.     End If
  196.  
  197.     'online help was requested
  198.     If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
  199.         OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then
  200.         intParseCmdLine = CONST_SHOW_USAGE
  201.         Exit Function
  202.     End If
  203.  
  204.     j = 0
  205.     For i = 0 to UBound(strArgumentArray)
  206.         strFlag = Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)
  207.         If Err.Number Then            'An error occurs if there is no : in the string
  208.             Err.Clear
  209.             Select Case LCase(strArgumentArray(i))
  210.                 Case "/q" 
  211.                   blnQuiet = True
  212.                 Case "/a"
  213.                   intParseCmdLine = CONST_ASSIGN
  214.                 Case "/d"
  215.                   intParseCmdLine = CONST_DELETE
  216.                 Case "/m"
  217.                   intParseCmdLine = CONST_MODIFY
  218.                 Case "/c"
  219.                   intParseCmdLine = CONST_CREATE
  220.                 Case "/p"
  221.                   intParseCmdLine = CONST_PRINT
  222.                 Case "/r"
  223.                   intParseCmdLine = CONST_REMOVE
  224.                 Case Else
  225.                   Print strArgumentArray(i) & " is not recognized as a valid input."
  226.                   intParseCmdLine = CONST_ERROR
  227.                   Exit Function
  228.             End Select 'end processing args that have no params
  229.  
  230.         Else
  231.             Select Case LCase(strFlag)
  232.                 Case "/o" 
  233.                     strPolicy = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  234.                 Case "/f"
  235.                     strFile = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  236.                 Case "/u"
  237.                     strCurrentUser = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  238.                 Case "/w"
  239.                     strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  240.                 Case "/s"
  241.                     strServer = Right(strArgumentArray(i), Len(strArgumentArray(i))-3)
  242.                 Case else
  243.                     ReDim Preserve strPropertyArray(j), strPropertyValueArray(j)
  244.                     strPropertyArray(j) = strFlag
  245.                     strPropertyValueArray(j) = Right(strArgumentArray(i), _
  246.                         Len(strArgumentArray(i))-InStr(1, strArgumentArray(i), ":"))
  247.                     If strPropertyValueArray(j) = ""  Then
  248.                         Print "Warning: property " & strFlag & " does not have a value!"
  249.                     End If
  250.                     j = j + 1
  251.             End Select
  252.         End If
  253.     Next
  254.  
  255.  
  256.     If ((strPolicy = "") And (intParseCmdLine <> CONST_REMOVE)) Then 
  257.           print "The name of the policy object is missing."
  258.           intParseCmdLine = CONST_ERROR
  259.           Exit Function
  260.     End If
  261.  
  262.     If ((strServer = "") And ((intParseCmdLine = CONST_REMOVE) Or (intParseCmdLine = CONST_ASSIGN))) Then 
  263.           print "The name of the site or server is missing."
  264.           intParseCmdLine = CONST_ERROR
  265.           Exit Function
  266.     End If
  267.  
  268. End Function
  269.  
  270. '********************************************************************
  271. '*
  272. '* Sub ShowUsage()
  273. '* Purpose:   Shows the correct usage to the user.
  274. '* Input:     None
  275. '* Output:    Help messages are displayed on screen.
  276. '*
  277. '********************************************************************
  278.  
  279. Sub ShowUsage()
  280.  
  281.     Wscript.echo ""
  282.     Wscript.echo "Modifies LDAP policies."  & vbCRLF
  283.     Wscript.echo "MODIFYLDAP.VBS [/A|T|C|D|M|P|R] /O:Policy [/F:filename] [property1:propertyvalue1]" 
  284.     Wscript.echo "[property2:propertyvalue2...] [/U:username] [/W:password] [/S:server] [/Q]"
  285.     Wscript.echo " command line switches:"
  286.     WScript.echo "   /C             Create a new query policy."
  287.     Wscript.echo "   /D             Delete an existing query policy."
  288.     Wscript.echo "   /M             Modify an existing query policy."
  289.     Wscript.echo "   /A             Assign a policy to a site or server."
  290.     Wscript.echo "   /R             Remove a policy from a site or server."
  291.     Wscript.echo "   /P             Display the LDAP Admin limits for a query policy."
  292.     Wscript.echo "   /Q             Quiet mode." 
  293.     Wscript.echo "   /? /H /HELP    Displays this help message."
  294.     Wscript.echo "   property1:propertyvalue1...property[i], propertyvalue[i]"
  295.     WScript.echo "                  Name and value of ldap parameters."
  296.     Wscript.echo " command line parameters:"
  297.     Wscript.echo "   /F:filename   valid filename." 
  298.     Wscript.echo "   /U:username    Username."
  299.     Wscript.echo "   /W:password    Password."
  300.     WScript.echo "   /S:server      Name of domain controller or site."
  301.     WScript.echo "   /O:policy      Name of Policy object."
  302.     Wscript.echo "EXAMPLES:"
  303.     Wscript.echo "MODIFYLDAP.VBS /C /O:NewPolicy ConnectionTimeOut:1000"
  304.     Wscript.echo "   Creates a policy named NewPolicy with ConnectionTimeOut=1000"
  305.     WScript.echo "   and defaults for remainder." 
  306.     Wscript.echo "MODIFYLDAP.VBS /D /O:NewPolicy"
  307.     Wscript.echo "   Deletes the LDAP Policy NewPolicy."
  308.     Wscript.echo "MODIFYLDAP.VBS /M /O:NewPolicy InitRecvTimeout:200"
  309.     Wscript.echo "   Modifies the LDAP Policy NewPolicy setting InitRecvTimeout value to 200."
  310.     Wscript.echo "MODIFYLDAP.VBS /A /O:NewPolicy /S:Wombat"
  311.     Wscript.echo "   Assigns the LDAP Policy NewPolicy to the server called Wombat."
  312.     Wscript.echo "MODIFYLDAP.VBS /R wombat"
  313.     Wscript.echo "   Removes the LDAP Policy associated with the site Timbucktoo."
  314.     Wscript.echo "MODIFYLDAP.VBS /P /O:NewPolicy"
  315.     Wscript.echo "   Displays the current settings for the LDAP Policy NewPolicy."
  316.  
  317.  
  318. End Sub
  319.  
  320. '********************************************************************
  321. '*
  322. '* Sub MODIFYLDAP()
  323. '* Purpose: Modifies an existing policy object.
  324. '* Input:   strPolicy           the name of the policy object
  325. '*          strFile             the input file name including the path
  326. '*          strCurrentUser      the name or cn of the current user
  327. '*          strPassword         the current user password
  328. '*          blnQuiet            specifies whether to suppress messages
  329. '*          strPropertyArray    an array of ldap properties names
  330. '*          strPropertyValueArray    an array of the corresponding ldap property values
  331. '* Output:  None
  332. '*
  333. '********************************************************************
  334.  
  335. Sub MODIFYLDAP(strPolicy, strFile, strCurrentUser,_
  336.     strPassword, blnQuiet, strPropertyArray, strPropertyValueArray)
  337.  
  338.     ON ERROR RESUME NEXT
  339.  
  340.     Dim objDomain, strUser, objPolicy, i, j, objFileSystem, objInputFile, strInput
  341.     Dim blnResult, strConfig, objProvider, arrLimits
  342.  
  343.     Set objDomain = GetObject("LDAP://RootDSE")
  344.     strConfig = objDomain.Get("configurationNamingContext")
  345.     Set objDomain=Nothing
  346.    
  347.     If Err.Number then
  348.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting config nc."
  349.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  350.         Err.Clear
  351.         Exit Sub
  352.     End If
  353.  
  354.     If strCurrentUser = "" Then            'no user credential is passed
  355.         Set objDomain = GetObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," & strConfig)
  356.     Else
  357.         Set objProvider = GetObject("LDAP:")
  358.         'Use user authentication
  359.         Set objDomain = objProvider.OpenDsObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," _
  360.                            & strConfig,strCurrentUser,strPassword,1)
  361.     End If
  362.     If Err.Number then
  363.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " _
  364.         & strPolicy & "."
  365.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  366.     Err.Clear
  367.         Exit Sub
  368.     End If
  369.  
  370.     'read the ldap admin limits into an array
  371.     Set objPolicy = objDomain.GetObject("queryPolicy","cn=" &  strPolicy)
  372.     If Err.Number then
  373.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " _
  374.         & strPolicy & "."
  375.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  376.     Err.Clear
  377.         Exit Sub
  378.     End If
  379.  
  380.     
  381.     arrLimits = objPolicy.ldapAdminLimits
  382.  
  383.     For j = LBound(StrPropertyArray) to UBound(StrPropertyArray)
  384.        i = intSearchArray(strPropertyArray(j), arrLimits)
  385.        if i <> -1 Then arrLimits(i) = strPropertyArray(j) & "=" & strPropertyValueArray(j)
  386.     Next
  387.  
  388.     If i <> -1 Then
  389.        objPolicy.PutEx ADS_PROPERTY_UPDATE, "ldapAdminLimits", arrLimits
  390.        objPolicy.Setinfo
  391.        If Err.Number then
  392.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in setting object " & strPolicy & "."
  393.         If Err.Description <> "" Then    Print "Error description: " & Err.Description & "."
  394.         Err.Clear
  395.             Exit Sub
  396.     Else
  397.             Print strPolicy & " updated"
  398.     End If
  399.  
  400.     Else
  401.     Print strPolicy & " not updated due to incorrect LDAP Query parameters"
  402.     End If
  403.  
  404.     Set objPolicy = Nothing
  405.     Set objDomain = Nothing
  406.  
  407. End Sub
  408.  
  409.  
  410.  
  411. '********************************************************************
  412. '*
  413. '* Sub PRINTLDAP()
  414. '* Purpose: Prints the LDAP parameters of a LDAP policy object.
  415. '* Input:   strPolicy           the ADsPath of the domain
  416. '*          strFile             the file name to print the data
  417. '*          strCurrentUser      the name or cn of the current user
  418. '*          strPassword         the current user password
  419. '*          blnQuiet            specifies whether to suppress messages
  420. '* Output:  None
  421. '*
  422. '********************************************************************
  423.  
  424. Sub PRINTLDAP(strPolicy, strFile, strCurrentUser, strPassword, blnQuiet)
  425.  
  426.     ON ERROR RESUME NEXT
  427.  
  428.     Dim  objDomain, objProvider, strConfig, objPolicy, i, objFileSystem, objOutputFile, strInput
  429.     Dim blnResult, arrLimits
  430.  
  431.  
  432.     If strFile <> "" Then
  433.         'Create a filesystem object
  434.         set objFileSystem = CreateObject("Scripting.FileSystemObject")
  435.         If Err.Number Then
  436.             Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating a filesystem object."
  437.             If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  438.             Exit Sub
  439.         End If
  440.  
  441.         'Opens a file for output
  442.         set objOutputFile = objFileSystem.OpenTextFile(strFile,2,True)
  443.         If Err.Number Then
  444.             Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in opening file " & strFile
  445.             If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  446.             Exit Sub
  447.         End If
  448.     End If
  449.  
  450.  
  451.     Set objDomain = GetObject("LDAP://RootDSE")
  452.     strConfig = objDomain.Get("configurationNamingContext")
  453.     Set objDomain=Nothing
  454.    
  455.     If Err.Number then
  456.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting configuration container."
  457.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  458.     Err.Clear
  459.         Exit Sub
  460.     End If
  461.  
  462.     If strCurrentUser = "" Then            'no user credential is passed
  463.         Set objDomain = GetObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," & strConfig)
  464.     Else
  465.         Set objProvider = GetObject("LDAP:")
  466.         'Use user authentication
  467.         Set objDomain = objProvider.OpenDsObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," _
  468.                            & strConfig,strCurrentUser,strPassword,1)
  469.     End If
  470.     If Err.Number then
  471.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " & strPolicy & "."
  472.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  473.     Err.Clear
  474.         Exit Sub
  475.     End If
  476.  
  477. '*** Query all not supported yet ***
  478. '
  479. '    If blnAll Then        'retrieve all policy objects
  480. '    objDomain.Filter= Array("queryPolicy")
  481. '        For Each objPolicy in ObjDomain
  482. '            print objPolicy.cn
  483. '            If strFile <> "" Then objOutputFile.WriteLine objPolicy.cn
  484. '            arrLimits = objPolicy.ldapAdminLimits
  485. '            For i = LBound(arrLimits) to UBound(arrLimits)
  486. '               print arrLimits(i)
  487. '               If strFile <> "" Then objOutputFile.WriteLine arrLimits(i)
  488. '            Next
  489. '        Next
  490. '    Else                  'retrieve specified policy object
  491.  
  492.     Set objPolicy = objDomain.GetObject("queryPolicy","cn=" &  strPolicy)
  493.     If Err.Number then
  494.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " & strPolicy & "."
  495.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  496.         Err.Clear
  497.         Exit Sub
  498.     End If
  499.  
  500.     print "LDAP Settings for " & objPolicy.cn
  501.     If strFile <> "" Then objOutputFile.WriteLine objPolicy.cn
  502.     arrLimits = objPolicy.ldapAdminLimits
  503.     For i = LBound(arrLimits) to UBound(arrLimits)
  504.          print arrLimits(i)
  505.          If strFile <> "" Then objOutputFile.WriteLine arrLimits(i)
  506.     Next
  507.  
  508.     Set objPolicy = Nothing
  509.     Set objDomain = Nothing
  510.  
  511.     If strFile <> "" Then 
  512.             objOutputFile.Close
  513.     End If
  514.  
  515. End Sub
  516.  
  517.  
  518. '********************************************************************
  519. '*
  520. '* Sub ASSIGNLDAP()
  521. '* Purpose: ASSIGNS LDAP policy object to a domain controller
  522. '* Input:   strPolicy           the ADsPath of the domain
  523. '*          strServer           The name of the domain controller
  524. '*          strCurrentUser      the name or cn of the current user
  525. '*          strPassword         the current user password
  526. '*          blnQuiet            specifies whether to suppress messages
  527. '* Output:  None
  528. '*
  529. '********************************************************************
  530.  
  531. Sub ASSIGNLDAP(strPolicy, strServer, strCurrentUser, strPassword, blnQuiet)
  532.     ON ERROR RESUME NEXT
  533.  
  534.     Dim  objDomain, strConfig, objPolicy, strADSPath, objServer, blnSite
  535.     Dim  objProvider, strCriteria, strPolicyPath, strClass, objNTDSSettings
  536.  
  537.  
  538.     Set objDomain = GetObject("LDAP://RootDSE")
  539.     strConfig = objDomain.Get("configurationNamingContext")
  540.     Set objDomain=Nothing
  541.    
  542.     If Err.Number then
  543.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting configuration container."
  544.     If Err.Description <> "" Then    Print "Error description: " & Err.Description & "."
  545.     Err.Clear
  546.         Exit Sub
  547.     End If
  548.  
  549.     If strCurrentUser = "" Then            'no user credential is passed
  550.         Set objDomain = GetObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," & strConfig)
  551.     Else
  552.         Set objProvider = GetObject("LDAP:")
  553.         'Use user authentication
  554.         Set objDomain = objProvider.OpenDsObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," _
  555.                            & strConfig,strCurrentUser,strPassword,1)
  556.     End If
  557.     If Err.Number then
  558.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting query policy container."
  559.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  560.     Err.Clear
  561.         Exit Sub
  562.     End If
  563.  
  564.     Set objPolicy = objDomain.GetObject("queryPolicy","cn=" &  strPolicy)
  565.     If Err.Number then
  566.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " & strPolicy & "."
  567.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  568.     Err.Clear
  569.         Exit Sub
  570.     End If
  571.  
  572.     strPolicyPath = objPolicy.distinguishedName
  573.     
  574.     Set objPolicy = Nothing
  575.     Set objDomain = Nothing
  576.     Set ObjProvider = Nothing
  577.  
  578.     strCriteria = "(&(|(objectClass=site)(objectClass=server))(cn=" & strServer & "))"
  579.         
  580.     if blnSearchForServer(strServer, strConfig, strCurrentUser, strPassword, strCriteria, strADSPath, strClass) Then
  581.         For i = LBound(strClass) to UBound(strClass)
  582.              If InStr(1, strClass(i), "site",1) then 
  583.             blnSite = True
  584.             Exit For
  585.            End If  
  586.         Next
  587.          
  588.         If strCurrentUser = "" Then            'no user credential is passed
  589.             Set objServer = GetObject(strADSPath)
  590.     Else
  591.             Set objProvider = GetObject("LDAP:")
  592.         'Use user authentication
  593.             Set objServer = objProvider.OpenDsObject(strADSPath,strCurrentUser,strPassword,1)
  594.     End If
  595.         If Err.Number then
  596.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " & strADSPath & "."
  597.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  598.         Err.Clear
  599.             Exit Sub
  600.         End If
  601.  
  602.         If blnSite Then
  603.             Set objNTDSSettings = objServer.GetObject("nTDSSiteSettings", "cn=NTDS Site Settings")
  604.         Else
  605.              Set objNTDSSettings = objServer.GetObject("nTDSDSA", "cn=NTDS Settings")
  606.         End If
  607.         If Err.Number then
  608.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting NTDS object " & strADSPath & "."
  609.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  610.         Err.Clear
  611.             Exit Sub
  612.         End If
  613.  
  614.         objNTDSSettings.Put "queryPolicyObject", strPolicyPath
  615.         objNTDSSettings.SetInfo
  616.  
  617.         If Err.Number then
  618.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in setting NTDSDSDA object."
  619.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  620.         Err.Clear
  621.                 Print "Server " & strServer & " was not updated"
  622.             Exit Sub
  623.         Else
  624.            Print "Server " & strServer & " was updated"
  625.         End If
  626.     Else
  627.        Print "Server " & strServer & " was not found"
  628.     End If
  629.  
  630.     Set objNTDSSettings = Nothing
  631.     Set objServer = Nothing
  632.     
  633. End Sub
  634.  
  635.  
  636. '********************************************************************
  637. '*
  638. '* Sub CREATELDAP()
  639. '* Purpose: Creates a new LDAP policy object.
  640. '* Input:   strPolicy           the name of the policy object
  641. '*          strCurrentUser      the name or cn of the current user
  642. '*          strPassword         the current user password
  643. '*          strPropertyArray    array of ldap parameters
  644. '*          strPropertyValueArray array of ldap parameter values
  645. '*          blnQuiet            specifies whether to suppress messages
  646. '* Output:  None
  647. '*
  648. '********************************************************************
  649.  
  650. Sub CREATELDAP(strPolicy, strCurrentUser, strPassword, strPropertyArray, strPropertyValueArray, blnQuiet)
  651.  
  652.     ON ERROR RESUME NEXT
  653.  
  654.     Dim  objDomain, objProvider, strConfig, objPolicy, i, j, arrLimits
  655.  
  656.     Redim arrLimits(11)
  657.  
  658.     'these are the current defaults
  659.  
  660.     arrLimits(0) = "MaxConnections=1000"
  661.     arrLimits(1) = "MaxDatagramRecv=1024"
  662.     arrLimits(2) = "MaxPoolThreads=4"
  663.     arrLimits(3) = "MaxResultSetSize=262144"
  664.     arrLimits(4) = "MaxTempTableSize=10000"
  665.     arrLimits(5) = "MaxQueryDuration=120"
  666.     arrLimits(6) = "MaxPageSize=1000"
  667.     arrLimits(7) = "MaxNotificationPerConn=5"
  668.     arrLimits(8) = "MaxActiveQueries=20"
  669.     arrLimits(9) = "MaxConnIdleTime=900"
  670.     arrLimits(10) = "AllowDeepNonIndexSearch=False"
  671.     arrLimits(11) = "InitRecvTimeout=120"
  672.  
  673.         
  674.     If Not IsNull(strPropertyArray) Then 
  675.       For j = LBound(StrPropertyArray) to UBound(StrPropertyArray)
  676.          i = intSearchArray(strPropertyArray(j), arrLimits)
  677.          If i <> -1 Then 
  678.              arrLimits(i) = strPropertyArray(j) & "=" & strPropertyValueArray(j)
  679.          Else
  680.              print "Invalid LDAP parameter: " & strPropertyArray(j) & " ,using correct default values"
  681.          End If
  682.       Next
  683.     End If
  684.  
  685.  
  686.     Set objDomain = GetObject("LDAP://RootDSE")
  687.     strConfig = objDomain.Get("configurationNamingContext")
  688.     Set objDomain=Nothing
  689.    
  690.     If Err.Number then
  691.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting configuration container."
  692.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  693.     Err.Clear
  694.         Exit Sub
  695.     End If
  696.  
  697.     If strCurrentUser = "" Then            'no user credential is passed
  698.         Set objDomain = GetObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," & strConfig)
  699.     Else
  700.         Set objProvider = GetObject("LDAP:")
  701.         'Use user authentication
  702.         Set objDomain = objProvider.OpenDsObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," _
  703.                            & strConfig,strCurrentUser,strPassword,1)
  704.     End If
  705.     If Err.Number then
  706.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting query policy container. "
  707.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  708.     Err.Clear
  709.         Exit Sub
  710.     End If
  711.  
  712.     Set objPolicy = objDomain.Create("queryPolicy","cn=" &  strPolicy)
  713.     objPolicy.PutEx  ADS_PROPERTY_UPDATE, "lDAPAdminLimits", arrLimits
  714.     objPolicy.SetInfo
  715.     If Err.Number then
  716.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating " & strPolicy & "."
  717.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  718.     Err.Clear
  719.         Exit Sub
  720.     End If
  721.     
  722.     Set objPolicy = Nothing
  723.     Set objDomain = Nothing
  724.  
  725.     Print "Created policy " & strPolicy
  726.  
  727. End Sub
  728.  
  729. '********************************************************************
  730. '*
  731. '* Sub DELETEDAP()
  732. '* Purpose: Deletes a LDAP policy object.
  733. '* Input:   strPolicy           the name of the policy object
  734. '*          strCurrentUser      the name or cn of the current user
  735. '*          strPassword         the current user password
  736. '*          blnQuiet            specifies whether to suppress messages
  737. '* Output:  None
  738. '*
  739. '********************************************************************
  740.  
  741. Sub DELETELDAP (strPolicy, strCurrentUser, strPassword, blnQuiet)
  742.     ON ERROR RESUME NEXT
  743.  
  744.     Dim  objDomain, objProvider, strConfig, objPolicy 
  745.  
  746.  
  747.     Set objDomain = GetObject("LDAP://RootDSE")
  748.     strConfig = objDomain.Get("configurationNamingContext")
  749.     Set objDomain=Nothing
  750.    
  751.     If Err.Number then
  752.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting configuration container."
  753.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  754.     Err.Clear
  755.         Exit Sub
  756.     End If
  757.  
  758.     If strCurrentUser = "" Then            'no user credential is passed
  759.         Set objDomain = GetObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," & strConfig)
  760.     Else
  761.         Set objProvider = GetObject("LDAP:")
  762.         'Use user authentication
  763.         Set objDomain = objProvider.OpenDsObject("LDAP://CN=Query-Policies,CN=Directory Service,CN=Windows NT,CN=Services," _
  764.                            & strConfig,strCurrentUser,strPassword,1)
  765.     End If
  766.     If Err.Number then
  767.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting query policy container."
  768.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  769.     Err.Clear
  770.         Exit Sub
  771.     End If
  772.  
  773.  
  774.     Set objPolicy = objDomain.GetObject("queryPolicy","cn=" &  strPolicy)
  775.     If Err.Number then
  776.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " & strPolicy & "."
  777.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  778.     Err.Clear
  779.         Exit Sub
  780.     End If
  781.  
  782.     if Not blnCheckForQueryPolicy(objPolicy.distinguishedName, strConfig, strCurrentUser, strPassword) Then
  783.         Print "Domain controllers or Sites are referencing the policy object " & strPolicy 
  784.         Print "Cannot delete policies if they are in use by any domain controllers or sites"
  785.         Exit Sub
  786.     End If
  787.  
  788.  
  789.     objDomain.Delete "queryPolicy","cn=" &  strPolicy
  790.     If Err.Number then
  791.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred deleting object "    & strPolicy & "."
  792.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  793.     Err.Clear
  794.         Exit Sub
  795.     End If
  796.     
  797.     Set objPolicy = Nothing    
  798.     Set objDomain = Nothing
  799.     
  800.     Print "Policy " & strPolicy & " deleted" 
  801.  
  802. End Sub
  803.  
  804. '********************************************************************
  805. '*
  806. '* Sub REMOVELDAP()
  807. '* Purpose: Removes a query policy reference from a site or server.
  808. '* Input:   strServer           the name of the site or server
  809. '*          strCurrentUser      the name or cn of the current user
  810. '*          strPassword         the current user password
  811. '*          blnQuiet            specifies whether to suppress messages
  812. '* Output:  None
  813. '*
  814. '********************************************************************
  815.  
  816. Sub REMOVELDAP (strServer, strCurrentUser, strPassword, blnQuiet)
  817.  
  818.     ON ERROR RESUME NEXT
  819.  
  820.     Dim  objDomain, objProvider, objServer, strConfig, objPolicy, strClass
  821.     Dim  objNTDSSettings, strCriteria, strADSPath , i, blnSite
  822.  
  823.     blnSite = False
  824.  
  825.     Set objDomain = GetObject("LDAP://RootDSE")
  826.     strConfig = objDomain.Get("configurationNamingContext")
  827.     Set objDomain=Nothing
  828.    
  829.     If Err.Number then
  830.     Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting configuration container."
  831.     If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  832.     Err.Clear
  833.         Exit Sub
  834.     End If
  835.  
  836.     strCriteria = "(&(|(objectClass=site)(objectClass=server))(cn=" & strServer & "))"
  837.     
  838.     
  839.     if blnSearchForServer(strServer, strConfig, strCurrentUser, strPassword, strCriteria, strADSPath, strClass) Then
  840.  
  841.     For i = LBound(strClass) to UBound(strClass)
  842.       If InStr(1, strClass(i), "site",1) then 
  843.         blnSite = True
  844.         Exit For
  845.       End If  
  846.     Next
  847.     
  848.         If strCurrentUser = "" Then            'no user credential is passed
  849.             Set objServer = GetObject(strADSPath)
  850.     Else
  851.             Set objProvider = GetObject("LDAP:")
  852.         'Use user authentication
  853.             Set objServer = objProvider.OpenDsObject(strADSPath,strCurrentUser,strPassword,1)
  854.     End If
  855.         If Err.Number then
  856.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting object " & strADSPath & "."
  857.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  858.         Err.Clear
  859.             Exit Sub
  860.         End If
  861.         
  862.             
  863.         If blnSite Then
  864.             Set objNTDSSettings = objServer.GetObject("nTDSSiteSettings", "cn=NTDS Site Settings")
  865.         Else
  866.                 Set objNTDSSettings = objServer.GetObject("nTDSDSA", "cn=NTDS Settings")
  867.         End If
  868.         If Err.Number then
  869.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting NTDS object " & strADSPath & "."
  870.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  871.         Err.Clear
  872.             Exit Sub
  873.         End If
  874.  
  875.         objNTDSSettings.PutEx ADS_PROPERTY_CLEAR, "queryPolicyObject",""
  876.         objNTDSSettings.SetInfo
  877.  
  878.         If Err.Number then
  879.         Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in setting NTDSDSDA object."
  880.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  881.         Err.Clear
  882.                 Print "Server " & strServer & " was not reset"
  883.             Exit Sub
  884.         Else
  885.            Print "Server " & strServer & " was reset"
  886.         End If
  887.     Else
  888.        Print "Server " & strServer & " was not found"
  889.     End If
  890.  
  891.     Set objNTDSSettings = Nothing
  892.     Set objServer = Nothing
  893.     Set objDomain = Nothing
  894.     
  895. End Sub
  896.  
  897.  
  898.  
  899.  
  900. '********************************************************************
  901. '* Function blnCheckForQueryPolicy()
  902. '* 
  903. '* Purpose: query domain controllers to see if they are using the policy
  904. '* Input:     adspath     path of the policy
  905. '*        strSearchpath    base search should be config nc
  906. '*        strCurrentUser    username
  907. '*        strPassword    password
  908. '*  blnCheckForQueryPolicy returns True if servers are not using policy
  909. '*
  910. '********************************************************************
  911.  
  912. Function blnCheckForQueryPolicy(ADSPath, strSearchPath, strCurrentUser, strPassword)
  913.  
  914. ON ERROR RESUME NEXT
  915.  
  916. Dim objConnect, objCommand, objRecordSet, intResult
  917. Dim strProperties, strScope, strCriteria, strCommand
  918.  
  919.  
  920. blnCheckForQueryPolicy = False
  921. strScope = "SubTree"
  922. strProperties = "cn"
  923. strCriteria = "(&(|(objectClass=nTDSDSA)(objectClass=nTDSSiteSettings))(queryPolicyObject=" & ADSPath & "))"
  924.  
  925.     Set objConnect = CreateObject("ADODB.Connection")
  926.     If Err.Number then
  927.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in opening a connection."
  928.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  929.         Exit Function
  930.     End If
  931.  
  932.     Set objCommand = CreateObject("ADODB.Command")
  933.     If Err.Number then
  934.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in creating the command object."
  935.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  936.         Exit Function
  937.     End If
  938.  
  939.     objConnect.Provider = "ADsDSOObject"
  940.     If strCurrentUser = "" then
  941.         objConnect.Open "Active Directory Provider"
  942.     Else
  943.         objConnect.Open "Active Directory Provider", strCurrentUser, strPassword
  944.     End If
  945.     If Err.Number then
  946.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred opening a provider."
  947.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  948.         Exit Function
  949.     End If
  950.  
  951.     Set objCommand.ActiveConnection = objConnect
  952.  
  953.     'Set the query string and other properties
  954.     strCommand = "<LDAP://" & strSearchPath & ">;" & strCriteria & ";" & strProperties & ";" & strScope
  955.     objCommand.CommandText  = strCommand
  956.     objCommand.Properties("Page Size") = 100000                    
  957.     objCommand.Properties("Timeout") = 300000 'seconds
  958.  
  959.  
  960.    Set objRecordSet = objCommand.Execute
  961.    If Err.Number then
  962.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred during the search."
  963.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  964.         Err.Clear
  965.         Exit Function
  966.    End If
  967.  
  968.    If objRecordSet.RecordCount = 0 Then blnCheckForQueryPolicy = True
  969.  
  970. End Function
  971.  
  972.  
  973. '********************************************************************
  974. '* Function blnSearchForServer()
  975. '* 
  976. '* Purpose: query config nc for requested domain controller
  977. '* Input:     strServer     server name
  978. '*        strSearchpath    base search should be config nc
  979. '*        strCurrentUser    username
  980. '*        strPassword    password
  981. '* Output:      strADSPath      ADS Path to the domain controller
  982. '*              strClass        Class of object
  983. '*  blnCheckForQUeryPolicy returns True if servers are not using policy
  984. '*
  985. '********************************************************************
  986.  
  987. Function blnSearchForServer(strServer, strSearchPath, strCurrentUser, strPassword, strCriteria, strADSPath, strClass)
  988.  
  989. ON ERROR RESUME NEXT
  990.  
  991. Dim objConnect, objCommand, objRecordSet, intResult
  992. Dim strProperties, strScope, strCommand
  993.  
  994.  
  995. blnSearchForServer = False
  996. strScope = "SubTree"
  997. strProperties = "ADSPath,objectClass"
  998.  
  999.  
  1000.     Set objConnect = CreateObject("ADODB.Connection")
  1001.     If Err.Number then
  1002.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in opening a connection."
  1003.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  1004.         Exit Function
  1005.     End If
  1006.  
  1007.     Set objCommand = CreateObject("ADODB.Command")
  1008.     If Err.Number then
  1009.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred in creating the command object."
  1010.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  1011.         Exit Function
  1012.     End If
  1013.  
  1014.     objConnect.Provider = "ADsDSOObject"
  1015.     If strCurrentUser = "" then
  1016.         objConnect.Open "Active Directory Provider"
  1017.     Else
  1018.         objConnect.Open "Active Directory Provider", strCurrentUser, strPassword
  1019.     End If
  1020.     If Err.Number then
  1021.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred opening a provider."
  1022.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  1023.         Exit Function
  1024.     End If
  1025.  
  1026.     Set objCommand.ActiveConnection = objConnect
  1027.  
  1028.     'Set the query string and other properties
  1029.     strCommand = "<LDAP://" & strSearchPath & ">;" & strCriteria & ";" & strProperties & ";" & strScope
  1030.     objCommand.CommandText  = strCommand
  1031.     objCommand.Properties("Page Size") = 100000                    
  1032.     objCommand.Properties("Timeout") = 300000 'seconds
  1033.  
  1034.  
  1035.    Set objRecordSet = objCommand.Execute
  1036.    If Err.Number then
  1037.         Print "Error 0x" & CStr(Hex(Err.Number)) & " ocurred during the search."
  1038.         If Err.Description <> "" Then Print "Error description: " & Err.Description & "."
  1039.         Err.Clear
  1040.         Exit Function
  1041.     End If
  1042.  
  1043.     If objRecordSet.RecordCount = 1 Then 
  1044.     blnSearchForServer = True
  1045.         strADSPath = objRecordSet.Fields(0).Value
  1046.         strClass = objRecordSet.Fields(1).Value
  1047.     End If
  1048.  
  1049. End Function
  1050.  
  1051.  
  1052.  
  1053. '********************************************************************
  1054. '*
  1055. '* Function intSearchArray()
  1056. '* Purpose: Searches an array for a given string.
  1057. '* Input:   strTarget    the string to look for
  1058. '*          strArray    an array of strings to search against
  1059. '* Output:  If a match is found intSearchArray is set to the index of the element,
  1060. '*          otherwise it is set to CONST_STRING_NOT_FOUND.
  1061. '*
  1062. '********************************************************************
  1063.  
  1064. Function intSearchArray(ByVal strTarget, ByVal strArray)
  1065.  
  1066. ON ERROR RESUME NEXT
  1067.  
  1068.     Dim i, j
  1069.  
  1070.     intSearchArray = CONST_STRING_NOT_FOUND
  1071.  
  1072.     If Not IsArray(strArray) Then
  1073.         Print "Argument is not an array!"
  1074.         Exit Function
  1075.     End If
  1076.  
  1077.     strTarget = LCase(strTarget)
  1078.     For i = 0 To UBound(strArray)
  1079.         j = InStr(1, strArray(i), strTarget, 1)
  1080.         If j > 0 Then 
  1081.            intSearchArray = i
  1082.         End If
  1083.     Next
  1084. End Function
  1085.  
  1086. '********************************************************************
  1087. '*
  1088. '* Sub Print()
  1089. '* Purpose:   Prints a message on screen if blnQuiet = False.
  1090. '* Input:     strMessage    the string to print
  1091. '* Output:    strMessage is printed on screen if blnQuiet = False.
  1092. '*
  1093. '********************************************************************
  1094.  
  1095. Sub Print(ByRef strMessage)
  1096.     'If Not blnQuiet then
  1097.         Wscript.Echo  strMessage
  1098.     'End If
  1099. End Sub
  1100.  
  1101. '********************************************************************
  1102. '*                                                                  *
  1103. '*                           End of File                            *
  1104. '*                                                                  *
  1105. '********************************************************************
  1106.  
  1107. '********************************************************************
  1108. '*
  1109. '* Procedures calling sequence: MODIFYLDAP.VBS
  1110. '*
  1111. '*  intChkProgram
  1112. '*    intParseCmdLine
  1113. '*    ShowUsage
  1114. '*    MODIFYLDAP
  1115. '*      PRINTLDAP
  1116. '*      ASSIGNLDAP
  1117. '*          blnSearchForServer
  1118. '*      DELETELDAP
  1119. '*          blnCheckForQueryPolicy
  1120. '*      CREATELDAP
  1121. '*      REMOVELDAP
  1122. '*
  1123. '********************************************************************
  1124.