Domino9下通过代理程序进行群组维护
上篇文章咱们介绍了通过java代理程序来管理邮件组成员,今天主要介绍通过domino默认代码vb进行编写的代理程序进行群组维护。主要实现功能为:通过web方式管理组织内的邮件组,然后添加、删除组内成员,如果添加的成员不在组织,保存将提示警告信息及继续完成数据提交。具体见下:
我们为了保证服务的稳定性,该操作还是新建数据库来部署,这样比较安全,就修改错误,也不会对现实环境造成影响,建议大家也这么做。
如果需要将服务应用其他服务器上只需要,更改相应的acl权限及数据库签名即可。
新建数据库:Groupqueryconfig.nsf
通过desinger打开该数据库,进行编辑
首先是创建代理程序:
为了更好的规划,我们创建三个代理程序:分别做为:保存群组成员、参训names群组_按群组名、获取群组成员
首先是保存群组成员代理设置:
代理设置:基本:名称“:保存群组成员,别名agtSaveGroupMembers
%REM
Agent 保存群组成员
%END REM
OptionPublic
OptionDeclare
Sub Initialize
OnErrorGoTo err_line
Dim session AsNew NotesSession
Dim namedb As NotesDatabase
Dim note As NotesDocument
Dim doc As NotesDocument
Dim ritem As NotesRichTextItem
Dim qstring AsString
Dim uid AsString
Dim members AsString
Dim mVar AsVariant
Dim newVar AsVariant
Dim errpsn AsString
Set note = session.Documentcontext
qstring = DF_TransUnicode(note.Request_content(0))
uid = cgi(qstring,"uid")
members = cgi(qstring,"members")
newVar = Split("")
If uid <> ""Then
Set namedb = session.Getdatabase("","names.nsf",False)
IfNot namedb IsNothingThen
Set doc = namedb.Getdocumentbyunid(uid)
IfNot doc IsNothingThen
If members <> ""Then
mVar = Split(members,";")
ForAll member In mVar
If member <> ""Then
If checkUser(namedb,CStr(member)) Then
newVar = ArrayAppend(newVar,member)
Else
If errpsn <> ""Then
errpsn = errpsn + ";" + CStr(member)
Else
errpsn = CStr(member)
EndIf
EndIf
EndIf
EndForAll
EndIf
Set ritem = New NotesRichTextItem(doc,"Members")
ritem.Values = ArrayUnique(FullTrim(newVar))
Call doc.Computewithform(False,False)
Call doc.save(True,True)
EndIf
EndIf
EndIf
If errpsn <> ""Then
Print|<info>以下人员保存时被忽略(因为该人员在domino目录下不存在):|+errpsn+|</info>|
Else
Print|<info>保存成功</info>|
EndIf
ExitSub
err_line:
MsgBox session.Currentagent.name+" error : "+Error+" at line : "+CStr(Erl)
EndSub
Function DF_TransUnicode(df_unstr AsString ) AsString
'编写人:
'编写时间:
'功能说明:把Unicode字符串转换成decode格式
Dim df_unstrs AsVariant
Dim df_unstr1 AsVariant
Dim df_uni AsInteger
df_unstrs=Split(df_unstr,"%u")
df_unstr1=df_unstrs(0)
For df_uni=1ToUBound(df_unstrs)
df_unstr1=df_unstr1 & CStr(UChr(Val("&H"+Mid(df_unstrs(df_uni),1,4)))) & Mid(df_unstrs(df_uni),5,Len(df_unstrs(df_uni)))
Next
DF_TransUnicode=df_unstr1
EndFunction
Function checkUser(ndb As NotesDatabase,user AsString) AsBoolean
OnErrorGoTo err_line
checkUser = True
Dim ndoc As NotesDocument
Dim nview As NotesView
Dim uname As NotesName
Dim sname AsString
IfInStr(user,"/") > 0Then
Set nview = ndb.Getview("($VIMPeople)")
Set uname = New NotesName(user)
sname = uname.Abbreviated
Else
Set nview = ndb.Getview("($VIMPeopleByLastName)")
sname = user
EndIf
Set ndoc = nview.Getdocumentbykey(sname,True)
If ndoc IsNothingThen
checkUser = False
EndIf
ExitFunction
err_line:
MsgBox"保存群组成员代理的checkUser方法出错:"+Error+" at line : "+CStr(Erl)
checkUser = True
EndFunction
PublicFunction cgi(ByVal querystring AsString,ByVal cginame AsString)AsString
'获得CGI变量的函数
Dim startpos,endpos,skiplen AsInteger
querystring=querystring+"&"+cginame+"="+"&"
cginame=UCase("&"+cginame+"=")
skiplen=Len(cginame)
startpos=InStr(UCase(querystring),cginame)+skiplen
endpos=InStr(startpos,querystring,"&")
cgi=Mid(querystring,startpos,endpos-startpos)
EndFunction
2.创建查询Names群组_按群组名
代码:
%REM
Agent 查询Names群组_按群组名
%END REM
OptionPublic
OptionDeclare
Sub Initialize
OnErrorGoTo err_line
Dim session AsNew NotesSession
Dim namedb As NotesDatabase
Dim note As NotesDocument
Dim rsdc As NotesDocumentCollection
Dim rsdoc As NotesDocument
Dim qstring AsString
Dim gpname AsString
Dim formula AsString
Dim shtml AsString
Set note = session.Documentcontext
qstring = note.Query_String_Decoded(0)
gpname = cgi(qstring,"gpname")
If gpname <> ""Then
'formula = |Form = "Group" & @Contains(ListName;"|+gpname+|")| (注释)
shtml = shtml + |<data id="|+rsdoc.Universalid+|"><![CDATA[ |+rsdoc.ListName(0)+|]]></data>|
Set namedb = session.Getdatabase("","names.nsf",False)
IfNot namedb IsNothingThen
Set rsdc = namedb.Search(formula, Nothing, 0)
If rsdc.Count > 0Then
Set rsdoc = rsdc.Getfirstdocument()
WhileNot rsdoc IsNothing
shtml = shtml + |<data id="|+rsdoc.Universalid+|">|+rsdoc.ListName(0)+|</data>|
Set rsdoc = rsdc.Getnextdocument(rsdoc)
Wend
EndIf
EndIf
EndIf
If shtml = ""Then
shtml = |<nulldata>没有找到匹配的群组!</nulldata>|
EndIf
Print|Content-Type:text/xml;charset=UTF-8|
Print|<rsdata>|
Print shtml
Print|</rsdata>|
ExitSub
err_line:
MsgBox session.Currentagent.name+" error : "+Error+" at line : "+CStr(Erl)
EndSub
PublicFunction cgi(ByVal querystring AsString,ByVal cginame AsString)AsString
'获得CGI变量的函数
Dim startpos,endpos,skiplen AsInteger
querystring=querystring+"&"+cginame+"="+"&"
cginame=UCase("&"+cginame+"=")
skiplen=Len(cginame)
startpos=InStr(UCase(querystring),cginame)+skiplen
endpos=InStr(startpos,querystring,"&")
cgi=Mid(querystring,startpos,endpos-startpos)
EndFunction
3.创建获取群组成员代理
代码:
%REM
Agent 获取群组成员
%END REM
OptionPublic
OptionDeclare
Sub Initialize
Dim session AsNew NotesSession
Dim ndb As NotesDatabase
Dim doc As NotesDocument
Dim note As NotesDocument
Dim ritem As NotesRichTextItem
Dim uid AsString
OnErrorGoTo err_line
Set note = session.Documentcontext
uid = note.uid(0)
If uid <> ""Then
Set ndb = session.Getdatabase("","names.nsf",False)
IfNot ndb IsNothingThen
Set doc = ndb.Getdocumentbyunid(uid)
IfNot doc IsNothingThen
note.strGroupName = doc.ListName(0)
Set ritem = New NotesRichTextItem(note,"rtfTmpGpMembers")
Call ritem.Appendtext(Join(ArrayUnique(doc.Getitemvalue("Members")),";"))
EndIf
EndIf
EndIf
ExitSub
err_line:
MsgBox session.Currentagent.name+" error : "+Error+" at line : "+CStr(Erl)
EndSub
所需要的代理程创建完成:
代理创建完成接下来就需要是创建表单:我们创建两个表单,一个用户群组查询维护、一个群组成员维护。
表单创建完成后,需要定义需要的域信息:
SaveOptions和Dbpath
定义表单内容:
首先定义SaveOptions 域值
接下来定义Dapath域值
<div style="display:none">
SaveOptions 和Dbpath
</div>
<style type="text/css">
#tblQueryData{
border:0px solid #c0c0c0;
border-collapse:collapse;
font-size:13px;
}
#tblQueryData td{
border:1px solid #c0c0c0;
padding-left:5px;
height:25px;
}
a {
text-decoration:none;
color:blue;
}
</style>
<script type="text/javascript" src="<计算的值>/GpQueryConfigJS?OpenJavascriptLibrary"></script>
<table ;100%" height="100%" border="0" cellspacing="0" cellpadding="0" style="border:0px solid #000;margin-top:50px;">
<tr>
<td height="1%" align="center">
<div>群组查询维护</div>
</td>
</tr>
<tr>
<td height="99%" valign="top">
<table ;100%" border="0" cellspacing="0" cellpadding="0" style="border:0px solid #000;margin-top:20px;">
<tr>
<td height="25" align="center">
群组名:<span style="margin-left:10px;"><input type="button" id="search" value="开始查询" id="view" style=";margin-right:0px;"></span>
</td>
</tr>
</table>
<span id="DivQueryResult">
<table id="tblQueryData" '100%' align='center' border='0' cellspacing='0' cellpadding='0'>
<tr>
<td ;80%" style="font-size:14px;">群组名</td>
<td ;20%" style="font-size:14px;">操作</td>
</tr>
<tbody id="tbdQueryData">
<tr>
<td colspan="2">待查询</td>
</tr>
</tbody>
</table>
</span>
</td>
</tr>
</table>
表单信息定义完成”
保存后,基本上已经完成了,接下来就是测试:
首先我们确认环境内的测试组及结构:
我们分别有group-01,group-02,group-03,group-4,group-05,group-11,group-21
然后在组内添加成员:
访问测试:
接下来我们输入组内的关键字进行查询:
我们可以通过操作栏下的编辑可对组内的用户进行查看及修改(添加、删除)
我们编辑group-01的组内查看到,有user01、user02,跟我们在目录下看见的是一样的。
接下来我们就是添加用户和删除用户;
为了保证不添加非法用户到该组织内,我们程序内做判断,如果添加的用户不在domino目录下保存会提示某些用户不在domino目录下,被忽略跳过继续保存。
首先我们是查看组织内的有效用户
因为user100、user101、user102、user103、user104、user105都不在domino目录下:所以添加后在保存会被忽略不会添加到该组内,而user04、user05是真实存在的会被添加到该组织内部。不存在的会忽略,继续保存有效用户
提示警告信息:user100……user105的用户不存在被忽略
接下来我们查看修改后的结果:
User04、user05已添加成功,但是user100…..user105没有添加成功
保证信息的有效性,我们在服务器控制台查看
数据迁移:如果在试验环境下创建的环境,迁移到真实环境内,只需要将该数据库到应用服务器的domino\data目录下即可。然后给该数据库签名即可。
同时为该数据库签名
建议通过服务器的标识进行签名:
最后将jquery定义页面拷贝到data\domino\html目录下:
注意:附件代码格式为7z格式,下载后将扩展名更改为.7z格式解压即可。
转载于:https://blog.51cto.com/gaowenlong/1402215