domino中动态修改表单设计

今天闲来无事，翻看domino自带的帮助，突然看到notesstream这个类的帮助说明，突然发现其功能之强大，令人为之一振。也可能是因为以前根本就没注意过这个类，在所做的项目中也没见到有人用过这个类。
再翻翻与之相关的几个类，突然看到一个解释，翻译过来也很简单，其实domino中的每个设计都是由xml组成，同时在R6中已经带了对其修改的相关类。这样，以前的某个想法，动态修改数据库设计，涌入我的脑海中。
就尝试了做了下关于数据库表单名称的修改，思路很简单：
1． 获取修改的数据库
2． 遍历表单获取到需要修改的表单
3． 利用CreateStream之类方法将表单导成dxl格式
4． 打开该dxl文件，利用DOM修改其中你需要修改的设计。
5． 修改完毕后再将该dxl文件回写到数据库中去。

至此，修改数据库设计的功能达到。

部分代理设计如下：
Sub Initialize
On Error Goto errhandle
Dim session As notessession
Dim db1 As notesdatabase
Dim db2 As notesdatabase
Dim nc As notesnotecollection
Dim nc2 As notesnotecollection
Dim stream As notesstream
Dim exporter As NotesDXLExporter 
Dim importer As notesdxlimporter
Dim importer0 As notesdxlimporter
Dim form As NotesForm 
Dim nid As String 

Dim file1 As String 
Dim file2 As String 
Dim file3 As String
Dim outputFile As String

Dim timeStr As String 

Dim inputStream As NotesStream, outputStream As NotesStream
Dim domParser As NotesDOMParser
Dim docNode As NotesDOMDocumentNode
Dim docRootNode As NotesDOMNode

file1 = ""
file2 = ""
file3 = ""
flag = False
timeStr = Replace(Replace(Replace(Cstr(Now),"-",""),":","")," ","")

Set session = New notessession
Set db1 = session.currentdatabase
  '先判断当前服务器是否有ext20.nsf
Set db2 = New NotesDatabase(db1.Server, "JSMCCOA/ext20.nsf")
  '如果没有ext20.nsf
If Not db2.IsOpen Then
Set db2 = db1.CreateFromTemplate(db1.Server,"JSMCCOA/ext20.nsf", True)
Else
Set form = db2.GetForm("test")
   '如果存在测试表单，首先备份测试表单''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not form Is Nothing Then
Set nc = db2.createnotecollection(False)
Call nc.buildcollection
Set nc2 = db2.createnotecollection(False)
nc2.SelectForms = True
Call nc2.BuildCollection 
nid = nc2.GetFirstNoteId 
    '查找测试表单
Forall f In db2.Forms
If Not f.IsSubForm Then
If f.name = "test" Then
nc.Add(nid)
Exit Forall
End If
nid = nc2.GetNextNoteId(nid)
End If
End Forall
    '将表单导成dxl文件，并存在临时文件夹中
Set stream = session.CreateStream
file2 = "D:\templogin_back_" & timeStr & "1.dxl"
'pathname = "c:\StreamFiles\"
Call stream.Open(file2)
Set exporter=session.createDXLexporter(nc, stream)
Call exporter.process
Call stream.close
    '删除原有测试表单
Call form.Remove

'读取刚才的dxl文件（xml格式的文件），修改测试表单名称
file3 = "c:templogin_back_" & timeStr & "2.dxl"
Set session = New NotesSession
Set outputStream =session.CreateStream
outputStream.Open(file3)
Set inputStream = session.CreateStream
inputStream.Open (file2)
If inputStream.Bytes > 0 Then
Set domParser=session.CreateDOMParser(inputStream)
Call domParser.Process
Set docNode = domParser.Document
Set docRootNode = docNode.DocumentElement
If Not docRootNode.IsNull Then
      '修改文件中form节点的下属节点name的nodevalue的值
Call ChangeNode(docRootNode,timeStr)
Call domParser.setoutput(outputStream)
Call domParser.Serialize 
End If
End If
    '导入备份测试表单页
Set importer0=session.createdxlimporter(outputStream, db2)
importer0.designimportoption = 2
Call importer0.process
Set importer0 = Nothing
Call outputStream.Truncate 
Call inputStream.Truncate 
Call outputStream.Close 
Call inputStream.Close 


End If
%REM
'导入登录页'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set nc = db1.createnotecollection(False)
Call nc.buildcollection
Set nc2 = db1.createnotecollection(False)
nc2.SelectForms = True
Call nc2.BuildCollection 
nid = nc2.GetFirstNoteId
   '取得当前库的登录页表单
Forall f In db1.Forms
If Not f.IsSubForm Then
If f.name = "test" Then
nc.Add(nid)
Exit Forall
End If
nid = nc2.GetNextNoteId(nid)
End If
End Forall
   '导成dxl文件，并存在临时文件夹中
Set stream = session.CreateStream
file1 = "c:templogin_" & timeStr & ".dxl"
Call stream.Open(file1)
   '把dxl导入到ext20库中
Set exporter=session.createDXLexporter(nc, stream)
Set importer=session.createdxlimporter(stream, db2)
importer.designimportoption = 2 
Call exporter.process
Call importer.process
Call stream.Truncate 
Call stream.close
%END REM

End If

Exit Sub
errhandle:
Msgbox Cstr(Erl) & "  " & Error
End Sub



函数：
Sub ChangeNode(childNode2 As NotesDOMNode, str1 As String )
On Error Goto errhandle
Dim docNameMap As NotesDOMNamedNodeMap 
Dim childNode3 As NotesDOMNode 
Dim tempNode As NotesDOMNode 
Dim i As Integer

While Not childNode2.IsNull
If childNode2.NodeType <> 3 Then
If childNode2.HasChildNodes Then
Set childNode3 = childNode2.FirstChild 
While Not childNode3.IsNull
Call ChangeNode(childNode3,str1)
If Not childNode3.IsNull Then
Set childNode3 = childNode3.NextSibling 
End If
Wend
End If
End If 
Set docNameMap = childNode2.Attributes 
For i =1 To docNameMap.NumberOfEntries 
Set tempNode = docNameMap.GetItem(i)
If tempNode.NodeValue = "test" Then
tempNode.NodeValue="test_" & str1
Exit Sub
End If
Next
Set childNode2 = childNode2.NextSibling 
Wend
Exit Sub
errhandle:
Msgbox "ChangeNode:" & Cstr(Erl) & "," & Error$
End Sub