Domino XML Language（DXL）簡介

1 Sub Click(Source As Button)
 2  Dim session As New NotesSession    
 3  Dim stream As NotesStream
 4  Dim importer As NotesDXLImporter
 5  Dim curdirname As String  
 6  
 7  REM Set current database  
 8  Set db = session.CurrentDatabase  
 9  curdirname = Curdir()  
10  
11  Dim workspace As New NotesUIWorkspace
12  Dim uidoc As NotesUIDocument
13  Dim doc As NotesDocument
14  Dim db As NotesDatabase
15  
16  REM Get the DXL file from current document
17  Set uidoc = workspace.CurrentDocument
18  Set doc= uidoc.Document
19  Set rtitem = doc.GetFirstItem("Body")   
20  
21  Forall eo In rtitem.EmbeddedObjects         
22    Call eo.ExtractFile( curdirname + eo.source )          
23  End Forall        
24  
25  REM Open DXL file
26  Set stream = session.CreateStream
27  If Not stream.Open(curdirname + "AddMyAgent.dxl") Then
28    Msgbox "Cannot open AddMyAgent.dxl", , "Error"
29    Exit Sub
30  End If
31  If stream.Bytes = 0 Then
32    Msgbox "File did not exist or was empty", , "Error"
33    Exit Sub
34  End If  
35  
36  REM Import DXL into new database
37  Set importer = session.CreateDXLImporter
38  importer.ReplaceDBProperties = True
39  importer.ReplicaRequiredForReplaceOrUpdate = False
40  importer.ACLImportOption = DXLIMPORTOPTION_REPLACE_ELSE_IGNORE
41  importer.DesignImportOption = DXLIMPORTOPTION_CREATE
42  Call importer.Import(stream, db)
43  
44  REM Sign agents with current user
45  Call db.sign(DBSIGN_DOC_AGENT)
46  Call stream.Close
47 End Sub

  
  
    
      
        20080402T061930,91-07
      
      
        20080901T151520,50-07
      
      
        20080901T151520,49-07
      
      
        20080901T151520,49-07
      
      
        20080402T061930,91-07
      
    
    
      CN=Administrator/O=ibm
    
    
      20080901T151520,48-07
    
    
    
    
      
      
    
    
      

    
    
      
        20080901T151520,48-07
      
    
    
      20080328T172442,06+08
    
  

  1 (Declarations)
  2 Dim isPostOpenEvent As Boolean
  3 Dim isPostOpenCode As Boolean
  4 Dim isCode As Boolean
  5
  6 Sub Initialize
  7  
  8  Dim session As New NotesSession
  9  Dim db As NotesDatabase
 10  Dim streamIn As NotesStream 
 11  Dim streamOut As NotesStream
 12  Dim dxlExporter As NotesDXLExporter 
 13  Dim dxlImporter As NotesDXLImporter
 14  Dim saxParser As NotesSAXParser 
 15  
 16  REM get current database
 17  Set db = session.CurrentDatabase
 18  
 19  REM Create DXL exporter
 20  Set dxlExporter = session.CreateDXLExporter
 21  
 22  REM Create the stream that will store the DXL
 23  Set streamIn = session.CreateStream 
 24  Call streamIn.Truncate
 25  Set streamOut = session.CreateStream
 26  Call streamOut.Truncate
 27  
 28  REM Create note collection
 29  Dim nc As NotesNoteCollection
 30  Set nc = db.CreateNoteCollection(False)
 31  nc.SelectDatabaseScript. = True  
 32  Call nc.BuildCollection
 33  
 34  REM Export note collection as DXL  
 35  Set dxlExporter = session.CreateDXLExporter(nc)
 36  dxlExporter.OutputDOCTYPE = True
 37  
 38  filename$ = "c:\" & Left(db.FileName, Len(db.FileName) - 3) & "xml"
 39  If Not streamIn.Open(filename$) Then
 40    Messagebox "Cannot open " & filename$,, "Error"
 41    Exit Sub
 42  End If
 43  streamIn.Truncate
 44  
 45  REM Create the SAX Parser, the results of the parse will be 
       pushed into stream (streamIn)
 46  Set saxParser = session.CreateSAXParser(dxlExporter, streamIn)
 47  On Event SAX_Characters From saxParser Call SAXCharacters
 48  On Event SAX_EndElement From saxParser Call SAXEndElement
 49  On Event SAX_StartDocument From saxParser Call SAXStartDocument
 50  On Event SAX_StartElement From saxParser Call SAXStartElement
 51  
 52  REM Initiate parsing, by doing this the SAX events are called
 53  REM It is in there that the DXL is rewritten and the 
       PostOpen() method was modified.
 54  Call dxlExporter.Process()  
 55  streamIn.Close  
 56  
 57  REM Open xml file named after current database 
 58  If Not streamOut.Open(filename$) Then
 59    Messagebox "Cannot open " & filename$,, "Error"
 60    Exit Sub
 61  End If
 62  If streamOut.Bytes = 0 Then
 63    Messagebox "File did not exist or was empty",, filename$
 64    Exit Sub
 65  End If
 66  
 67  REM Import DXL into new database
 68  Dim importer As NotesDXLImporter
 69  
 70  Set importer = session.CreateDXLImporter(streamOut, db)
 71  importer.ReplaceDBProperties = ture 
 72  importer.DesignImportOption =DXLIMPORTOPTION_REPLACE_ELSE_CREATE 
 73  Call importer.Process
 74  
 75 End Sub
 76
 77 Sub SAXStartDocument (Source As Notessaxparser)
 78  REM Write DXL header
 79  Source.Output("<?xml version='1.0'?>" & Chr(10))  
 80 End Sub
 81
 82 Sub SAXStartElement (Source As NotesSAXParser,_
 83 Byval strElementName As String, Attributes As NotesSaxAttributeList)  
 84  
 85  Dim i As Integer  
 86  REM Open Element
 87  Source.Output("<" & strElementName) 
 88  If Attributes.Length > 0 Then
 89    For i = 1 To Attributes.Length
 90      REM Get the name and value of the attribute
 91      strAttrName = Attributes.GetName(i)
 92      strAttrValue = Attributes.GetValue(i)     
 93      REM Check whether current element is code
 94      If strElementName = "code" Then
 95        bCode = True
 96        If  strAttrName = "event" Then          
 97          If strAttrValue = "postopen" Then
 98            REM found postopen event
 99            bPostOpenEvent = True           
