Domino9下通过代理程序进行群组维护

更新时间：2022-09-04 20:43:47

上篇文章咱们介绍了通过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>