Domino8.5下邮件组成员身份验证（二）

 Domino8.5下邮件组成员身份验证（二）

之前写过一篇文章，主要介绍了如何验证邮件组内的成员是否存在DOmino列表中的；因为我们都知道Domino是一个开源的软件，邮件组内的成员可以手动去添加，如果添加了未知用户的话在给邮件组发送邮件会有退信提示，说某个用户不在domino列表中，上篇文章中几乎可以满足，但是缺点是邮件组嵌套的邮件组无法查询，以下为网友更改后的代码：

Sub Initialize
    On Error Goto errH
   
   
   
    Dim session As NotesSession
    Dim nab As NotesDatabase , view As NotesView , group As NotesDocument
    Dim dc As NotesDocumentCollection
    Dim tmp As NotesDocument , item As NotesItem
   
    Set session = New NotesSession
   
   
    '打开Notes Domino Directory
    Msgbox |1. Open Domino Directory (|+session.Currentdatabase.Server+|!!|+ NAB_DB_PATH$ +|) ... |
    Set nab = session.Getdatabase( session.Currentdatabase.Server , NAB_DB_PATH$  )
    If Not nab.Isopen Then
        Msgbox |*** Cannot open Domino Directory :( , Quit. |
        Exit Sub
    End If
    Msgbox |1. Domino Directory opened.|
   
   
    'open view
    Msgbox |2. Process all groups ...|
    Set view = nab.Getview( GROUP_VIEW_NAME$ )
    If view Is Nothing Then
        Msgbox |*** Cannot open Group View (|+ GROUP_VIEW_NAME$ +|) :( , Quit. |
        Exit Sub
    End If
   
    '临时存储
    Set tmp = session.Currentdatabase.Createdocument()
    'processing docs in view
    Set group = view.Getfirstdocument()
    While Not group Is Nothing
        '说明：
        '  判断组成员是否存在于NAB中
        '  判断方法 - 在NAB中检索组成员是否存在
        '
        Msgbox |[!] Processing GROUP:|+group.ListName(0)
        tmp.tmpMembers = ""
        Set item = tmp.Replaceitemvalue("tmpMembers", "")
        Forall v In group.Members
            If Len(Trim$(v))>0 Then 'v不是空字符串
                '检索这个组中的成员中的组、个人和服务器是否存在
                Set dc = nab.Search({
(Type="Group"&GroupType!="3"&Form="Group"&@UpperCase(ListName)="}+Ucase$(v)+{")
|
(Type="Person"&@IsMember(@Name([Abbreviate];"}+ Ucase$(v) +{");@Name([Abbreviate];@UpperCase(FullName))))
|
(Type="Person"&@UpperCase(InternetAddress)="}+ Ucase$(v) +{")
| 
(Type="Server":"X400Server":"POServer"&Form="Server":"X400Server":"cc:Mail Post Office Server"&@Name([Abbreviate];@UpperCase(ServerName))=@Name([Abbreviate];"}+Ucase$(v)+{") )
} , Nothing , 1) '检索一个FullName
                If dc.Count>0 Then
                    Msgbox |+++ |+ v +| in GROUP:|+group.ListName(0)+| found in NAB.|
                    Call item.Appendtotextlist(v)
                Else
                    Msgbox |--- |+ v +| in GROUP:|+group.ListName(0)+| NOT found in NAB.|
                End If
            End If
        End Forall
        group.Members = Evaluate(| @Sort(@Trim(@Unique(tmpMembers))) |,tmp)
        Call group.save(True,True)
       
        Set group = view.Getnextdocument(group)
    Wend
    Msgbox |2. Process all groups ... done.|
   
   
   
    Exit Sub
errH:
    Msgbox "AA-001 error: "+Error$+"@"+Cstr(Erl())
    Exit Sub
End Sub