DominoArea.org [Archive]

Voici une première version
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

Bonjour,

Quelques modifs.

Code : Tout sélectionner

Public Class ACLProperty
%REM
   =========================================================
   Classe de gestion de la LCA des utilisateurs
   et groupes.
   Auteur         :    Oguruma (Dominoarea.org)
   Modificateur      :   Stéphane Maillard
   Date de création   :   25/07/2005
   Date de modification :   13/04/2006
   =========================================================
   Modification :   Ajout de Call m_dbACL.Save dans les
   fonctions enableUserRole et disableUserRole
   Gestion multi-serveurs/bases dans le New
   Ajout de la suppression des Entry's
   Ajout de l'accès Auteur dans les droits
   =========================================================
   Historique :   13/04/2006 (v 1.3) Ajout de l'accès Auteur
            13/04/2006 (v 1.2) Ajout de deleteEntry
            13/04/2006 (v 1.1) Modification
            25/07/2005 (v 1) Initiale.
   =========================================================
%ENDREM
   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 (sServeur As String, sDatabase As String)
      Set m_session = New NotesSession
      If sDatabase = "" Then
         Set m_db = m_session.CurrentDatabase
      Else
         Set m_db = m_session.GetDatabase(sServeur, sDatabase, False)
      End If
      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 deleteEntry(pEntry As Variant)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      Call entry.Remove
      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 )
      Call m_dbACL.Save
   End Function
   
   Public Function enableUserRole(pUser As String,pRole As String)
      Dim entry As NotesACLEntry
      Set entry=getCurrentEntry(pUser)
      Call entry.EnableRole( pRole )
      Call m_dbACL.Save
   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_AUTHOR
         strLevel="AUTEUR"
      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 "A","AUTHOR","AUTEUR"
         acces=ACLLEVEL_AUTHOR
      Case "E","EDITOR","EDITEUR"
         acces=ACLLEVEL_EDITOR
      Case "C","DESIGNER","CONCEPTEUR"
         acces=ACLLEVEL_DESIGNER
      Case "M","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

Ok, merci Stéphane pour ces mises à journ de code, elles sont toutes à ton honneur.

Modifications :
(16/01/2007)
* New() : suppression de la prise en charge de la base courante si la valeur de Server est vide ("").
* getStringType() : remplacement de 'Case CLTYPE_UNSPECIFIED' par 'Case Else' car la constant CLTYPE_UNSPECIFIED n'est pas reconnue à la compilation (testé en V7.0.x)
* whoHasRole() : suppression de la définition des variables 'db' et 'acl' qui n'ont pas lieu d'exiter!
+ 'Option declare' en début de code afin d'éviter les variables non déclarées !!! (pour éviter le point précédent)

Code : Tout sélectionner

Option Declare
Public Class cACL
%REM
   =========================================================
   Classe de gestion de la LCA des utilisateurs
   et groupes.
   Auteur :    Oguruma (Dominoarea.org)
   Modificateur :   Stéphane Maillard @ DominoArea (13/04/2006)
   Modificateur : Olivier FRANCHET @ Dominux (16/01/2007)
   Date de création   :   25/07/2005
   =========================================================
   Modifications :
   (16/01/2007)
   * New() : suppression de la prise en charge de la base
   courante si la valeur de Server est vide ("").
   * getStringType() : remplacement de  'Case CLTYPE_UNSPECIFIED'
   par 'Case Else' car la constant CLTYPE_UNSPECIFIED n'est pas reconnue
   à la compilation (testé en V7.0.x)
   * whoHasRole() : suppression de la définition des variables 'db'
   et 'acl' qui n'ont pas lieu d'exiter!
   (13/04/2006)
   + Ajout de Call m_dbACL.Save dans les
   fonctions enableUserRole et disableUserRole
   Gestion multi-serveurs/bases dans le New
   + Ajout de la suppression des Entry's
   + Ajout de l'accès Auteur dans les droits
   =========================================================
   Historique :
      15/01/2007 (v 1.4) Corrections
      13/04/2006 (v 1.3) Ajout de l'accès Auteur
      13/04/2006 (v 1.2) Ajout de deleteEntry
      13/04/2006 (v 1.1) Modification
      25/07/2005 (v 1) Initiale.
   =========================================================
