Domino 9 und frühere Versionen > ND6: Entwicklung
RichText in RichText EINFÜGEN
eknori (retired):
ich habe noch ein wenig rumoptimiert.
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:
--- Code: ---<?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>
--- Ende Code ---
wird
--- Code: ---<par def='1'><run><font style='bold italic underline' color='red'/>Dieser Text soll eingefügt werden</run></par>
--- Ende Code ---
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 )
--- Code: ---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
--- Ende Code ---
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
Grandios auch die Tatsache, daß der Fred schon fast 600 Mal angesehen wurde; es gibt offenbar ein Bedürfnis für eine solche Funktion.
eknori (retired):
ich baue gerade an dem Code, zu ermitteln, ob in dem zu mergenden Code ein Attachment enthalten ist.
Muss ich denn jedes Stückchen Code selber hier posten ?
Ich habe zu dem Thema schon einige Steilvorlagen gegeben.
Ich wünsche mr. daß mal jemand den bisher geposteten Code aufschnappt und weiterentwickelt ... und sein Ergebnis hier auch postet.
eknori (retired):
ich fange gerade an, meien IPod zu lieben; Stevie Nicks säuselt mir gerade DREAMS in die Ohren, während ich über meinem Code sitze. Eine nahezu ideale Symbiose zwischen Geek und Musik. O0
Thomas Schulte:
Würde ich ja gerne machen, aber was du da gerade tust ist im Moment jenseits meines Verständnishorizontes.
eknori (retired):
Grundsätzlich funktioniert das mergen jetzt
Hier der Code
--- 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
--- Ende Code ---
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
Navigation
[0] Themen-Index
[#] Nächste Seite
[*] Vorherige Sete
Zur normalen Ansicht wechseln