DESCRIPTION
- Create two virtual attributes and apply them to the user class:
edsvaIamAgreed - boolean, non-stored, single-valued
edsvaAgreedDate - generalized time, stored, single-valued
- Customize Web UI form with user personal data, and add to this form an entry for the edsvaIamAgreed attribute
SCRIPT POLICY
'*********************************************************************************
' 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
'===========================================================================
' EVENT HANDLERS
'===========================================================================
Sub onPreModify(Request)
'--- proceed for user object ---
If (LCase(Request.Class) <> LCase("user")) Then Exit Sub
'---
On Error Resume Next
boolAgreed = CBool(Request.Get("edsvaIamAgreed"))
On Error Goto 0
'--- skip if not
If (Not boolAgreed) Then Exit Sub
'--- set agreement data
Call Request.Put("edsvaAgreedDate", Now())
End Sub ' onPreModify
' *** END OF CODE *************************************************************
EXTERNAL SCRIPT FOR REPORTING
' *****************************************************************************
' 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 OR CUSTOM DEVELOPMENT.
' *****************************************************************************
Option Explicit
'===========================================================================
' Ldap queryr constants
'===========================================================================
Const strLdapQueryForUsers = "(&(objectCategory=person)(objectSid=*)(!(sAMAccountType:1.2.840.113556.1.4.804:=3))(!(userAccountControl:1.2.840.113556.1.4.804:=2048)))"
Const strLdapQueryForGroups = "(&(objectClass=group)(objectSid=*))"
'===========================================================================
' DoARSSearch
'===========================================================================
Function DoARSSearch (ByVal strStartNode, ByVal strLdapQuery, ByVal strReturnAttrList, ByVal strDepth)
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
objCmd.CommandText = "<EDMS://" & strStartNode & ">;" & strLdapQuery & ";" & strReturnAttrList & ";" & strDepth
Set DoARSSearch = objCmd.Execute
End Function ' Do ARSSearch
'===========================================================================
' Main routine
'===========================================================================
Dim dateBefore, objRS
dateBefore = DateAdd("m",-1, Now())
Set objRS = DoARSSearch("DC=foo,DC=com", "(&" & strLdapQueryForUsers & "(!(edsvaAgreedDate=*))(edsvaAgreedDate<=" & dateBefore & "))", "distinguishedName,givenName,sn,sAMAccountName", "subTree")
Do While (Not objRS.EOF)
MsgBox "user = " & objRS("sAMAccountName")
Loop
MsgBox "Done!"
' *** END OF CODE *************************************************************