DESCRIPTION
Get effective policy info list
Note This code may use functions from the ARS Script Policy Best Practices. Please, follow the link to obtain instructions and code for those functions.
SCRIPT
'*********************************************************************************
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
' WARRANTIES OF MERCHANTBILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
' IF YOU WANT THIS FUNCTIONALITY TO BE CONDITIONALLY SUPPORTED,
' PLEASE CONTACT QUEST PROFESSIONAL SERVICES.
'*********************************************************************************
'
' This code is published on the ActiveRoles Script Center:
' http://communities.quest.com/docs/DOC-9991
'
' This code may use functions from the ARS Script Policy Best Practices:
' http://communities.quest.com/docs/DOC-10016
'
' Please, follow the link to obtain instructions and code for those functions.
'*********************************************************************************
Option Explicit
'******************************************************************************
'*** ARS Constants
Const EDS_CONTROL_FULL_EFFECTIVE_POLICY_INFO = 31
'******************************************************************************
'*** Multi-page MsgBox
'******************************************************************************
Function MultiMsgBox(ByVal strOut)
Dim i, n, strPart
Do While (strOut <> "")
n = 0
For i = 1 To 21
n = InStr(n+1, strOut, vbCrLf)
If (n <= 0) Then
n = Len(strOut)+1
Exit For
End If
Next
strPart = Left(strOut, n-1)
strOut = Mid(strOut, n+2)
MsgBox (strPart)
Loop
End Function
'******************************************************************************
'***
'*** param: objObject - interesting object
'*** boolIncludeServerSideGeneration - include server-side
'*** generated values in policy info list
'*** arrstrInterestingAttributes - array of strings with
'*** LDAP names of attribute -or- Empty for all attributes
'******************************************************************************
Function MsgPolicyInfoList(ByRef objObject, ByVal boolIncludeServerSideGeneration, ByVal arrstrInterestingAttributes)
Dim strOut, strOut2, boolFlag, strInterestingAttribute
Dim objPolicyInfoList, objPolicyInfo, strValue
strOut = "Administrative Policy:" & vbCrLf & "-------------------------------" & vbCrLf
'-----------------------------------------
If (boolIncludeServerSideGeneration) Then
objObject.Control(EDS_CONTROL_FULL_EFFECTIVE_POLICY_INFO) = arrstrInterestingAttributes
End If
'-----------------------------------------
Set objPolicyInfoList = objObject.GetPolicyInfoList
For Each objPolicyInfo in objPolicyInfoList
boolFlag = False
If (IsEmpty(arrstrInterestingAttributes)) Then
boolFlag = True
Else
For Each strInterestingAttribute In arrstrInterestingAttributes
If (LCase(strInterestingAttribute) = LCase(objPolicyInfo.Name)) Then boolFlag = True
Next
End If
If (boolFlag) Then
On Error Resume Next
strOut = strOut & "Property = '" & objPolicyInfo.Name & "'" & vbCrLf
On Error Goto 0
On Error Resume Next
strOut = strOut & " autogenerated = " & objPolicyInfo.AutoGenerated & vbCrLf
On Error Goto 0
On Error Resume Next
strOut = strOut & " case adjusting = " & objPolicyInfo.CaseAdjusting & vbCrLf
On Error Goto 0
On Error Resume Next
strOut = strOut & " maximum length = " & objPolicyInfo.MaximumLength & vbCrLf
On Error Goto 0
On Error Resume Next
strOut = strOut & " generated value = " & objPolicyInfo.GeneratedValue & vbCrLf
On Error Goto 0
On Error Resume Next
strOut = strOut & " server-side generated = " & objPolicyInfo.ServerSideGenerated & vbCrLf
On Error Goto 0
On Error Resume Next
strOut = strOut & " value required = " & objPolicyInfo.ValueRequired & vbCrLf
On Error Goto 0
On Error Resume Next
strOut2 = ""
For Each strValue in objPolicyInfo.PossibleValues
strOut2 = strOut2 & " '" & strValue & "'" & vbCrLf
Next
If (strOut2 <> "") Then strOut = strOut & " possible values:" & vbCrLf & strOut2
On Error Goto 0
On Error Resume Next
strOut = strOut & " admin note = '" & objPolicyInfo.AdminNote & "'" & vbCrLf
On Error Goto 0
strOut = strOut & "--------------------" & vbCrLf
End If
Next
MultiMsgBox (strOut)
End Function
'******************************************************************************
'***
'******************************************************************************
Dim objOU, objUser
'--- Prepare to user creation in specified OU
Set objOU = GetObject("EDMS://OU=Sales,DC=foo,DC=com")
Set objUser = objOU.Create("user", "CN=John Smith")
'--- Put some value to creating user
objUser.Put "givenName", "John"
objUser.Put "sn", "Smith"
'--- Get policy info list for creating user
Call MsgPolicyInfoList(objUser, True, Array("displayName","sAMAccountName"))
'--- Or get policy info list for existing user
'Set objUser = GetObject("EDMS://CN=John Smith,OU=Sales,DC=foo,DC=com")
'Call MsgPolicyInfoList(objUser, True, Array("displayName","sAMAccountName"))
MsgBox "Done!"
'***** END OF CODE ***************************************************************
COMPATIBILITY
Script compatible with the following version(s): <Not specified>