100          End If
101        End If                  
102      End If                
103               REM Write the attribute
104      Source.Output(| | & strAttrName & |="| & strAttrValue & |"|) 
105    Next        
106  End If
107  
108  If strElementName = "lotusscript"  And bPostOpenEvent  Then
109    REM found postopen code
110    bPostOpenCode = True
111  End If
112  
113     REM Close the element tag here
114  Source.Output(">")  
115 End Sub
116
117 Sub SAXCharacters (Source As Notessaxparser, Byval Characters As String, _
118 Count As Long)
119  
120  If  isCode Then
121    Source.Output("<![CDATA[")    
122  End If  
123  
124  If (isPostOpenCode)  Then
125    REM insert code into this place
126    Dim header As String
127    Dim pos As Integer
128    Dim newchar As String
129    
130    header = "Notesuidatabase"
131    pos = Instr(Characters,header)
132    
133    If (pos = 1) Then
134      REM at the begining 
135    Else    
136      REM found the patten, and insert the code
137      newchar = Left(Characters, pos+16)        
138      newchar = newchar + Chr(13) + "Msgbox" + Chr(34) + "Welcome"+ Chr(34) + Chr(13)
139      newchar = newchar + Mid(Characters, pos+ 17)      
140    End If    
141    Source.Output(newchar)
142  Else 
143    Source.Output(Characters) 
144  End If
145  
146  If  bCode Then
147    Source.Output("]]>")    
148 End If
149  
150 End Sub
151
152 Sub SAXEndElement (Source As NotesSAXParser, Byval ElementName As String)
153  
154  REM Terminate the element
155  Source.Output("</" & ElementName & ">" & Chr(10))
156  
157  If ElementName = "lotusscript"  And isPostOpenEvent  Then
158    isPostOpenCode = False
159    isPostOpenEvent = False
160  Elseif elementName = "code" Then
161    isCode = False
162  End If
163  
164 End Sub