DESCRIPTION
This script policy automatically sends an email message with detailed debug information on the Request object.
Note This code may use functions from the Active Roles 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 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
'------------------------------------------------------------------------------------------
Sub onPreCreate(Request)
Call Report(Request)
End Sub
Sub onPostCreate(Request)
Call Report(Request)
End Sub
Sub onPreDelete(Request)
Call Report(Request)
End Sub
Sub onPostDelete(Request)
Call Report(Request)
End Sub
Sub onPreModify(Request)
Call Report(Request)
End Sub
Sub onPostModify(Request)
Call Report(Request)
End Sub
Sub onPreMove(Request)
Call Report(Request)
End Sub
Sub onPostMove(Request)
Call Report(Request)
End Sub
Sub onPreRename(Request)
Call Report(Request)
End Sub
Sub onPostRename(Request)
Call Report(Request)
End Sub
Sub onPreGet(Request)
Call Report(Request)
End Sub
Sub onPostGet(Request)
Call Report(Request)
End Sub
Sub onPreSearch(Request)
Call Report(Request)
End Sub
Sub onCheckPropertyValues(Request)
Call Report(Request)
End Sub
Sub onGetEffectivePolicy(Request)
Call Report(Request)
End Sub
Sub onPreDeprovision(Request)
Call Report(Request)
End Sub
Sub onDeprovision(Request)
Call Report(Request)
End Sub
Sub onPostDeprovision(Request)
Call Report(Request)
End Sub
Sub onPreUnDeprovision(Request)
Call Report(Request)
End Sub
Sub onUnDeprovision(Request)
Call Report(Request)
End Sub
Sub onPostUnDeprovision(Request)
Call Report(Request)
End Sub
'------------------------------------------------------------------------------------------
Sub Report(ByRef Request)
Dim strFrom, strTo, strSubject, strMessage, strSmtpServer
strFrom = "ARS-service@foo.co[[ars-script-wiki&mce_rdomain=dell.com:mailto:ARS-service@foo.com|]]m"
strTo = "Admin@foo.[[ars-script-wiki&mce_rdomain=dell.com:mailto:Admin@foo.com|]]com"
strSubject = "ARS Script Policy"
strMessage = ""
strSmtpServer = "mx.foo.com"
On Error Resume Next
strMessage = strMessage & "Request type = '" & Request.Parameter("Type") & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Interesting request type = '" & Request.Parameter("InterestingRequestType") & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.ADsPath = '" & Request.ADsPath & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.Class = '" & Request.Class & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.GUID = '" & Request.GUID & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.Name = '" & Request.Name & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.Parent = '" & Request.Parent & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.Name = '" & Request.Name & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.Schema = '" & Request.Schema & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
Dim strSan, strDn
Request.WhoamI strSan,strDn
strMessage = strMessage & "Request.WhoAmI = '" & strSan & "', '" & strDn & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.LdapFilter = '" & Request.LdapFilter & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "Request.SearchPref = '" & Request.SearchPref & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "EDS_CONTROL_LDAP_SERVER = '" & Request.GetInControl(EDS_CONTROL_LDAP_SERVER) & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "EDS_CONTROL_SOURCE_OBJECT_DN = '" & Request.GetInControl(EDS_CONTROL_SOURCE_OBJECT_DN) & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "EDS_CONTROL_OBJECT_DN = '" & Request.GetInControl(EDS_CONTROL_OBJECT_DN) & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
strMessage = strMessage & "EDS_CONTROL_FULL_EFFECTIVE_POLICY_INFO = '" & Request.GetInControl(EDS_CONTROL_FULL_EFFECTIVE_POLICY_INFO) & "'" & vbCrLf
On Error GoTo 0
On Error Resume Next
Dim strRequestedAttribute
For Each strRequestedAttribute In Request.RequestedAttributes
strMessage = strMessage & "Requested attribute = '" & strRequestedAttribute & "'" & vbCrLf
Next
On Error GoTo 0
On Error Resume Next
Dim i, strValue
For i=1 To Request.PropertyCount-1
strMessage = strMessage & "Attribute in request = '" & Request.Item(i).Name & "'" & vbCrLf
strMessage = strMessage & " control code = '" & Request.Item(i).ControlCode & "'" & vbCrLf
For Each strValue In Request.Item(i).Values
Select Case strValue.ADsType
Case ADSTYPE_DN_STRING
strMessage = strMessage & " value = '" & strValue.DNString & "'" & vbCrLf
Case ADSTYPE_CASE_EXACT_STRING
strMessage = strMessage & " value = '" & strValue.CaseExactString & "'" & vbCrLf
Case ADSTYPE_CASE_IGNORE_STRING
strMessage = strMessage & " value = '" & strValue.CaseIgnoreString & "'" & vbCrLf
Case ADSTYPE_PRINTABLE_STRING
strMessage = strMessage & " value = '" & strValue.PrintableString & "'" & vbCrLf
Case ADSTYPE_NUMERIC_STRING
strMessage = strMessage & " value = '" & strValue.NumericString & "'" & vbCrLf
Case ADSTYPE_BOOLEAN
strMessage = strMessage & " value = '" & strValue.Boolean & "'" & vbCrLf
Case ADSTYPE_INTEGER
strMessage = strMessage & " value = '" & strValue.Integer & "'" & vbCrLf
Case Else
strMessage = strMessage & " value = ???" & vbCrLf
End Select
Next
Next
On Error GoTo 0
Call SendEmail(strFrom, strTo, strSubject, strMessage, strSmtpServer)
End Sub
'------------------------------------------------------------------------------------------
Sub SendEmail(ByVal strFrom, ByVal strTo, ByVal strSubject, ByVal strMessage, ByVal strSmtpServer)
Dim objEmail
Set objEmail = CreateObject("CDO.Message")
objEmail.From = strFrom
objEmail.To = strTo
objEmail.Subject = strSubject
objEmail.Textbody = strMessage
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objEmail.Configuration.Fields.Update()
objEmail.Send()
End Sub
'***** END OF CODE ***************************************************************