%ENDREM
   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
   Private m_dbACLEntry As NotesACLEntry
   
   Sub new (sServeur As String, sDatabase As String)
      Set m_session = New NotesSession
      Set m_db = m_session.GetDatabase(sServeur, sDatabase, False)
      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 deleteEntry(pEntry As Variant)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      Call entry.Remove
      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 )
      Call m_dbACL.Save
   End Function
   
   Public Function enableUserRole(pUser As String,pRole As String)
      Dim entry As NotesACLEntry
      Set entry=getCurrentEntry(pUser)
      Call entry.EnableRole( pRole )
      Call m_dbACL.Save
   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
      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_AUTHOR
         strLevel="AUTEUR"
      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 "A","AUTHOR","AUTEUR"
         acces=ACLLEVEL_AUTHOR
      Case "E","EDITOR","EDITEUR"
         acces=ACLLEVEL_EDITOR
      Case "C","DESIGNER","CONCEPTEUR"
         acces=ACLLEVEL_DESIGNER
      Case "M","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 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"
      Case Else 'CLTYPE_UNSPECIFIED
         st="NON SPECIFIE"
      End Select
      getStringType=st
   End Function
   
End Class


Bonjour Olivier,

Merci pour les modifs.

Thanks....
Il est vrai que j'avais remarqué cette faiblesse/manque de l'option declare

merci pour cette contribution

ps : ma V2 de mail (anonyme) devrait évoluer... j'ai quelques idées....
du reste j'ai remarque qu'elle n'est pas prévue pour fonctionner en mode batch sur serveur
je vais tenter de revoir le constructeur et des classes propres à chaque type d'utilisation avec héritage du noyau...
y faut aussi avoir du temps... et depuis plus d'un an c'est galère... pour trouer du temps

Salut,

Un ajout setEntryType donne ou change un type à l'entrée en cours.

Code : Tout sélectionner

Public Class cACL
%REM
   =========================================================
   Classe de gestion de la LCA des utilisateurs
   et groupes.
   Auteur :    Oguruma (Dominoarea.org)
   Modificateur :   Stéphane Maillard @ DominoArea (13/04/2006)
   Modificateur : Olivier FRANCHET @ Dominux (16/01/2007)
   Modificateur : Stéphane Maillard @ Dominoarea (25/08/2007)
   Date de création   :   25/07/2005
   =========================================================
   Modifications :
   (25/08/2007)
   * setUserType : Ajoute ou change le type de l'entrée
   (16/01/2007)
   * New() : suppression de la prise en charge de la base
   courante si la valeur de Server est vide ("").
   * getStringType() : remplacement de  'Case CLTYPE_UNSPECIFIED'
   par 'Case Else' car la constant CLTYPE_UNSPECIFIED n'est pas reconnue
   à la compilation (testé en V7.0.x)
   * whoHasRole() : suppression de la définition des variables 'db'
   et 'acl' qui n'ont pas lieu d'exiter!
   (13/04/2006)
   + Ajout de Call m_dbACL.Save dans les
   fonctions enableUserRole et disableUserRole
   Gestion multi-serveurs/bases dans le New
   + Ajout de la suppression des Entry's
   + Ajout de l'accès Auteur dans les droits
   =========================================================
   Historique :
      25/08/2007 (v 1.5) Ajout ou modification du type de l'entrée
      15/01/2007 (v 1.4) Corrections
      13/04/2006 (v 1.3) Ajout de l'accès Auteur
      13/04/2006 (v 1.2) Ajout de deleteEntry
      13/04/2006 (v 1.1) Modification
      25/07/2005 (v 1) Initiale.
   =========================================================
%ENDREM
   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
   Private m_dbACLEntry As NotesACLEntry
   
   Sub new (sServeur As String, sDatabase As String)
      Set m_session = New NotesSession
      Set m_db = m_session.GetDatabase(sServeur, sDatabase, False)
      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
   
   '// Ajoute ou change le type de l'entrée
   Public Function setEntryType(pEntry As Variant, sType As String)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      entry.UserType = sType
      Call m_dbACL.Save
   End Function
   
   Public Function deleteEntry(pEntry As Variant)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      Call entry.Remove
      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 )
      Call m_dbACL.Save
   End Function
   
   Public Function enableUserRole(pUser As String,pRole As String)
      Dim entry As NotesACLEntry
      Set entry=getCurrentEntry(pUser)
      Call entry.EnableRole( pRole )
      Call m_dbACL.Save
   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
      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_AUTHOR
         strLevel="AUTEUR"
      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 "A","AUTHOR","AUTEUR"
         acces=ACLLEVEL_AUTHOR
      Case "E","EDITOR","EDITEUR"
         acces=ACLLEVEL_EDITOR
      Case "C","DESIGNER","CONCEPTEUR"
         acces=ACLLEVEL_DESIGNER
      Case "M","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 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"
      Case Else 'CLTYPE_UNSPECIFIED
         st="NON SPECIFIE"
      End Select
      getStringType=st
   End Function
   
