ce post sera complété par une description détaillée et éventuellement garni par d'autres propriétés et méthodes
je déplore une nouvelle fois que l'on ne puisse pas faire de surcharge de méthode comme en java... l'écriture en serait plus propre
- Code : Tout sélectionner
Public Class ACLProperty
Private m_session As NotesSession
Private m_db As NotesDatabase
Private m_dbACL As NotesACL
Private m_inACL As Integer
Private m_ACLEntriesCount As Integer
Private m_ACLRoles As Variant
Private m_ACLRolesCount As Integer
Sub new
Set m_session = New NotesSession
Set m_db = m_session.CurrentDatabase
Set m_dbACL = m_db.ACL
End Sub
Property Get LCA As NotesACL
Set LCA=m_dbACL
End Property
Property Get ACLEntriesCount As Integer
ACLEntriesCount=m_ACLEntriesCount
End Property
'// Nombre de rôles dans la LCA
Property Get ACLRolesCount As Integer
ACLRolesCount=m_ACLRolesCount
End Property
'//
Property Get IntoACL As Integer
IntoACL=m_inACL
End Property
'// Retourne tous les membres de la LCA
Function getACLEntries() As Variant
Dim ACLNames As NotesACLEntry
Dim i As Integer
Dim names As Variant
Set m_dbACLEntry = m_dbACL.GetFirstEntry
Redim names(0)
While Not (m_dbACLEntry Is Nothing)
Redim Preserve Names(i)
names(i) = m_dbACLEntry.Name
i = i + 1
Set m_dbACLEntry = m_dbACL.GetNextEntry(m_dbACLEntry)
Wend
getACLEntries=names
m_ACLEntriesCount=i
End Function
'// Retourne tous les rôles de la LCA
Public Function getACLRoles() As Variant
Dim i As Integer
Dim roles As Variant
Redim roles(0)
Forall dbRoles In m_dbACL.Roles
Redim Preserve roles(i)
roles(i)=dbRoles
i=i+1
End Forall
getACLRoles=roles
m_ACLRolesCount=i
End Function
Public Function setNewEntry(pEntry As Variant,pAccess As String)
Dim EntryName As Variant
Dim entry As NotesACLEntry
Dim acces As Integer
acces=getIntLevel(pAccess)
Set entry = New NotesACLEntry(m_dbACL, pEntry, acces)
Call m_dbACL.Save
End Function
Public Function setNewRole(pRole As String)
Call m_dbACL.AddRole( pRole )
Call m_dbACL.Save
End Function
Public Function renameRole(oldRole As String, newRole As String)
Call m_dbACL.RenameRole( oldRole, newRole )
Call m_dbACL.Save
End Function
Public Function deleteRole(role As String)
Call m_dbACL.DeleteRole( role )
Call m_dbACL.Save
End Function
'// Qui possède cet accès
Public Function whoHasAccess(pAccess As String) As Variant
Dim acces As Integer
Dim names As Variant
Dim entry As NotesACLEntry
Dim i As Integer
Redim names(0)
acces=getIntLevel(pAccess)
Set entry = m_dbACL.GetFirstEntry
While Not (entry Is Nothing)
If entry.Level = acces Then
Redim Preserve names(i)
names(i)=entry.Name
i=i+1
End If
Set entry = m_dbACL.GetNextEntry(entry)
Wend
whoHasAccess=names
End Function
Public Function getType() As Integer
Dim entry As NotesACLEntry
Set entry=getCurrentEntry("")
getType=entry.UserType
End Function
Public Function getUserType(pUser As String) As Integer
Dim entry As NotesACLEntry
Dim t As Integer
Set entry=getCurrentEntry(pUser)
t=entry.UserType
End Function
Public Function getStrType() As Integer
Dim entry As NotesACLEntry
Set entry=getCurrentEntry("")
getStrType=getStringType(entry.UserType)
End Function
Public Function getStrUserType(pUser As String) As Integer
Dim entry As NotesACLEntry
Dim t As Integer
Set entry=getCurrentEntry(pUser)
getStrUserType=getStringType(entry.UserType)
End Function
'// L'utilisateur a-t-il ce rôle
Public Function hasRole(pRole As String) As Integer
Dim entry As NotesACLEntry
If Left$(pRole,1)<>"[" Then pRole="[" & pRole & "]"
Set entry=getCurrentEntry("")
hasRole= isEnabledRole(entry,pRole)
End Function
Public Function userHasRole(pUser As String, pRole As String) As Integer
Dim entry As NotesACLEntry
If Left$(pRole,1)<>"[" Then pRole="[" & pRole & "]"
Set entry=getCurrentEntry(pUser)
userHasRole= isEnabledRole(entry,pRole)
End Function
Public Function disableUserRole(pUser As String,pRole As String)
Dim entry As NotesACLEntry
Set entry=getCurrentEntry(pUser)
Call entry.DisableRole( pRole )
End Function
Public Function enableUserRole(pUser As String,pRole As String)
Dim entry As NotesACLEntry
Set entry=getCurrentEntry(pUser)
Call entry.EnableRole( pRole )
End Function
Public Function hasAccess(pAcces As String) As Integer
Dim entry As NotesACLEntry
Dim acces As Integer
Set entry=getCurrentEntry("")
If entry.Level=acces Then hasAccess=True
End Function
Public Function getAccessLevel() As Integer
Dim entry As NotesACLEntry
Set entry=getCurrentEntry("")
If Not entry Is Nothing Then
getAccessLevel=entry.Level
End If
End Function
Public Function getStrAccessLevel() As String
Dim level As Integer
Dim strLevel As String
level=getAccessLevel()
getStrAccessLevel=getStringLevel(level)
End Function
Public Function getUserAccessLevel(pUser As String) As Integer
Dim entry As NotesACLEntry
Set entry=getCurrentEntry(pUser)
If Not entry Is Nothing Then
getUserAccessLevel=entry.Level
End If
End Function
Public Function getAllRoles() As Variant
Dim entry As NotesACLEntry
Dim i As Integer
Dim roles As Variant
Redim roles(0)
Set entry=getCurrentEntry("")
If Not entry Is Nothing Then
getAllRoles=getEntryRoles(entry)
End If
End Function
Public Function getAllUserRoles(pUser As String)
Dim entry As NotesACLEntry
Dim i As Integer
Dim roles As Variant
Redim roles(0)
Set entry=getCurrentEntry(pUser)
If Not entry Is Nothing Then
getAllUserRoles=getEntryRoles(entry)
End If
End Function
'// Qui possède ce rôle ?
Public Function whoHasRole(pRole As String) As Variant
Dim found As Integer
Dim i As Integer
Dim names As Variant
Dim entry As NotesACLEntry
Set db = session.CurrentDatabase
Set acl = db.ACL
pRole = "[" & pRole & "]"
Forall r In m_dbacl.Roles
If ( r = pRole ) Then
found= True
Exit Forall
End If
End Forall
If found Then
Redim names(0)
Set entry = m_dbacl.GetFirstEntry
While Not ( entry Is Nothing )
If entry.IsRoleEnabled(pRole) Then
Redim Preserve names(i)
names(i)=entry.Name
i=i+1
End If
Set entry = m_dbacl.GetNextEntry( entry )
Wend
End If
whoHasRole=names
End Function
'// Récupère l'entrée d'un utilisateur dans la LCA
Public Function getCurrentEntry(who As String) As NotesACLEntry
Dim entry As NotesACLEntry
Dim nn As NotesName
who=Trim$(who)
If who="" Then
Set entry = m_dbacl.GetEntry(m_session.CommonUsername)
If entry Is Nothing Then Set entry = m_dbacl.GetEntry(m_session.Username)
Else
Set nn=New NotesName(who)
Set entry = m_dbacl.GetEntry(nn.Canonical)
End If
If Not entry Is Nothing Then m_inACL=True
Set getCurrentEntry=entry
End Function
'// Vérifie si l'entrée possède le rôle
Private Function isEnabledRole(entry As NotesAclEntry, pRole As String) As Integer
pRole=Trim$(pRole)
If Not entry Is Nothing Then
isEnabledRole= entry.IsRoleEnabled(pRole)
End If
End Function
Private Function getEntryRoles(entry As NotesACLEntry) As Variant
Dim i As Integer
Dim roles As Variant
Redim roles(0)
If Not entry Is Nothing Then
Forall r In entry.Roles
Redim Preserve roles(i)
roles(i)=r
i=i+1
End Forall
getEntryRoles=roles
End If
End Function
Private Function getStringLevel(level As Integer) As String
Dim strLevel As String
Select Case level
Case ACLLEVEL_NOACCESS
strLevel="PAS D'ACCES"
Case ACLLEVEL_DEPOSITOR
strLevel="DEPOSANT"
Case ACLLEVEL_READER
strLevel="LECTEUR"
Case ACLLEVEL_EDITOR
strLevel="EDITEUR"
Case ACLLEVEL_DESIGNER
strLEVEL="CONCEPTEUR"
Case ACLLEVEL_MANAGER
strLevel="GESTIONNAIRE"
End Select
getStringLevel=strLevel
End Function
Private Function getIntLevel(pAcces As String) As Integer
Dim acces As String
Select Case Ucase$(pAcces)
Case "N","NOACCESS","PASACCES"
acces=ACLLEVEL_NOACCESS
Case "D","DEPOSITOR","DEPOSANT"
acces=ACLLEVEL_DEPOSITOR
Case "R","READER","LECTEUR"
acces=ACLLEVEL_READER
Case "E","EDITOR","EDITEUR"
acces=ACLLEVEL_EDITOR
Case "C","DESIGNER","CONCEPTEUR"
acces=ACLLEVEL_DESIGNER
Case "M","A","G","MANAGER","GESTIONNAIRE"
acces=ACLLEVEL_MANAGER
End Select
getIntLevel=acces
End Function
Private Function getStringType(t As Integer) As String
Dim st As String
Select Case t
Case CLTYPE_UNSPECIFIED
st="NON SPECIFIE"
Case ACLTYPE_PERSON
st="PERSONNE"
Case ACLTYPE_SERVER
st="SERVEUR"
Case ACLTYPE_MIXED_GROUP
st="GROUPE MIXTE"
Case ACLTYPE_PERSON_GROUP
st="GROUPE DE PERSONNES"
Case ACLTYPE_SERVER_GROUP
st="GROUPE DE SERVEURS"
End Select
getStringType=st
End Function
End Class
(pour éviter le point précédent) 
