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

本文转自 高文龙 51CTO博客，原文链接：http://blog.51cto.com/gaowenlong/1186332，如需转载请自行联系原作者