当前位置: 代码迷 >> Lotus >> 29. 面向对象的LotusScript(5)之ExtDoc
  详细解决方案

29. 面向对象的LotusScript(5)之ExtDoc

热度:2812   发布时间:2013-02-26 00:00:00
29. 面向对象的LotusScript(五)之ExtDoc
NotesDocument是Lotus Notes的核心对象之一,在开发中会遇到很多与它有关的反复出现的功能需求,可以写成通用的函数,比如针对一个文档,创建回复、取得父文档等等。下面就是一些例子:
%REM	Description: Create a response for the given document.	Use the given form name. Return the unsaved response.%END REMPublic Function CreateResponse(doc As NotesDocument, form As String)As NotesDocument	Dim response As NotesDocument	Set response=doc.Parentdatabase.Createdocument()	response.Form=form	Call response.Makeresponse(doc)	Set CreateResponse=responseEnd Function%REM	Description: Description: Replace the given items of the document collection 	with the given document's items of the same name. 	@param: itemNames is an array or a string conainting names separated by '^'	other types provided, an error will occur%END REMPublic Function StampCollection(dc As NotesDocumentCollection, doc As NotesDocument, itemNames As Variant) 	Dim v	If Not IsArray(itemNames) Then		v=Split(itemNames, "^")	Else		v=itemNames	End If	ForAll itemName In v		Call dc.Stampall(itemName, doc.Getitemvalue(itemName))	End ForAllEnd Function%REM	Description: Replace the given items of the reponses of the given document with its own items of the same name. 	@param: itemNames is an array or a string conainting names separated by '^'	other types provided, an error will occur%END REMPublic function StampResponses(doc As NotesDocument, itemNames As Variant)	Dim dc As NotesDocumentCollection	Set dc=doc.Responses	Call StampCollection(dc, doc, itemNames)	'Call dc.StampAll(itemName,doc.GetItemValue(itemName))End Function
这样的函数创建多了,我们便可以发现进一步改进的可能。它们都与NotesDocument有关,按照面向对象语言的规范,应该将它们集中到一个对象里。这样,可以收到使用对象的诸多好处,比如可以省去参数中的NotesDocument,减少了函数名称冲突的可能性。本来根据面向对象的思想,可以考虑扩展NotesDocument成为一个新的具备更多功能的类。但是LotusScript中由产品本身提供的类是不能扩展的。继承不了,我们可以换一种方式。创建一个“包含”NotesDocument的类,在其构造函数中传入需要“增强”的NotesDocument,保存在内部变量中,然后为其增加任意需要的方法,从中引用该NotesDocument。在面向对象的架构里,要创建一个新类,利用已有的类,也不只有继承一径,还可以组合或包含。
%REM	Class ExtDoc	Description: Comments for Class%END REMPublic Class ExtDoc	Public mdoc As NotesDocument		%REM		Sub New		Description: Comments for Sub	%END REM	Sub New(doc As NotesDocument)		Set me.mdoc=doc	End Sub		%REM		Function ReplaceItemValue		Description: Replace the given item's value using the given "from" array to "to" array. 	%END REM	Public Function ReplaceItemValue(itemName As String, compareArray As Variant, replaceArray As Variant)		Dim v As Variant		v=me.mdoc.Getitemvalue(itemName)		Call me.mdoc.Replaceitemvalue(itemName, ArrayReplace(v, compareArray, replaceArray))	End Function		%REM		Function CopyAllTo		Description: copy the document and all its descendents to		another db.	%END REM	Public Function CopyAllTo(dest As NotesDatabase )		Call mdoc.Copytodatabase(dest)		Dim dc As NotesDocumentCollection		Dim rdoc As NotesDocument		Dim rext As ExtDoc		Set dc=mdoc.Responses				Set rdoc=dc.Getfirstdocument()		Do Until rdoc Is Nothing			Set rext=New ExtDoc(rdoc)			Call rext.CopyAllTo(dest)			Set rdoc=dc.Getnextdocument(rdoc)		Loop		Call mdoc.Copytodatabase(dest)	End Function		%REM		Function RemoveAll		Description: Remove the document and all its descendents	%END REM	Public Function RemoveAll(force As Boolean)		Dim dc As NotesDocumentCollection		Dim docR As NotesDocument, docTmp As NotesDocument		Dim ed As ExtDoc		Set dc=mdoc.Responses				Set docR=dc.Getfirstdocument()		Do Until docR Is Nothing						Set docTmp=dc.Getnextdocument(docR)			Set ed=New ExtDoc(docR)			Call ed.RemoveAll(force)			Set docR=docTmp		Loop		Call mdoc.Remove(force)	End Function		%REM		Function ComputeAndSave		Description: Comments for Function	%END REM	Public Function ComputeAndSave()		Call mdoc.Computewithform(False, False )		Call mdoc.save(True, False)	End Function		%REM		Function CopyItemsFrom		Description: Comments for Function	%END REM	Public Function CopyItemsFrom(source As NotesDocument, items As Variant)		If IsArray(items) Then			ForAll itemName In items				Call mdoc.Replaceitemvalue(itemName, source.Getitemvalue(itemName))			End ForAll		Else			Call mdoc.Replaceitemvalue(items, source.Getitemvalue(items))		End If	End Function		%REM		Function CreateResponse		Description: Comments for Function	%END REM	Public Function CreateResponseDoc(form As String ) As NotesDocument		Set me.CreateResponseDoc=CreateResponse(me.mdoc, form)	End Function		%REM		Function StampResponses		Description: Replace the given item of the reponses of the wrapped document with its own item of the same name. 	%END REM	Public Function StampResponseDocs(itemName As Variant)		Call StampResponses(me.mdoc, itemName)	End Function		%REM		Function GetParentDoc		Description: Comments for Function	%END REM	Public Function GetParentDoc() As NotesDocument		Dim docResult As NotesDocument		If me.mdoc.Isresponse Then			Set docResult=mdoc.Parentdatabase.Getdocumentbyunid(mdoc.Parentdocumentunid)		Else			Set docResult=Nothing 		End If		Set GetParentDoc=docResult	End Function		%REM		Function IsUnique		Description: Check if the wrapped document is unique in the given view.		A document is unique if for the given number -- keyNum -- of sorted columns, there's no other document		having the same values. That is, if a GetDocumentByKey is called with an array cotaining		keyNum of keys, no other document is returned.	%END REM	Public Function IsUnique(viewName As String, keyNum As Integer) As Boolean		Dim view As NotesView		Set view=Me.mdoc.ParentDatabase.GetView(viewName)		Dim doc As NotesDocument		Dim keys As New NArray(-1)		ForAll c In view.Columns			If c.IsSorted Then				keys.Add(mdoc.Getitemvalue(c.Itemname)(0))				keyNum=keyNum-1				If keyNum=0 Then					Exit ForAll 				End If			End If		End ForAll				Set doc=view.Getdocumentbykey(keys.Container, True)		If doc Is Nothing Then			IsUnique=True		Else			If doc.Universalid=mdoc.Universalid Then				IsUnique=True			Else				IsUnique=False 			End If		End If			End Function		%REM		Function IsValueUnique		Description: Check if the wrapped document is unique in the given column of the given view.	%END REM	Public Function IsValueUnique(value As Variant,viewName As String,columnNum As Integer) As Boolean		Dim s As New NotesSession		Dim view As NotesView		Dim doc As NotesDocument			Set view=s.CurrentDatabase.GetView(viewName)		Set doc=view.GetFirstDocument		Do Until doc Is Nothing			If doc.ColumnValues(columnNum)=value And doc.Universalid><mdoc.Universalid Then 				Me.IsValueUnique=False				Exit Function			End If			Set doc=view.GetNextDocument(doc)		Loop		Me.IsValueUnique=True			End Function		%REM		Description: Check if the wrapped document is unique in the given field of the given document collection.	%END REM	Public Function IsValueUniqueInDC(Field As String, dc As NotesDocumentCollection) As Boolean		Dim doc As NotesDocument		Set doc=dc.Getfirstdocument()		Do Until doc Is Nothing			'cannot compare the item value array, compare the first value instead			If doc.GetItemValue(Field)(0)=mdoc.Getitemvalue(field)(0) And doc.Universalid><mdoc.Universalid Then 				Me.IsValueUniqueInDC=False				Exit Function			End If			Set doc=dc.GetNextDocument(doc)		Loop		Me.IsValueUniqueInDC=True 	End Function		%REM		Function GetDuplicatedDoc		Description: Return the first found document in the given view, which has the same value		with the given document in the given column.	%END REM	Public Function GetDuplicatedDoc(value As Variant, viewName As String, columnNum As Integer) As NotesDocument 		Dim s As New NotesSession		Dim view As NotesView		Dim doc As NotesDocument			Set view=s.CurrentDatabase.GetView(viewName)		Set doc=view.GetFirstDocument		Do Until doc Is Nothing			If doc.ColumnValues(columnNum)=value And doc.Universalid><mdoc.Universalid Then 				Set Me.GetDuplicatedDoc=doc				Exit Function			End If			Set doc=view.GetNextDocument(doc)		Loop			End Function	%REM		Obsolete Function ReplicateTo		Description: Make sure the copied document has the same universal id.		Direct copied documents will keep the response relations in 8.5. Modifying a document's universal id and saving it will generate another document with still a different OF part of the id.	Public Function ReplicateTo(dest As NotesDatabase )		Dim doc As NotesDocument		Set doc= mdoc.Copytodatabase(dest)		doc.Universalid=mdoc.Universalid		Call doc.Save(True, False)		Set me.ReplicateTo=doc	End Function	%END REM		%REM		Obsolete Function ReplicateAllTo		Description: Comments for Function	Public Function ReplicateAllTo(dest As NotesDatabase)		Call me.ReplicateTo(dest)		Dim dc As NotesDocumentCollection		Dim rdoc As NotesDocument		Dim rext As ExtDoc		Set dc=mdoc.Responses		Set rdoc=dc.Getfirstdocument()		Do Until rdoc Is Nothing			Set rext=New ExtDoc(rdoc)			Call rext.ReplicateAllTo(dest)			Set rdoc=dc.Getnextdocument(rdoc)		Loop	End Function	%END REMEnd Class

上面的CreateResponseDoc和StampResponseDocs方法分别调用了CreateResponse和StampResponses函数。当然也可以将这些函数本身包含进类中。大部分方法的作用都一看即知。稍微复杂一些的做了详细的注释,这里再略加说明。GetDuplicatedDoc,IsUnique, IsValueUnique,这些方法提到的Unique, Duplicated的含义都是针对某个视图的某个或某些列;IsUnique可以比较视图的前若干个排序列;IsValueUniqueInDC针对的是文档集合和某个字段。StampResponseDocs使用父文档的域更改子文档,参数中的域名可以是数组或由特殊字符^分隔开的字符串。CopyAllTo和RemoveAll里的All指的是连带所有子文档。ReplicateTo和ReplicateAllTo会修改目的文档的UniversalID,但是在8.5中似乎Notes会自动保持答复关系,故不再需要。

ExtDoc就像一把瑞士军刀,而且你还可以随时丰富它的功能。同样,对于其它Notes对象,你也可以制造你的瑞士军刀。
本站暂不开放注册!
内测阶段只得通过邀请码进行注册!