Subject: RE: LotusScript Class Error Handling
Sure . . . I can send you the entire framework if you want . . . but I think I may not have been clear enough in my response. So here’s an example of a class I’ve posted before where I’ve extended the AbstractErrorProcessor class to implement error handling at the class-level.
Drop me a note at dgimpel^at^gmail^dot^com if you’d like the framework.
dgg
Public Class UserAccessDetails As AbstractErrorProcessor
'// Public Methods:
'// New (constructor)
'// Initialize
'// ReleaseNotesObjects
'//
'// Private Methods:
'// setNAB
'// setGroupView
'// getActiveACLEntries
'// getActiveACLRoles
'// detectDeleteAccess
'// getMaxAccessLevel
'// getGroupMembers
'// processError
'//
'// Public Properties:
'// CLASS_NAME = String constant (the name of this class - mostly for use in error trapping)
'// PUBLIC_NAB_REPLICAID = String constant (replica id for PNAB)
'// DEFAULT_ARRAY_VALUE = String constant (default value for arrays within class)
'// GetACL = NotesACL (ACL for target Notes database)
'// GetProperACLEntry = NotesACLEntry (entry returned for a given user’s name - may be nothing)
'// GetActiveEntries = Variant (string array of given user’s active ACL entry names)
'// GetActiveRoles = Variant (string array of given user’s roles)
'// GetAccessLevel = Integer (access level as defined by NotesACLEntry class)
'// CanDelete = Bboolean (true if user has access to delete documents, otherwise false)
Private ndbTarget As NotesDatabase
Private ndbNAB As NotesDatabase
Private nName As NotesName
Private acl As NotesACL
Private aclEntryProper As NotesACLEntry
Private intAccessLevel As Integer
Private blnIsInitialized As Boolean
Private strServer As String
Private strNABReplicaID As String
Private strUzrRolesArray() As String
Private strACLEntryNameArray() As String
Private varDeleteAccess As Variant
'+++ CONSTRUCTOR +++
Public Sub New(pndbTarget As NotesDatabase, pstrServer As String, pstrUName As String, pstrNABRepID As String)
Set Me.ndbTarget = pndbTarget
Set Me.nName = New NotesName(pstrUName)
Me.strServer$ = pstrServer$
If pstrNABRepID$ = "" Then
Me.strNABReplicaID$ = Me.PUBLIC_NAB_REPLICAID
Else
Me.strNABReplicaID$ = pstrNABRepID$
End If
Redim Me.strACLEntryNameArray(0) As String '// initialize array
Redim Me.strUzrRolesArray(0) As String '// initialize array
Me.strACLEntryNameArray(0) = Me.DEFAULT_ARRAY_VALUE
Me.strUzrRolesArray(0) = Me.DEFAULT_ARRAY_VALUE
Me.varDeleteAccess = Null '// initialize to null
Set Me.aclEntryProper = getProperACLEntry() '// try to get an acl entry for given user name
Me.blnIsInitialized = False
Me.intAccessLevel% = -1
subExit:
Exit Sub
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume subExit
End Sub
'+++ PUBLIC PROPERTIES +++
Public Property Get CLASS_NAME As String
CLASS_NAME$ = {"UserAccessDetails" class}
End Property
Public Property Get PUBLIC_NAB_REPLICAID As String
PUBLIC_NAB_REPLICAID = "NAB REPLICA ID GOES HERE" '// used as default NAB Replica ID
End Property
Public Property Get DEFAULT_ARRAY_VALUE As String
DEFAULT_ARRAY_VALUE$ = "<<no value>>"
End Property
Public Property Get GetACL As NotesACL
If Me.acl Is Nothing Then
If Not(Me.ndbTarget Is Nothing) Then
Set Me.acl = Me.ndbTarget.ACL '// get database's ACL
End If
End If
Set GetACL = Me.acl
End Property
Public Property Get GetProperACLEntry() As NotesACLEntry
Set GetProperACLEntry = Me.GetACL.GetEntry(Me.nName.Canonical) '// try to get ACL entry using current user's name
End Property
Public Property Get GetActiveEntries As Variant
If Me.strACLEntryNameArray(0) = Me.DEFAULT_ARRAY_VALUE Then
If Not(Me.getActiveACLEntries()) Then
Msgbox "Unable to determine the active Access Control List (ACL) entries for " & Me.nName.Common & ".", , "Active ACL entries . . ."
End If
End If
GetActiveEntries = Me.strACLEntryNameArray
End Property
Public Property Get GetActiveRoles As Variant
If Me.strUzrRolesArray(0) = Me.DEFAULT_ARRAY_VALUE Then
If Not(Me.getActiveACLRoles()) Then
Msgbox "Unable to determine the active Access Control List (ACL) roles for " & Me.nName.Common & ".", , "Active ACL roles . . ."
End If
End If
GetActiveRoles = Me.strUzrRolesArray
End Property
Public Property Get GetAccessLevel As Integer
If Me.intAccessLevel% < 0 Then
Me.intAccessLevel% = Me.getMaxAccessLevel()
End If
GetAccessLevel = Me.intAccessLevel%
End Property
Public Property Get CanDelete As Boolean
If Isnull(Me.varDeleteAccess) Then
Me.varDeleteAccess = Me.detectDeleteAccess()
End If
CanDelete = Cbool(Me.varDeleteAccess)
End Property
'+++ PUBLIC METHODS +++
Public Sub Initialize()
On Error Goto errorHandler
Dim aclEntry As NotesACLEntry
Dim i As Integer
Dim varTmpRoles As Variant
If Me.blnIsInitialized Then '// since this is public, make sure it's only called once
Goto subExit
End If
Redim Me.strUzrRolesArray(0) As String '// reinitialize the array
varTmpRoles = Me.strUzrRolesArray '// initialize tmpVariant to an array
If Me.aclEntryProper Is Nothing Then '// user name is NOT explicitly defined in ACL
Forall ntryName In Me.GetActiveEntries
Set aclEntry = Me.GetACL.GetEntry(ntryName)
varTmpRoles = Arrayappend(varTmpRoles, aclEntry.Roles)
If aclEntry.Level > Me.intAccessLevel% Then
Me.intAccessLevel% = aclEntry.Level
End If
If Isnull(Me.varDeleteAccess) Then
If aclEntry.CanDeleteDocuments Then
Me.varDeleteAccess = True
Print "Delete access granted via " & Chr(34) & ntryName & Chr(34) & " ACL entry . . ."
End If
End If
End Forall
Else '// user name IS explicitly defined in ACL
Me.intAccessLevel% = Me.aclEntryProper.Level
Me.varDeleteAccess = Me.aclEntryProper.CanDeleteDocuments
Forall ntryName In Me.GetActiveEntries
Set aclEntry = Me.GetACL.GetEntry(ntryName)
varTmpRoles = Arrayappend(varTmpRoles, aclEntry.Roles)
End Forall
End If
If Isarray(varTmpRoles) Then
varTmpRoles = Arrayunique(Fulltrim(varTmpRoles)) '// remove remove empties & duplicates
Redim Me.strUzrRolesArray(Ubound(varTmpRoles)) As String '// re-size the strUzrRolesArray array
i = -1
Forall role In varTmpRoles
i = i + 1
Me.strUzrRolesArray(i) = role
End Forall
Erase varTmpRoles
End If
Set aclEntry = Nothing
Me.blnIsInitialized = True
subExit:
Exit Sub
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume subExit
End Sub
Public Sub Delete()
Set Me.ndbTarget = Nothing
Call Me.ReleaseNotesObjects()
Erase strUzrRolesArray
Erase strACLEntryNameArray
varDeleteAccess = Null
End Sub
Public Sub ReleaseNotesObjects()
'// releases everything but ndbTarget (which is needed for subsequent method calls)
Set Me.ndbNAB = Nothing
Set Me.nName = Nothing
Set Me.acl = Nothing
Set Me.aclEntryProper = Nothing
End Sub
'+++ PRIVATE METHODS +++
Private Function isNewInstance As Boolean
isNewInstance = False '// over-ride this method in the AbstractErrorProcessor class
End Function
Private Function setNAB() As Boolean
On Error Goto errorHandler
setNAB = False
If Me.ndbNAB Is Nothing Then
Set Me.ndbNAB = New NotesDatabase("", "")
setNAB = Me.ndbNAB.OpenByReplicaID(Me.strServer$, Me.strNABReplicaID$)
Else
setNAB = True
End If
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
Private Function setGroupView(view As NotesView) As Boolean
On Error Goto errorHandler
Const GROUP_VIEW$ = "($VIMGroups)"
setGroupView = False
If Me.ndbNAB Is Nothing Then
setGroupView = Me.setNAB()
Else
setGroupView = True
End If
If setGroupView Then
Set view = Me.ndbNAB.GetView(GROUP_VIEW)
If view Is Nothing Then
setGroupView = False
Else
view.AutoUpdate = False
End If
End If
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
Private Function getActiveACLEntries() As Boolean
On Error Goto errorHandler
Const DEFAULT_ENTRY = "-DEFAULT-"
Const NAME_DELIMITER$ = "/"
Dim groupView As NotesView
Dim groupDoc As NotesDocument
Dim aclEntry As NotesACLEntry
Dim tmpNName As NotesName
Dim i As Integer
Dim intMatchCount As Integer
Dim blnIsWildCardMatch As Boolean
Dim strACLEntryName As String
Dim varNameElements As Variant
Dim varEntryElements As Variant
Dim varTmp As Variant
getActiveACLEntries = False
Redim strACLEntryNameArray(0) As String
If Not(Me.setNAB()) Then '// if we can't get to NAB - fail with error message
Msgbox "Failed to open the Public Name and Address Book - unable to continue.", , "Error encountered . . ."
Goto functionExit
End If
If Not(setGroupView(groupView)) Then
Msgbox "Could not access a required view in the Public Name and Address Book - unable to continue.", , "Error encountered . . ."
Goto functionExit
End If
Set aclEntry = Me.GetACL.GetFirstEntry
varNameElements = Split(Me.nName.Abbreviated, NAME_DELIMITER, -1, 5) '// explode Notes name into individual components
intMatchCount% = -1
Do While Not(aclEntry Is Nothing)
strACLEntryName$ = aclEntry.Name
Set tmpNName = New NotesName(strACLEntryName$)
If Left$(strACLEntryName$, 1) = "*" Then '// entry IS a wildcard acl entry
varEntryElements = Split(tmpNName.Abbreviated, NAME_DELIMITER, -1, 5)
If Ubound(varEntryElements) > 0 Then '// even if there's only 1 element of the entry (eg, */Acme), array should still have ubound of 1
For i = Ubound(varEntryElements) To 1 Step -1 '// do a bottom to top comparison
If varEntryElements(i) = varNameElements(i) Then
blnIsWildCardMatch = True '// continue through loop to make sure ALL elements match
Else
blnIsWildCardMatch = False
Exit For '// exit loop on the first non-match
End If
Next i
If blnIsWildCardMatch Then '// if the loop above completes & the flag is true, a qualifying wild card match was found
intMatchCount% = intMatchCount% + 1
Redim Preserve strACLEntryNameArray(intMatchCount%) As String
strACLEntryNameArray(intMatchCount%) = strACLEntryName$
End If
End If
Else '// entry is NOT a wildcard acl entry
If Ucase(strACLEntryName$) = DEFAULT_ENTRY Then
If aclEntry.Level > ACLLEVEL_NOACCESS Then
intMatchCount% = intMatchCount% + 1
Redim Preserve strACLEntryNameArray(intMatchCount%) As String
strACLEntryNameArray(intMatchCount%) = strACLEntryName$
End If
Else
If tmpNName.IsHierarchical Then '// assume explicitly defined name entries to be hierarchical (flat names are therefore ignored or treated as a potential group)
If tmpNName.Abbreviated = Me.nName.Abbreviated Then
intMatchCount% = intMatchCount% + 1
Redim Preserve strACLEntryNameArray(intMatchCount%) As String
strACLEntryNameArray(intMatchCount%) = strACLEntryName$
End If
Else '// assume without checking that entry is a group (to account for undefined entries)
Set groupDoc = groupView.GetDocumentByKey(strACLEntryName$, True) '// try to get corresponding group document
If Not(groupDoc Is Nothing) Then
varTmp = groupDoc.GetItemValue("Members")
If Isnumeric(Arraygetindex(varTmp, Me.nName.Canonical, 5)) Then
intMatchCount% = intMatchCount% + 1
Redim Preserve strACLEntryNameArray(intMatchCount%) As String
strACLEntryNameArray(intMatchCount%) = strACLEntryName$
Else
varTmp = Me.getGroupMembers(groupView, strACLEntryName$)
If Isnumeric(Arraygetindex(varTmp, Me.nName.Canonical, 5)) Then
intMatchCount% = intMatchCount% + 1
Redim Preserve strACLEntryNameArray(intMatchCount%) As String
strACLEntryNameArray(intMatchCount%) = strACLEntryName$
End If
End If
End If
End If
End If
End If
Set aclEntry = getACL.GetNextEntry(aclEntry)
Loop
getActiveACLEntries = True
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
Private Function getActiveACLRoles() As Boolean
On Error Goto errorHandler
Dim aclEntry As NotesACLEntry
Dim i As Integer
Dim varTmpRoles As Variant
getActiveACLRoles = False '// initialize function's return value
Redim Me.strUzrRolesArray(0) As String '// reinitialize the array
varTmpRoles = Me.strUzrRolesArray
Forall ntry In Me.GetActiveEntries
Set aclEntry = Me.GetACL.GetEntry(ntry)
If Not(aclEntry Is Nothing) Then
If Isarray(aclEntry.Roles) Then
varTmpRoles = Arrayappend(varTmpRoles, aclEntry.Roles)
End If
End If
End Forall
varTmpRoles = Arrayunique(Fulltrim(varTmpRoles)) '// remove remove empties & duplicates
If Isarray(varTmpRoles) Then
Redim Me.strUzrRolesArray(Ubound(varTmpRoles)) As String '// re-size the strUzrRolesArray array
i = -1
Forall role In varTmpRoles
i = i + 1
Me.strUzrRolesArray(i) = role
End Forall
Erase varTmpRoles
End If
Set aclEntry = Nothing
getActiveACLRoles = True
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
Private Function detectDeleteAccess() As Boolean
On Error Goto errorHandler
Dim aclEntry As NotesACLEntry
detectDeleteAccess = False
If Me.aclEntryProper Is Nothing Then '// user name is NOT explicitly defined in ACL
Forall ntryName In Me.GetActiveEntries
Set aclEntry = Me.GetACL.GetEntry(ntryName)
If aclEntry.CanDeleteDocuments Then
detectDeleteAccess = True
Print "Delete access detected via " & Chr(34) & ntryName & Chr(34) & " ACL entry . . ."
Goto functionExit
End If
End Forall
Else '// user name IS explicitly defined in ACL
detectDeleteAccess = Me.aclEntryProper.CanDeleteDocuments
End If
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
Private Function getMaxAccessLevel() As Integer
On Error Goto errorHandler
Const ACLLEVEL_MGR = 6
Dim aclEntry As NotesACLEntry
Dim intLevel As Integer
getMaxAccessLevel% = -1
If Me.aclEntryProper Is Nothing Then '// user name is NOT explicitly defined in ACL
Forall ntryName In Me.GetActiveEntries
Set aclEntry = Me.GetACL.GetEntry(ntryName)
intLevel% = aclEntry.Level
If intLevel% = ACLLEVEL_MGR Then
getMaxAccessLevel% = intLevel%
Goto functionExit
Elseif intLevel% > getMaxAccessLevel% Then
getMaxAccessLevel% = intLevel%
End If
End Forall
Else '// user name IS explicitly defined in ACL
getMaxAccessLevel% = Me.aclEntryProper.Level
End If
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
Private Function getGroupMembers(groupView As NotesView, pstrGroupName As String) As Variant
On Error Goto errorHandler
Dim groupDoc As NotesDocument
Dim varTmpGroupName1 As Variant
Dim varTmpGroupName2 As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim intGrpLBound1 As Integer
Dim intGrpUBound1 As Integer
Dim intGrpLBound2 As Integer
Dim intGrpUBound2 As Integer
Dim vaMembers() As Variant
Set groupDoc = groupView.GetDocumentByKey(pstrGroupName$, True)
Redim vaMembers(1) As Variant
j = 0
If Not(groupDoc Is Nothing) Then
varTmpGroupName1 = groupDoc.GetItemValue("Members")
intGrpLBound1% = Lbound(varTmpGroupName1)
intGrpUBound1% = Ubound(varTmpGroupName1)
For i = intGrpLBound1% To intGrpUBound1%
varTmpGroupName2 = getGroupMembers(groupView, varTmpGroupName1(i))
intGrpLBound2% = Lbound(varTmpGroupName2)
intGrpUBound2% = Ubound(varTmpGroupName2)
Redim Preserve vaMembers(intGrpUBound2% + j) As Variant
For k = intGrpLBound2% To intGrpUBound2%
vaMembers(j) = varTmpGroupName2(k)
j = j + 1
Next k
Next i
Else
Redim vaMembers(0) As Variant
vaMembers(0) = pstrGroupName$
End If
getGroupMembers = vaMembers
functionExit:
Exit Function
errorHandler:
Call Me.processError(Me.CLASS_NAME & " / " & LIB_NAME)
Resume functionExit
End Function
End Class