End Class

heureux de voir que ce début de code rend service et motive quelques corrections

Salut,

Comme la base est de bonne facture c'est normal d'ajouter les besoin de chacun dedans. C'est comme une bonne mayonnaise.

Bonjour,

Dans les 2 property ACLEntriesCount et ACLRolesCount, il manque l'appelle aux functions getACLEntries et getACLRoles, si on les utilise tout de suite.

j'avoue ne pas avoir suivi toutes les évol... mais je ne comprends pas trop ta remarque... dsl... réveil difficile

Bonjour,

Correction d'un bug sur getUserType

Code : Tout sélectionner

Public Class cACL
%REM
   =========================================================
   Classe de gestion de la LCA des utilisateurs et groupes.
   Auteur         :   Oguruma (Dominoarea.org)
   Modificateur   :   Stéphane Maillard @ DominoArea (13/04/2006)
   Modificateur   :   Olivier FRANCHET @ Dominux (16/01/2007)
   Modificateur   :   Stéphane Maillard @ Dominoarea (25/08/2007)
               Stéphane Maillard @ Dominoarea (03/01/2008)
   Date de création   :   25/07/2005
   =========================================================
   Modifications :
   (03/01/2008)
   * getUserType : Correction de la fonction, ne retourne rien puisqu'à
   l'origine c'est la variable t qui prend le retour mais pas la fonction
/** Ancienne fonction :
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
**/ Remplacé par
    ============
/** Nouvelle fonction :
Public Function getUserType(pUser As String) As Integer
   Dim entry As NotesACLEntry
   Set entry=getCurrentEntry(pUser)
   getUserType = entry.UserType
End Function
**/ Fin
   (25/08/2007)
   + setUserType : Ajoute ou change le type de l'entrée
   (16/01/2007)
   * New() : suppression de la prise en charge de la base
   courante si la valeur de Server est vide ("").
   * getStringType() : remplacement de  'Case CLTYPE_UNSPECIFIED'
   par 'Case Else' car la constant CLTYPE_UNSPECIFIED n'est pas reconnue
   à la compilation (testé en V7.0.x)
   * whoHasRole() : suppression de la définition des variables 'db'
   et 'acl' qui n'ont pas lieu d'exiter!
   (13/04/2006)
   + Ajout de Call m_dbACL.Save dans les
   fonctions enableUserRole et disableUserRole
   Gestion multi-serveurs/bases dans le New
   + Ajout de la suppression des Entry's
   + Ajout de l'accès Auteur dans les droits
   =========================================================
   Historique :
    03/01/2008 (v 1.6) Correction getUserType
      25/08/2007 (v 1.5) Ajout ou modification du type de l'entrée
      15/01/2007 (v 1.4) Corrections
      13/04/2006 (v 1.3) Ajout de l'accès Auteur
      13/04/2006 (v 1.2) Ajout de deleteEntry
      13/04/2006 (v 1.1) Modification
      25/07/2005 (v 1) Initiale.
   =========================================================
%ENDREM
   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
   Private m_dbACLEntry As NotesACLEntry
   
   Sub new (sServeur As String, sDatabase As String)
      Set m_session = New NotesSession
      Set m_db = m_session.GetDatabase(sServeur, sDatabase, False)
      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
   
   '// Ajoute ou change le type de l'entrée
   Public Function setEntryType(pEntry As Variant, sType As String)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      entry.UserType = sType
      Call m_dbACL.Save
   End Function
   
   Public Function deleteEntry(pEntry As Variant)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      Call entry.Remove
      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
      Set entry=getCurrentEntry(pUser)
      getUserType = 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 )
      Call m_dbACL.Save
   End Function
   
   Public Function enableUserRole(pUser As String,pRole As String)
      Dim entry As NotesACLEntry
      Set entry=getCurrentEntry(pUser)
      Call entry.EnableRole( pRole )
      Call m_dbACL.Save
   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
      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_AUTHOR
         strLevel="AUTEUR"
      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 "A","AUTHOR","AUTEUR"
         acces=ACLLEVEL_AUTHOR
      Case "E","EDITOR","EDITEUR"
         acces=ACLLEVEL_EDITOR
      Case "C","DESIGNER","CONCEPTEUR"
         acces=ACLLEVEL_DESIGNER
      Case "M","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 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"
      Case Else 'CLTYPE_UNSPECIFIED
         st="NON SPECIFIE"
      End Select
      getStringType=st
   End Function
   
End Class

Salut,

Ajout de => Public Function getUserStringAccess(pUser As String) As String

Code : Tout sélectionner

Option Public
Option Explicit

