étrange... je l'avais posté je crois... et il n'y est plus
- Code : Tout sélectionner
Public Class NABGroup
Private m_session As NotesSession
Private m_db As NotesDatabase
Private m_dbNames As NotesDatabase
Private m_viewGroup As NotesView
Private m_docGroup As NotesDocument
Private m_itemMember As NotesItem
Private m_serverName As String
Private m_members As Variant
'// Constructeur
Sub new (groupName As String)
Set m_session=New NotesSession
Set m_db=m_session.CurrentDatabase
m_serverName=m_db.Server
Set m_dbNames=New NotesDatabase(m_serverName,"names.nsf")
Set m_viewGroup=m_dbNames.Getview("Groups")
Set m_docGroup=m_viewGroup.GetDocumentByKey(groupName)
Set m_itemMember=m_docGroup.GetFirstitem("Members")
m_members=m_docGroup.Members
End Sub
'// Vérifie si on a trouvé le groupe
Property Get isFound As Integer
If Not m_docGroup Is Nothing Then isFound=True Else isFound=False
End Property
'// Vérifie si un utilisateur est dans ce groupe
Public Function isMember(member As String) As Integer
isMember=m_itemMember.Contains(pCanonicName(member))
End Function
'// Ajout d'un membre dans ce groupe
Public Sub addMember(member As String)
If Not isMember(member) Then
Call m_itemMember.AppendToTextList( pCanonicName(member) )
Call save
End If
End Sub
'// Suppression d'un membre du groupe
Public Sub deleteMember(member As String)
If isMember(member) Then pDeleteMember(pCanonicName(member))
Call save
End Sub
Public Sub browseMembers()
Forall m In m_members
Msgbox m
End Forall
End Sub
Public Sub remove()
Call m_docGroup.Remove(True)
End Sub
'// procédure de suppression
Private Sub pDeleteMember(member As String)
Dim group As Variant
Forall m In m_members
If pCanonicName(m)<>member Then
Call pAddMemberToArray(group,m)
End If
End Forall
m_docGroup.Members=group
End Sub
'// procédure d'ajout d'un membre
Private Sub pAddMemberToArray (group As Variant, m As Variant)
If Isempty(group) Then
Redim group(0)
Else
Redim Preserve group(Ubound(group)+1)
End If
group(Ubound(group))=m
End Sub
'// Transformation canonique
Private Function pCanonicName(member As Variant)
Dim nn As NotesName
Set nn=New NotesName(member)
'Msgbox "canonical = " & nn.Canonical
'Msgbox "abbreviated = " & nn.Abbreviated
'Msgbox "common = " & nn.Common
pCanonicName=nn.Canonical
End Function
Private Function pCommonName(member As Variant)
Dim nn As NotesName
Set nn=New NotesName(member)
pCommonName=nn.Common
End Function
Private Function pAbbreviatedName(member As Variant)
Dim nn As NotesName
Set nn=New NotesName(member)
pAbbreviatedName=nn.Abbreviated
End Function
Public Sub save()
Call m_docGroup.Save(True,False)
End Sub
End Class
à ajouter par exemple une méthode qui renvoie les membres d'un groupe comme
- Code : Tout sélectionner
public function getMembers() as variant
etMembers=m_members
end function
et ensuite exploiter le contenu par un balayage de tableau avec un forall
