Hier einmal ein Modell, das das Einfügen über ein FindAndReplace im DXLExport in einem RichTextFeld durchführt. Danach wird das modifizierte XML wieder in das ausgewählte Dokument importiert. Es werden keine IO-Operationen im Filesystem ausgeführt.
Die Textmarke lautet #RT:RTTWO. Der Screenshot ist als Konstante im Code der Schaltfläche ExportModifyImport hinterlegt.
Const REPLACE_WITH = | <picture height='71px' width='108px'><notesbitmap>
lQAmAAAAAAAAAAAAAAABAAAAAAAAAGwARwAIAAEACAACAE0ABwCWAFUIAAAAAAAAAAAAADIAQwgD
DQwLQA0AAQADDQwLQA0AAQADDQwLQA0AAQADDQwLQA0AAQADDQwLQA0AAQADDQwLQA0AAQADDQwL
yABADAEBAwMNDAvIAAEDQAwCAw0MC8gAAgMEQAsDxwEDDQwLyAACAwRACwPHAQMNDAvIAAIDBMoB
ww5ACgPCAQMNDAvIAAIDBMgBwg4BFcIAAg4VzgEEGQoXBcUBBBASChPLAQgQEhEPEBIRD0AEA8IB
Aw0MC8gAAgMExgHCDgQVOQAhwgACDhXNAQEZwgoBHMUBBAYfChPLAQgQEhEPEBIRD0AEA8IBAw0M
C8gAAgMExQECDhXCAMIhAiAhwgACDhXMAQQZJTAmxQEEIjsfE88BBBASEQ9ABAPCAQMNDAvIAAID
BMUBAg4AwiHDIAIdIcIAAg4VywEFGRdEFwXDAQUQEjIUE88BBBASEQ9ABAPCAQMNDAvIAAIDBMUB
Aj0awyDCFcIdBSEASg4VygEFGRcsKx7DAQUGKzYUE8MBASTECgETwgEIEBIRDxASEQ/EAQEjxwoB
I0ACA8UBAw0MC8gAAgMExQEFDgAOIBXCHQEVwh0EIQAVPsoBBRkXLRITwwEFIhFJFBPCAQEixgoK
EwEQEhEPEBIRD8UBASPFCgEjQAIDxgEDDQwLyAACAwTFAQEOwgACDiDCFQIdFcIdAyEOL8oBEhkX
BSIRDwEQEiYWFBMBFhQXBcIBDBYUEQ8QEhEPEBIRD8YBASPDCgEjQAIDxwEDDQwLyAACAwTFAQEO
wwACDiDCFcIdwg4COC/KAQ0ZFwUkJR4BBh8cFhQTxQECEBLCCgoRDxASEQ8QEhEPxwEDIwojQAMD
Aw0MC8gAAgMExQEBDsIABRoADiAdwg7CAAI4DsoBDRkXBRYUEwEiFwUWFBPCAQIGH8UKChEPEBIR
DxASEQ/IAQEjQAMDAQEDDQwLyAACAwTFAQQOACoawgAEPA4AGsIAAicOygEQGRcFARkRDxkmARYU
EwEWFMIKDhMBFhQRDxASEQ8QEhEPQAQDwgEDDQwLyAACAwTFAQQOABoqxQAFGioAJw7KAREZFwUB
JCU2FBwBFhQTASQKHMMBDBYUEQ8QEhEPEBIRD0AEA8IBAw0MC8gAAgMExQEDDgAaxgAHKhoAJw4a
FcgBERkXBQEWFEIXBQEWFBMBJAomwgENFhQKEQ8QEhEPEBIRD0AEA8IBAw0MC8gAAgMExQEBGsMO
BBoVS0zCAAQaACcOwhrIAQMZFwXCAQMZCibCAQYWFBMBFhTGCgoXBRASEQ8QEhEPQAQDwgEDDQwL
yAACAwTJAQIVGsIOCBoVORonDhoVyAEDGRcFwgEDIgocwgEDFhQTwgECFhTDCgwcGSUeEBIRDxAS
EQ9ABAPCAQMNDAvIAAIDBM0BAhUaww4CGhVACQPDAQMNDAvIAAIDBEALA8cBAw0MC8gAAgMEQAsD
xwEDDQwLyAACAwRACwPHAQMNDAvIAAIDBEALA8cBAw0MC8gAAgMEQAsDxwEDDQwLyAACAwRACwPH
AQMNDAvIAAIDBEALA8cBAw0MC8gAAgMExQEJEBIKEwYILSkeyAEDBggFwwEDBggFxwEDBggFzwED
BggFwwEGBggFBggFxAEDBggFxgEDBggFxwEEBggFAQMNDAvIAAIDBMUBAwYIBc4BAwYIBcMBAwYI
BUADAwQBBggFwwEGBggFBggFzQEDBggFxwEEBggFAQMNDAvIAAIDBMUBDxQKJUUIBQEGCAUGMTUX
BcIBAwYIBcMBEAYIBQEWFAoXBQEGCAUGKEPCCgMcARnDCgEmwwEDBggFwwEWBggFBggFBjE1FywI
BQEWFAolHgYIQcIKARzEAQQGCAUQAw0MC8gAAgMExQENBggFBggFAQYIBQYfHMQBAwYIBcMBFAYI
BRASEwEkEQ8GCAUGHxMBJBEPwgEDECkewwEDBggFwwEaBggFBggFBh8cAQYIBRASHAEkEUgfEwEk
EQ/DAQQGCC0SAw0MC8gAAgMExQENBggFBggFAQYIBQYIBcQBAgYfxQoTFwUGCAUBECkeBggFBggF
AQYIBcIBAiITxAEDBggFwwEQBggFBggFBggFAQYIBQYIBcMBBwYIBQEGCAXDAQQGKzAKAw0MC8gA
AgMExQENBggFBggFAQYIBQYIBcQBAwYIBcMBBQYIBQYfwwoQJR4GCAUGCAUBBggFAQYoD8QBAwYI
BcMBEAYIBQYIBQYIBQEGCAUGKA/DAQcGCAUBBggFwwEEBh8TFgMNDAvIAAIDBMUBDQYIBQYIBQEG
CAUGCAXEAQMGCAXDAQYGCAUGCAXEAQ0GCAUGCAUBBggFECkexQEDFjQewwEQBigPBggFBggFAQYI
BQYIBcMBBwYIBQEGCAXDAQQGCAUBAw0MC8gAAgMExQENBggFFjQeASIXBQYIBcQBAwYIBcMBFgYI
BRASEwEGCAUGCAUGCAUBBggFIhPHAQIZJsIBGxASEwEGCAUGCAUBBggFEBIcAQYILAgFAQYIBcMB
BAYIBQEDDQwLyAACAwTFAQUGCAUBIsIKBjJABQYIBcQBAwYIBcMBBgYIBQEWFMIKDRwBBggFBggF
AQYIRxTECgETxAEBGcMKARPCARcGCAUGCAUBBggFARYUCiUeBggFAQYIBcMBBAYIBQEDDQwLyAAC
AwRACwPHAQMNDAvIAAIDBEALA8cBAw0MC8gAAgMEQAsDxwEDDQwLyAADAwQBQAsExgcDDQwLyAAE
AwQBB0ALAcUDAw0MC8gABQMEAQcDQAsFxAkDDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJ
QAsAwwCWANkBAAAAAAAAAAAAABUAxwEDDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsA
wwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwAD
DQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwL
yAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAG
AwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAGAwQBBwMJQAsAwwADDQwLyAAEAwQB
B0ADBsYCxBhABwbDAgMNDAvIAAQDBAEHQAMGxgIEGAAbGEAHBsMCAw0MC8gABAMEAQdAAwbGAgQY
ABsYQAcGwwIDDQwLyAAEAwQBB0ADBsYCBBgAGxhABwbDAgMNDAvIAAQDBAEHQAMGwwLEGAIAG8QY
QAcGAw0MC8gABAMEAQdAAwbDAgEYwwDFGwEYywICLj/EDgU6Ri4zN0AEBsICAw0MC8gABAMEAQdA
AwbDAgIOGMYbARjMAgMuMzdABQbCApcA7QAAAP///6jA0NDY6HCYwKjA2HDA0KioqKC4yBhAmODg
4ABAgHBoYJiYoMjI0AAAAIjA0KjAyABQqFBQgBiAyDhAgHCgyKjAuABAmDAwMHBogECAuPjgsDiQ
0NDg6FCo0BhAgJi42CBAWIiAiABgyKiQmABAiABouKjI4BhQqFBQiLjQ4BhAiHCoqHDAyNC4cAgQ
GBhQgBhQmBiAqCAASDhAiDhQgFCouIjY6KjA4ODo8AAAKABQiAgYIBAgMBgwSCAAADhAmDhogDho
mFBogFCAiFCQqGi46HDAuIioqIjAuNjo8Ojw+PDw+JgArgAAAAAAAAAAAAAAAAABAAQAAgAEAAAA
AAAAAAMDAwMDAwMDAAAAAAAAAAAAAAAAAAAAAAQEBAQEBAQEAAAAAAAAAAAAAAAAAAAAAAEBAQEB
AQEBAAAAAAAAAAAAAAAAAAAAAAcHBwcHBwcHAAD+/wAAAAAAAAAAAAAAAAkJCQkJCQkJAAAAAAAA
AAAAAAAAAAAAAAICAgICAgICAAAAAAAAAACWPgAAAAAAAA==
</notesbitmap></picture> |
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim dc As NotesDocumentCollection
Set dc = db.UnprocessedDocuments
If dc.Count = 0 Then
Messagebox "No document selected",, "No document"
Exit Sub
End If
Dim doc As NotesDocument
Set doc = dc.GetFirstDocument
Dim NewDoc As NotesDocument
Dim rtitem As NotesRichTextItem
Set InMemDoc = db.CreateDocument
Set rtitem = InMemDoc.CreateRichTextItem( "DXL" )
' Export DXL int RichTextField
Dim exporter As NotesDXLExporter
Set exporter = session.CreateDXLExporter
Call exporter.SetInput(doc)
Call exporter.SetOutput(rtitem)
Call exporter.Process
' Modify Body with FindAndReplace
' #RT:RTTWO
Dim rtnav As NotesRichTextNavigator
Dim rtrange As NotesRichTextRange
Dim ret As Integer
Set rtnav = rtItem.CreateNavigator
Set rtrange = rtItem.CreateRange
ret = rtrange.FindAndReplace _
( "#RT:RTTWO",_ ' find
REPLACE_WITH, _ ' replaceWith
RT_REPL_ALL + RT_FIND_CASEINSENSITIVE)
Call rtItem.Update ' Must update before looping
Dim importer As NotesDXLImporter
Set importer = session.CreateDXLImporter(rtItem, db)
importer.DocumentImportOption = DXLIMPORTOPTION_REPLACE_ELSE_IGNORE
Call importer.Process
Call InMemDoc.remove(True)
'doc.form = "Memo"
'doc.SendTo = "Heinz Ulrich Krause/witte/de"
'Call doc.Send(False)
End Sub
Anbei noch einmal eine aktuelle Sample Database
Erstmal zum navigieren:
Ich habs mit dem oberen Skript gemacht (griff auf ein File zu und erschien mir einfacher):
Sub Initialize
Dim session As NotesSession
Dim db As NotesDatabase
Dim inputStream As NotesStream
Dim domParser As NotesDOMParser
Dim rootElement As NotesDOMElementNode
Dim docList As NotesDOMNodeList
Dim node As NotesDOMNode
Dim nodeChildOfRTOne As NotesDOMNode
Dim eNode As NotesDOMElementNode
Dim i As Integer
Dim origXML As String
origXML = "c:\temp\RichText.xml"
Set session = New NotesSession
Set db = session.CurrentDatabase
Set inputStream = session.CreateStream
inputStream.Open (origXML)
Set domParser=session.CreateDOMParser ( inputStream )
domParser.Process
Set rootElement = domParser.Document.DocumentElement
Set docList = rootElement.GetElementsByTagName ( "item" )
If docList.NumberOfEntries = 0 Then
Messagebox "No <item> element nodes in file", , "Error"
Exit Sub
End If
For i = 1 To docList.NumberOfEntries
Set node = docList.GetItem( i )
Set enode = node
If enode.GetAttribute("name") = "RTONE" Then
Msgbox "found at position " & Cstr(i)
Stop
rem hier kommen ein paar ergänzungen....
If enode.hasChildNodes Then
Set nodeChildOfRTOne = enode.FirstChild
While Not (nodeChildOfRTOne.isNull)
Msgbox nodeChildOfRTOne.NodeName & " vom Typ : " & Cstr(nodeChildOfRTOne.NodeType)
Set nodeChildOfRTOne = nodeChildOfRTOne.nextSibling
Wend
End If
End If
Next
End Sub
... und jetzt willst du da noch eine node anhängen? Versuch mal, ob ich aus dem bisherigen Text i.S. von ToDo schlau werde.
DOM hat als api in jeden Fall ein paar bekannte Überraschungen. Z.B. dass der Text-Nodes als Childnodes von enode rausgibt ist nicht direkt offensichtlich.
Beim Erzeugen und Einhängen von nodes gab es aber auch gotchas. Ich sollte die aber kennen.
In Java benutzt man heute übrigens eher neuere apis oberhalb von dom die einfacher in der Handhabung sind, wie z.B. dom4j.
Dom ist eine xml Api für allemöglichen Programmiersprachen. Durch diesen kleinste-gemeinsame-Nenner Ansatz wird die api selbst natürlich kompliziert.
Die Api ist entkoppelt von der Programmiersprache. Das hat eben auch Nachteile :-)
Hab das nochmal kurz ein bischen erweitert.
Er überprüft jetzt auch childs von <richtext>
Sicher vom code her nicht das gelbe. Man sollte das irgendwie rekursiver und vielleicht auch wiederverwendbarer machen. Jedenfalls iteriert er jetzt über die pars, pardefs oder wie immer die heissen.
Allgemein gute Ideen:
Mit der Superklasse NotesDomNode arbeiten. Diese gehört einer von 13 Typen an (s. Attribut NodeType).
In dieser Klasse gibts btw. auch Methoden zum anhängen (nur am Ende einer Liste -> outch), ersetzen und entfernen.
Beim Erstellen einer Node gibts einen Trick. Unwahrscheinlich, dass ich das heute abend noch packe.
Hier nur noch ein Teil des obigen Skripts. den block einfach austauschen.
oben in den dims: Dim nodeChildRichText As NotesDOMNode
If enode.GetAttribute("name") = "RTONE" Then
Msgbox "found at position " & Cstr(i)
Stop
If enode.hasChildNodes Then
Set nodeChildOfRTOne = enode.FirstChild
While Not (nodeChildOfRTOne.isNull)
Msgbox nodeChildOfRTOne.NodeName & " vom Typ : " & Cstr(nodeChildOfRTOne.NodeType)
If nodeChildOfRTOne.NodeName = "richtext" Then
If nodeChildOfRtOne.hasChildNodes Then
Set nodeChildRichText = nodeChildOfRTOne.FirstChild
While Not (nodeChildRichText.IsNull)
Msgbox "kind von <richtext>:" & nodeChildRichText.nodeName & " vom Typ: " & Cstr(nodeChildRichText.NodeType)
Set nodeChildRichText = nodeChildRichText.nextSibling
Wend
End If
End If
Set nodeChildOfRTOne = nodeChildOfRTOne.nextSibling
Wend
End If
End If
Ein nächster Schritt wäre dann dies:
Set notesDOMNode = notesDOMNode.ReplaceChild( newChild, oldChild )
Für die Erzeugung von Nodes hat die Klasse:
NotesDOMDocumentNode class
createMethoden (Factory-method).
So, hier erst einmal der Code, um die Einfügemarke RT:RTONE im RichtextFeld RTONE zu finden
Sub Click(Source As Button)
Dim session As NotesSession
Dim db As NotesDatabase
Dim inputStream As NotesStream
Dim domParser As NotesDOMParser
Dim rootElement As NotesDOMElementNode
Dim docList As NotesDOMNodeList
Dim node As NotesDOMNode
Dim nodeChildOfRTOne As NotesDOMNode
Dim nodeChildRichText As NotesDOMNode
Dim eNode As NotesDOMElementNode
Dim parNode As NotesDOMElementNode
Dim i As Integer
Dim origXML As String
origXML = "c:\RichText.xml"
Set session = New NotesSession
Set db = session.CurrentDatabase
Set inputStream = session.CreateStream
inputStream.Open (origXML)
Set domParser=session.CreateDOMParser ( inputStream )
domParser.Process
Set rootElement = domParser.Document.DocumentElement
Set docList = rootElement.GetElementsByTagName ( "item" )
If docList.NumberOfEntries = 0 Then
Messagebox "No <item> element nodes in file", , "Error"
Exit Sub
End If
For i = 1 To docList.NumberOfEntries
Set node = docList.GetItem( i )
Set enode = node
If enode.GetAttribute("name") = "RTONE" Then
'Msgbox "found at position " & Cstr(i)
If enode.hasChildNodes Then
Set nodeChildOfRTOne = enode.FirstChild
While Not (nodeChildOfRTOne.isNull)
'Msgbox nodeChildOfRTOne.NodeName & " vom Typ : " & Cstr(nodeChildOfRTOne.NodeType)
If nodeChildOfRTOne.NodeName = "richtext" Then
If nodeChildOfRtOne.hasChildNodes Then
Set nodeChildRichText = nodeChildOfRTOne.FirstChild
While Not (nodeChildRichText.IsNull)
'Msgbox "kind von <richtext>:" & nodeChildRichText.nodeName & " vom Typ: " & Cstr(nodeChildRichText.NodeType)
If nodeChildRichText.NodeName = "par" Then
'Msgbox nodeChildRichText.NodeName
Set parnode = nodeChildRichText
If ( Not parNode.FirstChild.IsNull ) Then
If ( Not Isnull (parnode.FirstChild.NodeValue ) ) Then
If parnode.FirstChild.NodeValue = "RT:RTONE" Then
Msgbox "HEUREKA"
End If
End If
End If
End If
Set nodeChildRichText = nodeChildRichText.nextSibling
Wend
End If
End If
Set nodeChildOfRTOne = nodeChildOfRTOne.nextSibling
Wend
End If
End If
Next
End Sub
Funktioniert auch bei einer XML Datei mit 10MB in knapp einer Sekunde. Ist also für eine Hintergrundaktion genügend performant, denke ich ...
Der Code müsste auch verwendbar sein, um die <par ... > Nodes des RT Feldes auszulesen, dessen Werte eingefügt werden sollen.
Hilft dieser Stan Rogers code weiter:
Oder vielleicht wendest du dich einfach an ihn. Normal gibt der sich ja sehr hilfsbereit (ich glaub 60% der Antworten zu Programmierfragen in Notes-Foren sind von ihm). Ansonsten kann ich auch weitermachen. Hab aber z.Zt. ziemlich viel anderen Kram.
Function CrossDocClone(SourceNode As NotesDOMNode, TargetParentNode As NotesDOMNode) As NotesDOMNode
Dim NewNode As NotesDOMNode
Dim NewChildNode As NotesDOMNode
Dim NextNode As NotesDOMNode
<error handling statement goes here -- there may be failures>
%REM
This assumes the following objects are Global
SourceRootDoc -- the NotesDOMDocumentNode that clones are drawn from
TargetRootDoc -- the NotesDOMDocumentNode that clones are inserted into
%END REM
Select Case SourceNode.NodeType
'ignoring attribute, comment, document and entity types
Case DOMNODETYPE_ELEMENT_NODE
Set NewNode = TargetRootDoc.CreateElementNode(SourceNode.NodeName)
Case DOMNODETYPE_TEXT_NODE
Set NewNode = TargetRootDoc.CreateTextNode(SourceNode.NodeValue)
Case DOMNODETYPE_CDATASECTION_NODE
Set NewNode = TargetRootDoc.CreateCDATASectionNode(SourceNode.NodeValue)
End Select
If SourceNode.HasAttributes Then
Dim map As NotesDOMNamedNodeMap
Dim attrib As NotesDOMAttributeNode
Dim count As Integer
Set map = SourceNode.Attributes
For count = 1 To map.NumberOfElements
Set attrib = map.GetItem(count)
Call NewNode.SetAttribute(attrib.NodeName, attrib.NodeValue)
Next
End If
Call TargetParentNode.AppendChild(NewNode)
If SourceNode.HasChildNodes Then
Set NextNode = SourceNode.FirstChild
Set NewChildNode = CrossDocClone(NextNode, NewNode)
Set NextNode = NextNode.NextSibling
While Not NextNode.IsNull
Set NewChildNode = CrossDocClone(NextNode, NewNode)
Wend
End If
End Function
1. DomDocumentNode-Objekt erzeugen:
Dim docNode As NotesDOMDocumentNode
[...]
Set docNode = domParser.Document
2. Mit docNode (!) eine DomElement erzeugen.
Dim newNode as notesDOMElementNode
[...]
Set newNode = docNode.CreateElementNode("NewElement")
Dies erzeugt ein <newElement></newElement> (Attribute, childNodes als Text oder als weitere nodes können da sicher angefügt werden).
3. newNode an eine existierende node anhängen:
Call nodeChildRichText.AppendChild(newNode)
Der entsprechende code in meinem Beispielcode sieht so aus:
If nodeChildRichText.NodeName = "pardef" Then
Stop
Set newNode = docNode.CreateElementNode("NewElement")
Call nodeChildRichText.AppendChild(newNode)
End If
Man kann alle Bestandteile dieser Node auslesen (nodeName, enthaltener Text, enthaltene Nodes, Attribute-Nodes) und daraus eine neue Node erzeugen. Aber vielleicht gibts einen besseren Weg.
Aus
<item name='RTTWO'><richtext>
<pardef id='2'/>
<par def='2'/></richtext></item>
<item name='RTTWO'><richtext>
<pardef id='2'>
<newElement/>
</pardef>
<par def='2'/></richtext></item>
Ich hab auch Probleme das manipulierte xml in eine Datei herauszuschreiben. Kann mir da jemand helfen?
Axel
*HaareRauf* Gerade, als ich dachte, ich hätte das Pipelining verstanden, .... bin ich so schlau als wie zuvor .
Der Exporter übergibt an den Parser, der Parser parsed, übergibt aber nicht an den Importer ( so sieht es zumindest aus ) Der Code läuft fehkerfrei durch. Im Debugger sieht man auch, daß
parnode.FirstChild.NodeValue = "Hallo Welt"
gesetzt wird. Also müsst edoch das Document aktualisiert werden. ???
Das ist das "Dumme" beim Pipeline; man sieht irgendwie nicht mehr, was passiert ...
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim rootElement As NotesDOMElementNode
Dim docList As NotesDOMNodeList
Dim node As NotesDOMNode
Dim nodeChildOfRTOne As NotesDOMNode
Dim nodeChildRichText As NotesDOMNode
Dim eNode As NotesDOMElementNode
Dim parNode As NotesDOMElementNode
Dim cloneNode As NotesDOMNode
Dim i As Integer
Dim dc As NotesDocumentCollection
Set dc = db.UnprocessedDocuments
If dc.Count = 0 Then
Messagebox "No document selected",, "No document"
Exit Sub
End If
Dim doc As NotesDocument
Set doc = dc.GetFirstDocument
Dim exporter As NotesDXLExporter
Dim domParser As NotesDOMParser
Set exporter = session.CreateDXLExporter
Set domParser=session.CreateDOMParser
Call exporter.SetInput ( doc )
Call exporter.SetOutput ( domParser )
Call exporter.process
Set rootElement = domParser.Document.DocumentElement
Set docList = rootElement.GetElementsByTagName ( "item" )
If docList.NumberOfEntries = 0 Then : Exit Sub
For i = 1 To docList.NumberOfEntries
Set node = docList.GetItem( i )
Set enode = node
If enode.GetAttribute("name") = "RTONE" Then
If enode.hasChildNodes Then
Set nodeChildOfRTOne = enode.FirstChild
While Not (nodeChildOfRTOne.isNull)
If nodeChildOfRTOne.NodeName = "richtext" Then
If nodeChildOfRtOne.hasChildNodes Then
Set nodeChildRichText = nodeChildOfRTOne.FirstChild
While Not (nodeChildRichText.IsNull)
If nodeChildRichText.NodeName = "par" Then
Set parnode = nodeChildRichText
If ( Not parNode.FirstChild.IsNull ) Then ' skip NULL Values
If parnode.FirstChild.NodeValue = "RT:RTONE" Then
parnode.FirstChild.NodeValue = "Hallo Welt"
Msgbox "HEUREKA"
Else
End If
End If
End If
Set nodeChildRichText = nodeChildRichText.nextSibling
Wend
End If
End If
Set nodeChildOfRTOne = nodeChildOfRTOne.nextSibling
Wend
End If
End If
Next
Dim importer As NotesDXLImporter
Set importer = session.CreateDXLImporter
Call importer.SetInput ( domParser )
Call importer.SetOutput ( db )
End Sub
Agent:
Options:
Option Public
Option Declare
Declarations:
Dim session As NotesSession
Initialize:
Dim db As NotesDatabase
Dim inputStream As NotesStream
Dim docNode As NotesDOMDocumentNode
Dim domParser As NotesDOMParser
Dim Importer As NotesDOMParser
Dim rootElement As NotesDOMElementNode
Dim docList As NotesDOMNodeList
Dim node As NotesDOMNode
Dim newNode As NotesDOMNode
Dim nodeChildOfRTOne As NotesDOMNode
Dim nodeChildRichText As NotesDOMNode
Dim eNode As NotesDOMElementNode
Dim i As Integer
Dim origXML As String
Dim outputFile As String
Dim outputStream As NotesStream
Dim exporter As NotesDOMParser
origXML = "c:\temp\RichText.xml"
Set session = New NotesSession
Set db = session.CurrentDatabase
Set inputStream = session.CreateStream
inputStream.Open (origXML)
Set exporter=session.CreateDOMParser ()
Set domParser = session.CreateDOMParser()
Set Importer=session.CreateDOMParser ( inputStream)
outputFile = "c:\temp\RichTextNew.xml"
Set outputStream = session.CreateStream
outputStream.Open(outputFile)
' Set input for Exporter
'Set output for Exporter
'Set output for Parser
Call exporter.setInput(domParser)
Call exporter.setOutput(outputStream)
Call domParser.setInput(importer)
importer.Process
On Event PostDOMParse From domParser Call PlayWithDXLRoutine
Set docNode = domParser.Document
Set rootElement = domParser.Document.DocumentElement
Set docList = rootElement.GetElementsByTagName ( "item" )
If docList.NumberOfEntries = 0 Then
Messagebox "No <item> element nodes in file", , "Error"
Exit Sub
End If
For i = 1 To docList.NumberOfEntries
Set node = docList.GetItem( i )
Set enode = node
If enode.GetAttribute("name") = "RTONE" Then
Msgbox "found at position " & Cstr(i)
Stop
If enode.hasChildNodes Then
Set nodeChildOfRTOne = enode.FirstChild
While Not (nodeChildOfRTOne.isNull)
Msgbox nodeChildOfRTOne.NodeName & " vom Typ : " & Cstr(nodeChildOfRTOne.NodeType)
If nodeChildOfRTOne.NodeName = "richtext" Then
If nodeChildOfRtOne.hasChildNodes Then
Set nodeChildRichText = nodeChildOfRTOne.FirstChild
While Not (nodeChildRichText.IsNull)
'Msgbox "kind von <richtext>:" & nodeChildRichText.nodeName & " vom Typ: " & Cstr(nodeChildRichText.NodeType)
If nodeChildRichText.NodeName = "pardef" Then
Stop
Set newNode = docNode.CreateElementNode("NewElement")
Call nodeChildRichText.AppendChild(newNode)
End If
Set nodeChildRichText = nodeChildRichText.nextSibling
Wend
End If
End If
Set nodeChildOfRTOne = nodeChildOfRTOne.nextSibling
Wend
End If
End If
Next
Stop
Subroutine:
Public Sub PlayWithDxlRoutine(domParser As NotesDomParser)
domParser.serialize
End Sub
2 files in c:\temp
RichText.xml und RichTextNew.xml
RichTextNew.xml kann einfach eine leere Datei sein.
RichText.xml
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE document SYSTEM 'xmlschemas/domino_7_0.dtd'>
<document xmlns='http://www.lotus.com/dxl' version='7.0' replicaid='C125715F002D73D1'
form='Sample'>
<noteinfo noteid='916' unid='7EE586C3D6B725CCC1257160004210E3' sequence='26'>
<created><datetime dst='true'>20060430T140136,99+02</datetime></created>
<modified><datetime dst='true'>20060501T143234,46+02</datetime></modified>
<revised><datetime dst='true'>20060501T143234,45+02</datetime></revised>
<lastaccessed><datetime dst='true'>20060501T143234,45+02</datetime></lastaccessed>
<addedtofile><datetime dst='true'>20060430T140144,62+02</datetime></addedtofile></noteinfo>
<updatedby><name>CN=Heinz Ulrich Krause/O=Witte/C=de</name></updatedby>
<revisions><datetime dst='true'>20060430T140144,62+02</datetime><datetime
dst='true'>20060430T140243,32+02</datetime><datetime dst='true'>20060430T140318,98+02</datetime><datetime
dst='true'>20060430T140350,65+02</datetime><datetime dst='true'>20060430T140423,73+02</datetime><datetime
dst='true'>20060430T144720,51+02</datetime><datetime dst='true'>20060430T153953,81+02</datetime><datetime
dst='true'>20060430T154101,45+02</datetime><datetime dst='true'>20060430T154103,21+02</datetime><datetime
dst='true'>20060430T154143,04+02</datetime><datetime dst='true'>20060430T154235,77+02</datetime><datetime
dst='true'>20060430T154437,24+02</datetime><datetime dst='true'>20060430T154904,73+02</datetime><datetime
dst='true'>20060430T155631,37+02</datetime><datetime dst='true'>20060430T160359,38+02</datetime><datetime
dst='true'>20060430T162002,11+02</datetime><datetime dst='true'>20060430T162040,60+02</datetime><datetime
dst='true'>20060430T162107,21+02</datetime><datetime dst='true'>20060430T163828,93+02</datetime><datetime
dst='true'>20060501T094942,46+02</datetime><datetime dst='true'>20060501T095028,39+02</datetime><datetime
dst='true'>20060501T101412,59+02</datetime><datetime dst='true'>20060501T104914,32+02</datetime><datetime
dst='true'>20060501T114738,49+02</datetime><datetime dst='true'>20060501T115259,27+02</datetime></revisions>
<item name='OriginalModTime'><datetime dst='true'>20060501T143234,44+02</datetime></item>
<item name='RTONE'>
<richtext>
<pardef id='1'/>
<par def='1'>TEST</par>
<par def='1'/>
<par def='1'><<RT:RTTWO>></par>
<par def='1'/>
<par def='1'>noch mehr Text</par>
</richtext>
</item>
<item name='RTTWO'><richtext>
<pardef id='2'/>
<par def='2'/></richtext></item>
<item name='TextField'><text/></item>
</document>
Der einzige Weg, das Ziel zu erreichen ist ein MERGE zweier XML Dateien. Der Platzhalter ( RT:RTONE ) definiert dabei das RichTextFeld des Dokuments, welches in das Originaldokument eingefügt werden soll ( und eben auch die Position des Insert )
Wie schon erwähnt, kann man kein einzelnes Feld per DXLExport in ein XML File schreiben.
Daher muß man dafür sorgen, daß die MergeXML function genau die Stellen des XML merged, die dem RTONE entsprechen.
Der folgende Code extrahiert aus einem DXLExport die für das RichtextFeld RTONE relevanten Stellen.
aus:
<?xml version='1.0' encoding='utf-8'?>
<!DOCTYPE document SYSTEM 'xmlschemas/domino_7_0.dtd'>
<document xmlns='http://www.lotus.com/dxl' version='7.0' replicaid='C125716400442909'
form='Sample'>
<noteinfo noteid='8fe' unid='5F51EAD9AF6B93A0C12571650030E607' sequence='17'>
<created><datetime dst='true'>20060505T105406,15+02</datetime></created>
<modified><datetime dst='true'>20060505T184225,59+02</datetime></modified>
<revised><datetime dst='true'>20060505T184225,58+02</datetime></revised>
<lastaccessed><datetime dst='true'>20060505T184225,58+02</datetime></lastaccessed>
<addedtofile><datetime dst='true'>20060505T105424,71+02</datetime></addedtofile></noteinfo>
<updatedby><name>CN=Heinz Ulrich Krause/O=Witte/C=de</name></updatedby>
<revisions><datetime dst='true'>20060505T105424,71+02</datetime><datetime
dst='true'>20060505T182943,24+02</datetime><datetime dst='true'>20060505T183029,98+02</datetime><datetime
dst='true'>20060505T183236,20+02</datetime></revisions>
<item name='OriginalModTime'><datetime dst='true'>20060505T184225,58+02</datetime></item>
<item name='RTONE'><richtext>
<pardef id='1'/>
<par def='1'><run><font style='bold italic underline' color='red'/>Dieser Text soll eingefügt werden</run></par></richtext></item>
<item name='RTTWO'><richtext>
<pardef id='2'/>
<par def='2'/></richtext></item>
<item name='TextField'><text/></item></document>
wird
<par def='1'><run><font style='bold italic underline' color='red'/>Dieser Text soll eingefügt werden</run></par>
Da wo jetzt ein Print m_stream_buf steht, werden die Daten über ein rt.Appendtext ( m_stream_bufbuf ) in ein RT Feld in das SoureXML gemerged.
Anschließend aktualisiert ein DXLImporter das Ursprungsdokument.
Attachments brauchen wieder eine Sonderbehandlung, da ja auch die $File - Daten in das Ursprungsdokument übernommen werden müssen. ( wie das geht; nach der nächsten MAUS )
Sub Click(Source As Button)
Const RT_FIELD = "RTONE"
MergeFile = "c:\RichText.xml"
Dim s As New NotesSession
Dim db As NotesDatabase
Set db = s.CurrentDatabase
Dim m_stream As NotesStream
Dim m_stream_buf As String
Set m_stream = s.CreateStream
If ( Not m_stream.open ( MergeFile )) Then
Exit Sub
End If
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf, |<item name='| ) > 0 And Instr ( m_stream_buf, RT_FIELD ) > 0 Then
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf, |<pardef| ) > 0 Then
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
End If
If Instr ( m_stream_buf, |</richtext></item>| ) > 0 Then
m_stream_buf = Left$ ( m_stream_buf, Len ( m_stream_buf ) - ( Len ( |</richtext></item>| ) +1 ) )
Print m_stream_buf
Exit Do
End If
Print m_stream_buf
Loop Until Instr(m_stream_buf, |</item>| ) > 0
End If
Loop Until m_stream.IsEOS
m_stream.Close
End Sub
Auch wenn es bei grossen Datenmangen ( beide Files ~ 100 MB ) nicht sonderlich performant ist, kommt man schlussendlich zum Ziel: Richtext in RichText einfügen !!
Soweit mein Ansatz
(http://www.eknori.de//_data/MacGyver.jpg)
Grandios auch die Tatsache, daß der Fred schon fast 600 Mal angesehen wurde; es gibt offenbar ein Bedürfnis für eine solche Funktion.
Grundsätzlich funktioniert das mergen jetzt
Hier der Code
Function MergeXML ( SourceFile As String, MergeFile As String ) As Boolean
MergeXML = False
Const RT_FIELD = "RTONE"
Dim s As New NotesSession
Dim db As NotesDatabase
Set db = s.CurrentDatabase
Dim tmpDoc As NotesDocument
Set tmpDoc = New NotesDocument(db)
Dim rtXML As New NotesRichTextItem (tmpDoc, "Body")
Dim s_stream As NotesStream
Dim m_stream As NotesStream
Dim s_stream_buf As String
Dim m_stream_buf As String
Dim HAS_ATTACHMENTS As Boolean
Dim i As Integer
Set s_stream = s.CreateStream
If ( Not s_stream.open ( SourceFile )) Then
Exit Function
End If
i = 1
HAS_ATTACHMENTS = False
' Read the Source File line by line
Do
s_stream_buf = s_stream.ReadText ( STMREAD_LINE, 4 )
Do While Instr ( Ucase ( s_stream_buf ) , Ucase ( "RT:" + RT_FIELD ) )> 0
' insert data from merge file
Set m_stream = s.CreateStream
If ( Not m_stream.open ( MergeFile )) Then
Exit Function
End If
' Read the MergeFile line by line
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( Ucase ( m_stream_buf ) , Ucase ( |<item name='| + RT_FIELD +|'>|) ) > 0 Then
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf, |<pardef| ) > 0 Then
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
End If
If Instr ( m_stream_buf, |</richtext></item>| ) > 0 Then
m_stream_buf = Left$ ( m_stream_buf, Len ( m_stream_buf ) - ( Len ( |</richtext></item>| ) +1 ) )
Call rtXML.AppendText ( m_stream_buf )
Exit Do
End If
Dim pos As Long
pos = Instr ( Ucase ( m_stream_buf ) , Ucase ( |<attachmentref name='| ) )
If pos > 0 Then
' Determine the <attachmentref name= of all attachments in mergefile
' and store names in array for further use
HAS_ATTACHMENTS = True
Redim Preserve AttNames ( i ) As String
AttNames ( i -1 ) = Mid ( m_stream_buf , pos +21 , Instr (Mid ( m_stream_buf , pos + 21 , ( Len(m_stream_buf ) - 21 )) , |'|) -1 )
i = i +1
End If
Call rtXML.AppendText ( m_stream_buf )
Loop Until Instr(m_stream_buf, |</item>| ) > 0
Exit Do
End If
Loop Until m_stream.IsEOS
Dim m_stream_pos As Long
m_stream_pos = m_stream.Position 'store current stream location
m_stream.Close ' close stream
s_stream_buf = s_stream.ReadText ( STMREAD_LINE, 4 )' read next line
Loop
If HAS_ATTACHMENTS And Instr ( s_stream_buf, |</document>| ) > 0 Then
' strip the </document> tag from s_stream_buf
Call rtXML.AppendText ( Replace ( s_stream_buf , |</document>| , "" ) )
' append filedata
Set m_stream = s.CreateStream
If ( Not m_stream.open ( MergeFile )) Then
Exit Function
End If
m_stream.Position = m_stream_pos
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
'If Instr ( Ucase ( m_stream_buf ) , Ucase ( |<item name='| + RT_FIELD +|'>|) ) > 0 Then
Call rtXML.AppendText ( m_stream_buf )
'End If
Loop Until m_stream.IsEOS
m_stream.Close ' close stream
' finally add </document> tag
'Call rtXML.AppendText ( |</document>| )
Else
Call rtXML.AppendText ( s_stream_buf )
End If
Loop Until s_stream.IsEOS
s_stream.Close
tmpdoc.Form = "Memo"
tmpdoc.SendTo = "Heinz Ulrich Krause/Witte/de"
Call tmpdoc.send ( False )
Dim importer As NotesDXLImporter
Set importer = s.CreateDXLImporter ( rtXML , db )
importer.DocumentImportOption = DXLIMPORTOPTION_REPLACE_ELSE_IGNORE
Call importer.Process
Kill ( sourceFile )
Kill ( mergeFile )
MergeXML = True
End Function
Es gibt noch 2 kleinere Probleme, die zu lösen sind.
1. Wenn nach der Einfügemarke am Ende des RichTextFeldes kein CRLF erfolgt, steigt der DXLImporter mit einem Fehler aus.
2. zur Zeit werden ALLE Attachments des MergeDoc übernommen. Hier muss ich noch nach den nur im gewünschten Feld enthaltenen Attachments filtern.
Ausserdem ist die Marke RT:RTONE z.Zt. noch fest verdrahtet, aber das ist kein Problem, die Marken im RT des SourceDoc zu ermitteln. :D
Hier noch der Codeteil, der die relevanten $FILE Informationen aus dem MergeDoc extrahiert
Forall m In AttNames
Set m_stream = s.CreateStream
If ( Not m_stream.open ( MergeFile )) Then
Exit Function
End If
m_stream.Position = m_stream_pos
Dim FILENAME As String
FILENAME = Cstr ( m )
Dim tmp_buf As String
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf , |<item name='$FILE'| ) > 0 Then
tmp_buf = m_stream_buf
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf , FILENAME ) > 0 Then
Call rtXML.AppendText ( tmp_buf )
Call rtXML.AppendText ( m_stream_buf )
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
m_stream_buf = Replace ( m_stream_buf , |</document>| , "" )
Call rtXML.AppendText ( m_stream_buf )
Loop Until Instr ( m_stream_buf , |</item>| ) > 0
End If
End If
Loop Until m_stream.IsEOS
Call m_stream.Close
End Forall
Hier nun der endgültige Code + eine Sample DB
Const PATHNAME = "c:\"
Sub Click(Source As Button)
Dim s As New NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim ret As Boolean
Set db = s.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
Dim SourceFileName As String
Dim MergeFileName As String
SourceFileName = ExportXML ( doc )
Set doc = dc.GetNextDocument ( doc )
MergeFileName = ExportXML ( doc )
ret = InsertRichText ( SourceFileName , MergeFileName ,"RTONE")
End Sub
Function ExportXML ( doc As NotesDocument ) As String
Dim s As New NotesSession
Dim stream As NotesStream
Set stream = s.CreateStream
Dim exporter As NotesDXLExporter
Dim FILENAME As String
Dim universalID As String*32
universalID = doc.UniversalID
FILENAME = PATHNAME + universalID +".xml"
If Not stream.Open ( FILENAME ) Then
Messagebox "Cannot open " & FILENAME,, "Error"
Exit Function
End If
Call stream.Truncate
Set exporter = s.CreateDXLExporter
Call exporter.SetInput ( doc )
Call exporter.SetOutput ( stream )
Call exporter.Process
ExportXML = FILENAME
End Function
Function InsertRichText ( SourceFile As String, MergeFile As String, FieldName As String) As Boolean
%REM
INSERTS a NotesRichTextItem into another NotesRichTextItem.
You can define the insertion point by writing a RT:<SomeFieldName> - Tag into the field where the Richtext
should be inserted.
Known issues:
If RT:RTONE is located at the end of the RTItem it has to be terminated by a CRLF. Otherwise the DXLImpoter
fails.
%END REM
InsertRichText = False
Dim s As New NotesSession
Dim db As NotesDatabase
Set db = s.CurrentDatabase
Dim tmpDoc As NotesDocument
Set tmpDoc = New NotesDocument(db)
Dim rtXML As New NotesRichTextItem (tmpDoc, "Body")
Dim s_stream As NotesStream
Dim m_stream As NotesStream
Dim s_stream_buf As String
Dim m_stream_buf As String
Dim HAS_ATTACHMENTS As Boolean
HAS_ATTACHMENTS = False
Dim i As Integer
i = 1
' Open source stream
Set s_stream = s.CreateStream
If ( Not s_stream.open ( SourceFile )) Then
Exit Function
End If
' Read the Source File line by line
Do
s_stream_buf = s_stream.ReadText ( STMREAD_LINE, 4 )
Do While Instr ( Ucase ( s_stream_buf ) , Ucase ( "RT:" + FieldName ) )> 0
' insert data from merge file
Set m_stream = s.CreateStream
If ( Not m_stream.open ( MergeFile )) Then
Exit Function
End If
' Read the MergeFile line by line
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( Ucase ( m_stream_buf ) , Ucase ( "<item name='" + FieldName +"'>" )) > 0 Then
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf, "<pardef" ) > 0 Then
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
End If
If Instr ( m_stream_buf, "</richtext></item>" ) > 0 Then
m_stream_buf = Left$ ( m_stream_buf,_
Len ( m_stream_buf ) - ( Len ( "</richtext></item>" ) +1 ) )
Call rtXML.AppendText ( m_stream_buf )
Exit Do
End If
Dim pos As Long
pos = Instr ( Ucase ( m_stream_buf ) , Ucase ( "<attachmentref name='" ) )
If pos > 0 Then
' Determine the <attachmentref name= of all attachments in mergefile
' and store names in array for further use
HAS_ATTACHMENTS = True
Redim Preserve AttNames ( i ) As String
AttNames ( i -1 ) =_
Mid ( m_stream_buf , pos +21 ,_
Instr (Mid ( m_stream_buf , pos + 21 ,_
( Len(m_stream_buf ) - 21 )) , "'") -1 )
i = i +1
End If
Call rtXML.AppendText ( m_stream_buf )
Loop Until Instr(m_stream_buf, "</item>" ) > 0
Exit Do
End If
Loop Until m_stream.IsEOS
Dim m_stream_pos As Long
m_stream_pos = m_stream.Position 'store current stream position
m_stream.Close ' close stream
s_stream_buf = s_stream.ReadText ( STMREAD_LINE, 4 )' read next line
Loop
If HAS_ATTACHMENTS And Instr ( s_stream_buf, "</document>" ) > 0 Then
' strip the </document> tag from s_stream_buf
Call rtXML.AppendText ( Replace ( s_stream_buf , "</document>" , "" ) )
' append filedata
Forall m In AttNames
If Trim ( Cstr ( m )) = "" Then Exit Forall
Set m_stream = s.CreateStream
If ( Not m_stream.open ( MergeFile )) Then
Exit Function
End If
' do not read from beginning of stream but restore last position
m_stream.Position = m_stream_pos
Dim FILENAME As String
FILENAME = Cstr ( m )
Dim tmp_buf As String
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf , "<item name='$FILE'" ) > 0 Then
tmp_buf = m_stream_buf '
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
If Instr ( m_stream_buf , FILENAME ) > 0 Then
Call rtXML.AppendText ( tmp_buf )
Call rtXML.AppendText ( m_stream_buf )
' loop through all lines until </item> is found
Do
m_stream_buf = m_stream.ReadText ( STMREAD_LINE, 4 )
m_stream_buf = Replace ( m_stream_buf , "</document>" , "" )
Call rtXML.AppendText ( m_stream_buf )
Loop Until Instr ( m_stream_buf , "</item>" ) > 0
End If
End If
Loop Until m_stream.IsEOS
Call m_stream.Close
End Forall
' finally append the closing tag </document>
Call rtXML.AppendText ( "</document>" )
Else
Call rtXML.AppendText ( s_stream_buf )
End If
Loop Until s_stream.IsEOS
s_stream.Close ' close dtream
' import the XML data and update the source document
Dim importer As NotesDXLImporter
Set importer = s.CreateDXLImporter ( rtXML , db )
importer.DocumentImportOption = DXLIMPORTOPTION_REPLACE_ELSE_IGNORE
Call importer.Process
' delete the exported files from the filesystem
Kill ( sourceFile )
Kill ( mergeFile )
InsertRichText = True
End Function
Habe heute ein bisschen mit der API herungespielt. Herausgekommen ist folgender Code, der den Inhalt aus einem Richtextfeld in ein anderes Richtextfeld an einer bestimmten Stelle einfügt. Die Einfügemarke ist "<RTINSERT>".
Der Code ersetzt alles Vorkommen von <RTINSERT> mit dem Inhalt des RTFeldes aus einem anderen Dokument.
Das Ganze ist selbstverständlich keine komplette Lösung, die man jetzt sofort in seine eigenen Anwendungen kopieren kann.
/*
Insert richtext into richtext
Ulrich Krause, 2006
*/
#include <LNCPPAPI.H>
#include <iostream>
using namespace std; // VS2003 uses namespaces so add this line. You could prefix cout with std::cout instead.
int main(int argc, char *argv[]) {
char errorBuf [LNERROR_MESSAGE_LENGTH];
LNNotesSession s;
LNDatabase db;
LNDocument docA;
LNDocument docB;
LNDocumentArray col;
LNRichText rtA;
LNRichText rtB;
LNRTCursor cursor;
LNSTATUS lnstatus = LNNOERROR;
LNSetThrowAllErrors( TRUE ); // get the API to trow catchable errors rather than return a status code from each operation.
try {
s.Init();
s.GetDatabase("richtext.nsf", &db, "");
db.Open();
db.GetDocuments(&col); // Get All documents in the database
docA = col[0]; // Get First Document
docB = col[1]; // Get Second Document
docA.Open(); // Open Document
docB.Open(); // Open Document
docA.GetItem("Body", &rtA); // Get Body Field
docB.GetItem("Body", &rtB); // Get Body Field
//Get a cursor pointing at the first element in the rich text.
rtA.GetCursor(&cursor);
lnstatus = cursor.GotoFirst ( "<RTINSERT>" );
//Loop through the end of the document.
while ( lnstatus != LNWARN_NOT_FOUND)
{
//Delete the original text string.
rtA.Delete( &cursor, 10);
//Replace the text string with the new one.
rtA.Insert( rtB ,&cursor);
//We have to save the doc before doing the next step
docA.Save();
//Go find the next string occurrence.
lnstatus = cursor.GotoNext( "<RTINSERT>" );
}
docA.Close();
docB.Close();
}
catch (LNSTATUS error ) {
LNGetErrorMessage( error, errorBuf);
cout << "Error: " << errorBuf << endl;
}
db.Close();
s.Term();
return 0;
}
Die Bilder zeigen das Dokument mit der Einfügemarke, den RT, der eingefügt werden soll und das Ergebnis.
Es werden alle Objekte eingefügt, alle Formatierungen bleiben erhalten.