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 REM
Public 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=response
End 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 REM
Public 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 ForAll
End 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 REM
Public 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 REM
Public 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 REM
End Class

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

ExtDoc就像一把瑞士军刀，而且你还可以随时丰富它的功能。同样，对于其它Notes对象，你也可以制造你的瑞士军刀。