1 Sub Click(Source As Button)2  Dim session As New NotesSession    3  Dim stream As NotesStream4  Dim importer As NotesDXLImporter5  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

<?xml version="1.0"?>
20080402T061930,91-0720080901T151520,50-0720080901T151520,49-0720080901T151520,49-0720080402T061930,91-07CN=Administrator/O=ibm20080901T151520,48-0720080901T151520,48-0720080328T172442,06+08

<?xml version="1.0"?>

  1 (Declarations)2 Dim isPostOpenEvent As Boolean3 Dim isPostOpenCode As Boolean4 Dim isCode As Boolean56 Sub Initialize7  8  Dim session As New NotesSession9  Dim db As NotesDatabase10  Dim streamIn As NotesStream 11  Dim streamOut As NotesStream12  Dim dxlExporter As NotesDXLExporter 13  Dim dxlImporter As NotesDXLImporter14  Dim saxParser As NotesSAXParser 15  16  REM get current database17  Set db = session.CurrentDatabase18  19  REM Create DXL exporter20  Set dxlExporter = session.CreateDXLExporter21  22  REM Create the stream that will store the DXL23  Set streamIn = session.CreateStream 24  Call streamIn.Truncate25  Set streamOut = session.CreateStream26  Call streamOut.Truncate27  28  REM Create note collection29  Dim nc As NotesNoteCollection30  Set nc = db.CreateNoteCollection(False)31  nc.SelectDatabaseScript. = True  32  Call nc.BuildCollection33  34  REM Export note collection as DXL  35  Set dxlExporter = session.CreateDXLExporter(nc)36  dxlExporter.OutputDOCTYPE = True37  38  filename$ = "c:\" & Left(db.FileName, Len(db.FileName) - 3) & "xml"39  If Not streamIn.Open(filename$) Then40    Messagebox "Cannot open " & filename$,, "Error"41    Exit Sub42  End If43  streamIn.Truncate44  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 SAXCharacters48  On Event SAX_EndElement From saxParser Call SAXEndElement49  On Event SAX_StartDocument From saxParser Call SAXStartDocument50  On Event SAX_StartElement From saxParser Call SAXStartElement51  52  REM Initiate parsing, by doing this the SAX events are called53  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$) Then59    Messagebox "Cannot open " & filename$,, "Error"60    Exit Sub61  End If62  If streamOut.Bytes = 0 Then63    Messagebox "File did not exist or was empty",, filename$64    Exit Sub65  End If66  67  REM Import DXL into new database68  Dim importer As NotesDXLImporter69  70  Set importer = session.CreateDXLImporter(streamOut, db)71  importer.ReplaceDBProperties = ture 72  importer.DesignImportOption =DXLIMPORTOPTION_REPLACE_ELSE_CREATE 73  Call importer.Process74  75 End Sub7677 Sub SAXStartDocument (Source As Notessaxparser)78  REM Write DXL header79  Source.Output("<?xml version='1.0'?>" & Chr(10))  80 End Sub8182 Sub SAXStartElement (Source As NotesSAXParser,_83 Byval strElementName As String, Attributes As NotesSaxAttributeList)  84  85  Dim i As Integer  86  REM Open Element87  Source.Output("<" & strElementName) 88  If Attributes.Length > 0 Then89    For i = 1 To Attributes.Length90      REM Get the name and value of the attribute91      strAttrName = Attributes.GetName(i)92      strAttrValue = Attributes.GetValue(i)     93      REM Check whether current element is code94      If strElementName = "code" Then95        bCode = True96        If  strAttrName = "event" Then          97          If strAttrValue = "postopen" Then98            REM found postopen event99            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