Public Class cACL
%REM
   =========================================================
   Classe de gestion de la LCA des utilisateurs et groupes.
   Auteur         :   Oguruma (Dominoarea.org)
   Modificateur   :   Stéphane Maillard @ DominoArea (13/04/2006)
   Modificateur   :   Olivier FRANCHET @ Dominux (16/01/2007)
   Modificateur   :   Stéphane Maillard @ Dominoarea (25/08/2007)
               Stéphane Maillard @ Dominoarea (03/01/2008)
               Stéphane Maillard @ Dominoarea (15/01/2008) 
   Date de création   :   25/07/2005
   =========================================================
   Modifications :
   (15/01/2008)
   + getUserStringAccess : Récupère l'accès de l'utilisateur passé
   en paramètre en string
   (03/01/2008)
   * getUserType : Correction de la fonction, ne retourne rien puisqu'à
   l'origine c'est la variable t qui prend le retour mais pas la fonction
/** Ancienne fonction :
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
**/ Remplacé par
    ============
/** Nouvelle fonction :
Public Function getUserType(pUser As String) As Integer
   Dim entry As NotesACLEntry
   Set entry=getCurrentEntry(pUser)
   getUserType = entry.UserType
End Function
**/ Fin
   (25/08/2007)
   + setUserType : Ajoute ou change le type de l'entrée
   (16/01/2007)
   * New() : suppression de la prise en charge de la base
   courante si la valeur de Server est vide ("").
   * getStringType() : remplacement de  'Case CLTYPE_UNSPECIFIED'
   par 'Case Else' car la constant CLTYPE_UNSPECIFIED n'est pas reconnue
   à la compilation (testé en V7.0.x)
   * whoHasRole() : suppression de la définition des variables 'db'
   et 'acl' qui n'ont pas lieu d'exiter!
   (13/04/2006)
   + Ajout de Call m_dbACL.Save dans les
   fonctions enableUserRole et disableUserRole
   Gestion multi-serveurs/bases dans le New
   + Ajout de la suppression des Entry's
   + Ajout de l'accès Auteur dans les droits
   =========================================================
   Historique :
      15/01/2008 (v 1.7) Ajout de getUserStringAccess
    03/01/2008 (v 1.6) Correction getUserType
      25/08/2007 (v 1.5) Ajout ou modification du type de l'entrée
      15/01/2007 (v 1.4) Corrections
      13/04/2006 (v 1.3) Ajout de l'accès Auteur
      13/04/2006 (v 1.2) Ajout de deleteEntry
      13/04/2006 (v 1.1) Modification
      25/07/2005 (v 1) Initiale.
   =========================================================
%ENDREM
   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
   Private m_dbACLEntry As NotesACLEntry
   
   Sub new (sServeur As String, sDatabase As String)
      Set m_session = New NotesSession
      Set m_db = m_session.GetDatabase(sServeur, sDatabase, False)
      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
   
   '// Ajoute ou change le type de l'entrée
   Public Function setEntryType(pEntry As Variant, sType As String)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      entry.UserType = sType
      Call m_dbACL.Save
   End Function
   
   Public Function deleteEntry(pEntry As Variant)
      Dim entry As NotesACLEntry
      Set entry = m_dbACL.GetEntry( pEntry )
      Call entry.Remove
      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
   
   ' Récupère l'accès de l'utilisateur en cours en string
   Public Function getUserStringAccess(pUser As String) As String
      Dim entry As NotesACLEntry
      Set entry = getCurrentEntry(pUser)
      getUserStringAccess = getStringLevel(entry.Level)
   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
      Set entry=getCurrentEntry(pUser)
      getUserType = 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 )
      Call m_dbACL.Save
   End Function
   
   Public Function enableUserRole(pUser As String,pRole As String)
      Dim entry As NotesACLEntry
      Set entry=getCurrentEntry(pUser)
      Call entry.EnableRole( pRole )
      Call m_dbACL.Save
   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
      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_AUTHOR
         strLevel="AUTEUR"
      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 "A","AUTHOR","AUTEUR"
         acces=ACLLEVEL_AUTHOR
      Case "E","EDITOR","EDITEUR"
         acces=ACLLEVEL_EDITOR
      Case "C","DESIGNER","CONCEPTEUR"
         acces=ACLLEVEL_DESIGNER
      Case "M","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 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"
      Case Else 'CLTYPE_UNSPECIFIED
         st="NON SPECIFIE"
      End Select
      getStringType=st
   End Function
   
End Class

salut

ça serais bien de tout rassembler en un seul tips, non ?

Salut,

Pour le moment je travail dessus on fera ça pour la v2.