Domino 9下通过程序删除并记录未知用户及邮件组
说道domino相信大家都很熟悉了，而我们今天呢，主要介绍在Domino 9下通过程序删除并记录未知用户及邮件组，是什么意思呢，我们都知道Domino提供的邮件服务是个人数据库文件系统，每个邮箱用户都有一个独立的数据库存放邮件信息，跟其他提供邮件服务的系统不一样，当然Domino使用起来比较灵活，可以根据自己的需求开发自定义功能，由此可见使用起来相当灵活了，但是同时也会有另外一个问题产生，那就是邮件管理员可以误操作导致邮件信息错误。比如邮件组，定义一个邮件组，然后添加邮件组成员，管理员可以手动自定义任何内容然后保存，这样会导致给邮件组发送邮件时导致退信的问题，所以呢，我们今天就为了解决该问题部署了一个判断程序。具体见下：
首先是环境介绍：
邮件组：
我们再次在group_01 group_02下添加在domino目录下不存在的用户级邮件组进行程序判断，添加一些无效的用户
同样在group_02下添加无效用户
我们是需要创建一个空的数据库文件AutoDealgroup.nsf
打开Domino控制台---单击文件---应用程序----新建--------
我们选择数据库的应用服务器，然后选择模板---空---确认
然后我们定以后通过desinger工具打开该数据库即可；
同时因为我们需要把操作的字段记录下来，所以我们需要定义一个表单；定义需要显示的字段，然后填写传输字段即可：strDate字段显示日期及时间
类别strType
StrGroupName
StrContent
stRestoe
表单定义完后，我们接下来定义代理程序了
代理内容：
注：对Localdomainadmin、localdomainserver、等服务器组不做检查判断
%REM
Agent 定时处理群组
%END REM
Option Public
Option Declare
Dim session As NotesSession
Dim agt As NotesAgent
Dim dbcur As NotesDatabase
Dim namedb As NotesDatabase
Dim vwpsn As NotesView
Dim vwpsnbylname As NotesView
Dim vwgroup As NotesView
Sub Initialize
On Error Goto err_line
Dim entries As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim docGp As NotesDocument
Dim blnInit As Boolean
Dim i As Integer
Dim intLen As Integer
Dim vntMembers As Variant
Dim ind As Integer
Dim strContent As String
MsgBox "*********定时处理群组**********Start"
'初始化
blnInit = fnInit()
'初始化完成
If blnInit Then
'遍历群组
Set entries = vwgroup.Allentries
intLen = entries.Count
For i=1 To intLen
Set entry = entries.Getnthentry(i)
If Not entry Is Nothing Then
If entry.Isvalid Then
If entry.Isdocument Then
Set docGp = entry.Document
If Not docGp Is Nothing Then
If fnIsDealGroup(docGp.listname(0)) Then
strContent = ""
vntMembers = docGp.Members
For ind=0 To UBound(vntMembers)
If vntMembers(ind) <> "" Then
'判断成员是否为有效用户
If Not checkIsUser(vntMembers(ind)) Then
'判断成员是否为有效群组
If Not checkIsGroup(vntMembers(ind)) Then
strContent = strContent + "," + vntMembers(ind)
vntMembers(ind) = ""
End If
End If
End If
Next
'成员有更新，则保存群组文档
If strContent <> "" Then
docGp.Members = FullTrim(ArrayUnique(vntMembers))
Call docGp.Computewithform(False , False)
If docGp.Save(False,False) Then
'记录操作日志
Call fnSetOptLog(docGp.listname(0),strContent)
End If
End If
End If
End If
End If
End If
End If
Next
End If
MsgBox "*********定时处理群组**********End"
Exit Sub
err_line:
Call showError("Initialize")
End Sub
%REM
Description: 判断群组是否需要处理
%END REM
Function fnIsDealGroup(gpname As String) As Boolean
On Error GoTo err_line
fnIsDealGroup = True
Select Case LCase(gpname)
Case "localdomainservers","otherdomainservers","localdomainadmins" :
fnIsDealGroup = False
End Select
Exit Function
err_line:
Call showError("fnIsDealGroup")
MsgBox "判断群组【"+gpname+"】是否允许处理时出错，不处理"
fnIsDealGroup = False
End Function
Function fnInit() As Boolean
On Error GoTo err_line
Set session = New NotesSession
Set agt = session.Currentagent
Set dbcur = session.Currentdatabase
Set namedb = session.Getdatabase("","names.nsf",False)
If Not namedb Is Nothing Then
Set vwpsn = namedb.Getview("($VIMPeople)")
Set vwpsnbylname = namedb.Getview("($VIMPeopleByLastName)")
Set vwgroup = namedb.Getview("($VIMGroups)")
If (vwpsn Is Nothing Or vwpsnbylname Is Nothing Or vwgroup Is Nothing) Then
fnInit = False
Exit Function
End If
Else
fnInit = False
Exit Function
End If
fnInit = True
Exit Function
err_line:
Call showError("fnInit")
fnInit = False
End Function
Sub showError(errmsg As String)
MsgBox agt.Name + " >> " + errmsg + " Error : " + Error + " at line : " & Erl
End Sub
%REM
Description: 记录操作日志
%END REM
Function fnSetOptLog(gpname As String,strContent As String)
On Error GoTo err_line
Dim doclog As NotesDocument
Dim vntContent As Variant
vntContent = Split(strContent,",")
vntContent = FullTrim(ArrayUnique(vntContent))
If vntContent(0) <> "" Then
Set doclog = dbcur.Createdocument()
doclog.form = "frmAutoDealGroupLog"
doclog.strDate = Format$(CStr(Now),"YYYY-MM-DD HH:MM:SS")
doclog.strType = "删除"
doclog.strGroupName = gpname
doclog.strContent = Join(vntContent,",")
doclog.strReason = "不是names中的有效用户或群组"
Call doclog.save(True,True)
End If
Exit Function
err_line:
Call showError("fnSetOptLog")
End Function
%REM
判断群组是否存在
%END REM
Function checkIsGroup(gpname As String) As Boolean
On Error GoTo err_line
Dim docGp As NotesDocument
checkIsGroup = True
Set docGp = vwgroup.Getdocumentbykey(gpname,True)
If docGp Is Nothing Then
checkIsGroup = False
End If
Exit Function
err_line:
Call showError("checkIsGroup")
checkIsGroup = True
End Function
%REM
判断用户是否存在
%END REM
Function checkIsUser(user As String) As Boolean
On Error Goto err_line
Dim ndoc As NotesDocument
Dim uname As NotesName
checkIsUser = True
If Instr(user,"/") > 0 Then
Set uname = New NotesName(user)
Set ndoc = vwpsn.Getdocumentbykey(uname.Abbreviated,True)
Else
Set ndoc = vwpsnbylname.Getdocumentbykey(user,True)
End If
If ndoc Is Nothing Then
checkIsUser = False
End If
Exit Function
err_line:
Call showError("checkIsUser")
checkIsUser = True
End Function
定义好后，我们可以打开刚才创建的数据库
以上代码附件后保存即可。
接下来我们手动运行程序进行判断：
Tell amgr run “数据库名称” ‘代理名称’
执行后，我们查看log文件
我们为了定期自动检查，我们可以定义代理的计划任务
可以根据自己的需求定义即可
以上程序当然是对Domino目录下的所有邮件组进行判断的，如果我们在Domino邮件组内添加了一些第三方的邮件组的话，而且邮件组的数量比较多的话，我们怎么做呢?任何对指定的邮件组进行梳理判断呢，当然，如果在邮件组数量不多的情况下，我们可以在当然情绪下添加需要跳过不做检查的邮件组；因为我们当前程序已添加了对localdomainadmins、localdomainserver等组不做检查，我们可以将不需要检查的组添加到代码中即可，注：前提是邮件组不多的情况下，如果多的话那就太麻烦了。
%REM Description: 判断群组是否需要处理 %END REM Function fnIsDealGroup(gpname As String) As Boolean On Error GoTo err_line fnIsDealGroup = True Select Case LCase(gpname) Case "localdomainservers","otherdomainservers","localdomainadmins" : fnIsDealGroup = False End Select
那如果邮件组多的话，我们应该怎么做了，比如我的真实环境下邮件组就比较多，我只能判断指定邮件组进行判断了，我们只需要稍微更改一下程序即可，添加一个表单，然后一个试图，然后需要只需要将指定的邮件组新建保存在试图即可
我们添加一个表单-----表单名称—待处理的群组
同样添加试图
试图添加后，我们修改代理代码：
%REM
Agent 定时处理群组
%END REM
Option Public
Option Declare
Dim session As NotesSession
Dim agt As NotesAgent
Dim dbcur As NotesDatabase
Dim namedb As NotesDatabase
Dim vwpsn As NotesView
Dim vwpsnbylname As NotesView
Dim vwgroup As NotesView
Dim arrDealGp As Variant
Sub Initialize
On Error Goto err_line
Dim entries As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim docGp As NotesDocument
Dim blnInit As Boolean
Dim i As Integer
Dim intLen As Integer
Dim vntMembers As Variant
Dim ind As Integer
Dim strContent As String
MsgBox "*********定时处理群组**********Start"
'初始化
blnInit = fnInit()
'初始化完成
If blnInit Then
'遍历群组
Set entries = vwgroup.Allentries
intLen = entries.Count
For i=1 To intLen
Set entry = entries.Getnthentry(i)
If Not entry Is Nothing Then
If entry.Isvalid Then
If entry.Isdocument Then
Set docGp = entry.Document
If Not docGp Is Nothing Then
If fnIsDealGroup(docGp.listname(0)) Then
strContent = ""
vntMembers = docGp.Members
For ind=0 To UBound(vntMembers)
If vntMembers(ind) <> "" Then
'判断成员是否为有效用户
If Not checkIsUser(vntMembers(ind)) Then
'判断成员是否为有效群组
If Not checkIsGroup(vntMembers(ind)) Then
strContent = strContent + "," + vntMembers(ind)
vntMembers(ind) = ""
End If
End If
End If
Next
'成员有更新，则保存群组文档
If strContent <> "" Then
docGp.Members = FullTrim(ArrayUnique(vntMembers))
Call docGp.Computewithform(False , False)
If docGp.Save(False,False) Then
'记录操作日志
Call fnSetOptLog(docGp.listname(0),strContent)
End If
End If
End If
End If
End If
End If
End If
Next
End If
MsgBox "*********定时处理群组**********End"
Exit Sub
err_line:
Call showError("Initialize")
End Sub
%REM
Description: 判断群组是否需要处理
%END REM
Function fnIsDealGroup(gpname As String) As Boolean
On Error GoTo err_line
fnIsDealGroup = True
Select Case LCase(gpname)
Case "localdomainservers","otherdomainservers","localdomainadmins" :
fnIsDealGroup = False
End Select
If Not IsEmpty(arrDealGp) Then
If IsNull(ArrayGetIndex(arrDealGp, gpname)) Then
fnIsDealGroup = False
End If
End If
Exit Function
err_line:
Call showError("fnIsDealGroup")
MsgBox "判断群组【"+gpname+"】是否允许处理时出错，不处理"
fnIsDealGroup = False
End Function
Function fnInit() As Boolean
On Error GoTo err_line
Dim vwDealGpConf As NotesView
Dim docDealGpConf As NotesDocument
Dim strDealGp As String
Set session = New NotesSession
Set agt = session.Currentagent
Set dbcur = session.Currentdatabase
Set namedb = session.Getdatabase("","names.nsf",False)
If Not namedb Is Nothing Then
Set vwpsn = namedb.Getview("($VIMPeople)")
Set vwpsnbylname = namedb.Getview("($VIMPeopleByLastName)")
Set vwgroup = namedb.Getview("($VIMGroups)")
If (vwpsn Is Nothing Or vwpsnbylname Is Nothing Or vwgroup Is Nothing) Then
fnInit = False
Exit Function
End If
Set vwDealGpConf = dbcur.Getview("vwNeedDealGroup")
If Not vwDealGpConf Is Nothing Then
Set docDealGpConf = vwDealGpConf.Getfirstdocument()
If Not docDealGpConf Is Nothing Then
strDealGp = docDealGpConf.strGroup(0)
strDealGp = Replace(strDealGp,"，",",")
arrDealGp = Split(strDealGp,",")
End If
End If
Else
fnInit = False
Exit Function
End If
fnInit = True
Exit Function
err_line:
Call showError("fnInit")
fnInit = False
End Function
Sub showError(errmsg As String)
MsgBox agt.Name + " >> " + errmsg + " Error : " + Error + " at line : " & Erl
End Sub
%REM
Description: 记录操作日志
%END REM
Function fnSetOptLog(gpname As String,strContent As String)
On Error GoTo err_line
Dim doclog As NotesDocument
Dim vntContent As Variant
vntContent = Split(strContent,",")
vntContent = FullTrim(ArrayUnique(vntContent))
If vntContent(0) <> "" Then
Set doclog = dbcur.Createdocument()
doclog.form = "frmAutoDealGroupLog"
doclog.strDate = Format$(CStr(Now),"YYYY-MM-DD HH:MM:SS")
doclog.strType = "删除"
doclog.strGroupName = gpname
doclog.strContent = Join(vntContent,",")
doclog.strReason = "不是names中的有效用户或群组"
Call doclog.save(True,True)
End If
Exit Function
err_line:
Call showError("fnSetOptLog")
End Function
%REM
判断群组是否存在
%END REM
Function checkIsGroup(gpname As String) As Boolean
On Error GoTo err_line
Dim docGp As NotesDocument
checkIsGroup = True
Set docGp = vwgroup.Getdocumentbykey(gpname,True)
If docGp Is Nothing Then
checkIsGroup = False
End If
Exit Function
err_line:
Call showError("checkIsGroup")
checkIsGroup = True
End Function
%REM
判断用户是否存在
%END REM
Function checkIsUser(user As String) As Boolean
On Error Goto err_line
Dim ndoc As NotesDocument
Dim uname As NotesName
checkIsUser = True
If Instr(user,"/") > 0 Then
Set uname = New NotesName(user)
Set ndoc = vwpsn.Getdocumentbykey(uname.Abbreviated,True)
Else
Set ndoc = vwpsnbylname.Getdocumentbykey(user,True)
End If
If ndoc Is Nothing Then
checkIsUser = False
End If
Exit Function
err_line:
Call showError("checkIsUser")
checkIsUser = True
End Function
修改后，保存程序然后进行测试
注意：如果在表单中未配置需要执行的邮件组的话，默认执行全部。
我们定义需要执行检查的邮件组，单击---新建
定义多个群组名称，然后以逗号分开。
然后单机保存并关闭
然后我们需要进行测试，然后在group01、group02、group03、group5中分别添加未知用户进行测试，最终结果，group01、group02、group03中的未知用户删除而group5的未知用户不做处理
Group02下定义
Group03
定义gourp5内的未知用户
接下来我们执行程序
执行后，log中没有group5的信息，
检查邮件组内的人员信息：
最后我们查看group5的信息
最后我们介绍一下，执行的代理时间问题，如果我们想希望在每周的七天中周一和周三执行或者其他时间段执行，通过代理的计划任务是无法实现的，只能通过代码实现，添加日期判断条件：
Dim wek As String wek = Weekday(Now) 'wek的值为1到7，分别表示星期天，星期一...星期六 If wek <> 2 And wek <> 5 Then '不是星期一、星期六，则退出 Exit Sub End If
添加后的所有代码为：
%REM
Agent 定时处理群组
%END REM
Option Public
Option Declare
Dim session As NotesSession
Dim agt As NotesAgent
Dim dbcur As NotesDatabase
Dim namedb As NotesDatabase
Dim vwpsn As NotesView
Dim vwpsnbylname As NotesView
Dim vwgroup As NotesView
Dim arrDealGp As Variant
Sub Initialize
On Error Goto err_line
Dim entries As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim docGp As NotesDocument
Dim blnInit As Boolean
Dim i As Integer
Dim intLen As Integer
Dim vntMembers As Variant
Dim ind As Integer
Dim strContent As String
Dim wek As String
wek = Weekday(Now)
'wek的值为1到7，分别表示星期天，星期一...星期六
If wek <> 2 And wek <> 5 Then
'不是星期一、星期六，则退出
Exit Sub
End If
MsgBox "*********定时处理群组**********Start"
'初始化
blnInit = fnInit()
'初始化完成
If blnInit Then
'遍历群组
Set entries = vwgroup.Allentries
intLen = entries.Count
For i=1 To intLen
Set entry = entries.Getnthentry(i)
If Not entry Is Nothing Then
If entry.Isvalid Then
If entry.Isdocument Then
Set docGp = entry.Document
If Not docGp Is Nothing Then
If fnIsDealGroup(docGp.listname(0)) Then
strContent = ""
vntMembers = docGp.Members
For ind=0 To UBound(vntMembers)
If vntMembers(ind) <> "" Then
'判断成员是否为有效用户
If Not checkIsUser(vntMembers(ind)) Then
'判断成员是否为有效群组
If Not checkIsGroup(vntMembers(ind)) Then
strContent = strContent + "," + vntMembers(ind)
vntMembers(ind) = ""
End If
End If
End If
Next
'成员有更新，则保存群组文档
If strContent <> "" Then
docGp.Members = FullTrim(ArrayUnique(vntMembers))
Call docGp.Computewithform(False , False)
If docGp.Save(False,False) Then
'记录操作日志
Call fnSetOptLog(docGp.listname(0),strContent)
End If
End If
End If
End If
End If
End If
End If
Next
End If
MsgBox "*********定时处理群组**********End"
Exit Sub
err_line:
Call showError("Initialize")
End Sub
%REM
Description: 判断群组是否需要处理
%END REM
Function fnIsDealGroup(gpname As String) As Boolean
On Error GoTo err_line
fnIsDealGroup = True
Select Case LCase(gpname)
Case "localdomainservers","otherdomainservers","localdomainadmins" :
fnIsDealGroup = False
End Select
If Not IsEmpty(arrDealGp) Then
If IsNull(ArrayGetIndex(arrDealGp, gpname)) Then
fnIsDealGroup = False
End If
End If
Exit Function
err_line:
Call showError("fnIsDealGroup")
MsgBox "判断群组【"+gpname+"】是否允许处理时出错，不处理"
fnIsDealGroup = False
End Function
Function fnInit() As Boolean
On Error GoTo err_line
Dim vwDealGpConf As NotesView
Dim docDealGpConf As NotesDocument
Dim strDealGp As String
Set session = New NotesSession
Set agt = session.Currentagent
Set dbcur = session.Currentdatabase
Set namedb = session.Getdatabase("","names.nsf",False)
If Not namedb Is Nothing Then
Set vwpsn = namedb.Getview("($VIMPeople)")
Set vwpsnbylname = namedb.Getview("($VIMPeopleByLastName)")
Set vwgroup = namedb.Getview("($VIMGroups)")
If (vwpsn Is Nothing Or vwpsnbylname Is Nothing Or vwgroup Is Nothing) Then
fnInit = False
Exit Function
End If
Set vwDealGpConf = dbcur.Getview("vwNeedDealGroup")
If Not vwDealGpConf Is Nothing Then
Set docDealGpConf = vwDealGpConf.Getfirstdocument()
If Not docDealGpConf Is Nothing Then
strDealGp = docDealGpConf.strGroup(0)
strDealGp = Replace(strDealGp,"，",",")
arrDealGp = Split(strDealGp,",")
End If
End If
Else
fnInit = False
Exit Function
End If
fnInit = True
Exit Function
err_line:
Call showError("fnInit")
fnInit = False
End Function
Sub showError(errmsg As String)
MsgBox agt.Name + " >> " + errmsg + " Error : " + Error + " at line : " & Erl
End Sub
%REM
Description: 记录操作日志
%END REM
Function fnSetOptLog(gpname As String,strContent As String)
On Error GoTo err_line
Dim doclog As NotesDocument
Dim vntContent As Variant
vntContent = Split(strContent,",")
vntContent = FullTrim(ArrayUnique(vntContent))
If vntContent(0) <> "" Then
Set doclog = dbcur.Createdocument()
doclog.form = "frmAutoDealGroupLog"
doclog.strDate = Format$(CStr(Now),"YYYY-MM-DD HH:MM:SS")
doclog.strType = "删除"
doclog.strGroupName = gpname
doclog.strContent = Join(vntContent,",")
doclog.strReason = "不是names中的有效用户或群组"
Call doclog.save(True,True)
End If
Exit Function
err_line:
Call showError("fnSetOptLog")
End Function
%REM
判断群组是否存在
%END REM
Function checkIsGroup(gpname As String) As Boolean
On Error GoTo err_line
Dim docGp As NotesDocument
checkIsGroup = True
Set docGp = vwgroup.Getdocumentbykey(gpname,True)
If docGp Is Nothing Then
checkIsGroup = False
End If
Exit Function
err_line:
Call showError("checkIsGroup")
checkIsGroup = True
End Function
%REM
判断用户是否存在
%END REM
Function checkIsUser(user As String) As Boolean
On Error Goto err_line
Dim ndoc As NotesDocument
Dim uname As NotesName
checkIsUser = True
If Instr(user,"/") > 0 Then
Set uname = New NotesName(user)
Set ndoc = vwpsn.Getdocumentbykey(uname.Abbreviated,True)
Else
Set ndoc = vwpsnbylname.Getdocumentbykey(user,True)
End If
If ndoc Is Nothing Then
checkIsUser = False
End If
Exit Function
err_line:
Call showError("checkIsUser")
checkIsUser = True
End Function
最后我们再说一下，全部功能介绍
如果我们不配置待处理的邮件群组的话，代码程序执行不处理全部的邮件群组，对于我们来说不灵活，所以来说不太方便，如果我们在待处理的群组下不添加指定的邮件组，那就处理全部群组，以此我们需要修改代码。删除以下代码同时添加代码：
fninit-----arrDealGp = Split(strDealGp,",")
然后在添加的此处添加以下代码：
if strDealGp <> "" then arrDealGp = split(strDealGp,",") end if
介绍结束：
注意：附件中的文件修改扩展名为7z可解压。