DESCRIPTION
Policy incompliance reporting & fixing for the specified policy. This action will be provided entire management environment. Caution: This script may run for a long time.
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 MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
' IF YOU WANT THIS FUNCTIONALITY TO BE CONDITIONALLY SUPPORTED,
' PLEASE CONTACT ONE IDENTITY PROFESSIONAL SERVICES.
'*********************************************************************************
Option Explicit
'===========================================================================
' Constants
'===========================================================================
Const strActiveDirectoryDN = "CN=Active Directory"
'===========================================================================
Const EDS_CONTROL_FIX = 4
Const EDS_CONTROL_CHECK_POLICY_COMPLIANCE = 5
'******************************************************************************
'*** 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
'===========================================================================
' DoARSSearchRaw
'===========================================================================
Function DoARSSearchRaw (ByVal strCommand, ByVal strSortList)
Dim objConn, objCmd
Set objConn = CreateObject("ADODB.Connection")
objConn.Open "Provider=ADSDSOObject;Data Source=ADs Provider;"
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConn
If (strSortList <> "") Then
objCmd.Properties("Size Limit") = 10
objCmd.Properties("Sort On") = strSortList
End If
objCmd.CommandText = strCommand
Set DoARSSearchRaw = objCmd.Execute
End Function ' Do ARSSearchRaw
'===========================================================================
' DoARSSearch
'===========================================================================
Function DoARSSearch (ByVal strStartingNodeDN, ByVal strLdapQuery, ByVal strAttrList, ByVal strDepth)
Dim strCommand
strCommand = "<EDMS://" & strStartingNodeDN & ">;" & strLdapQuery & ";" & strAttrList & ";" & strDepth
Set DoARSSearch = DoARSSearchRaw(strCommand, "")
End Function ' Do ARSSearch
'===========================================================================
' GetObjectGUID
'===========================================================================
Function GetObjectGUID (ByVal strADObjectDN)
Dim objADObject, objOctetString
On Error Resume Next
Set objADObject = GetObject("EDMS:" & strADObjectDN)
Set objOctetString = CreateObject("AelitaEDM.EDMOctetString")
Call objOctetString.Set(objADObject.GUID)
GetObjectGuid = objOctetString.GetGuidString()
On Error Goto 0
End Function ' GetObjectGUID
'===========================================================================
' ReportAndFixPolicyIncompliance
'===========================================================================
Sub ReportAndFixPolicyIncompliance (ByVal strContainerDN, ByVal strPolicyDN, ByVal boolFix)
Dim objADObject, objRS
Dim objPP, objPP1, objPP2
Dim strPolicyGUID, strOut, strOut2
strPolicyGUID = GetObjectGUID(strPolicyDN)
' Give the rowset object with attributes
Set objRS = DoARSSearch (strContainerDN, "(objectClass=*)", "distinguishedName", "SubTree")
strOut = ""
Do While (Not objRS.EOF)
Set objADObject = GetObject("EDMS://" & objRS("distinguishedName"))
objADObject.Control(EDS_CONTROL_FIX) = strPolicyDN
If (boolFix) Then
objADObject.Control(EDS_CONTROL_CHECK_POLICY_COMPLIANCE) = strPolicyDN
End If
Set objPP = objADObject.CheckPropertyValues()
strOut2 = ""
For Each objPP1 in objPP
For Each objPP2 in objPP1
strOut2 = strOut2 & PP2.PropertyName & " " & CStr(PP2.Status) & " " & PP2.Message & vbCrLf
Next
Next
If (strOut2 <> 0) Then
strOut = strOut & objRS("distinguishedName") & vbCrLf & _
"--------" & vbCrLf & _
strOut2 & vbCrLf
End If
objRS.MoveNext
Loop
MultiMsgBox (strOut)
End Sub ' ReportAndFixPolicyIncompliance
'===========================================================================
'== MAIN ROUTINE
'===========================================================================
' 1st param - DN of container to check,
' please specify DN value (sample: "OU=Sales,DC=foo,DC=com"), or use the strActiveDirectoryDN constant
' 2nd param - DN of policy object
' 3rd param - True -or-False, fix the policy incompliance -or- not
Call ReportAndFixPolicyIncompliance(strActiveDirectoryDN, "CN=SomePolicy1,CN=Policy Objects,CN=Configuration", True)
'***** END OF CODE ***************************************************************