29. 面向对象的LotusScript（五）之ExtDoc

旧城等待， 2022-04-10 09:49 167阅读 0赞

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对象，你也可以制造你的瑞士军刀。