Domino 9 und frühere Versionen > ND6: Entwicklung
RichText in RichText EINFÜGEN
eknori (retired):
Hier noch der Codeteil, der die relevanten $FILE Informationen aus dem MergeDoc extrahiert
--- Code: --- 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
--- Ende Code ---
eknori (retired):
Hier nun der endgültige Code + eine Sample DB
--- Code: ---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
--- Ende Code ---
eknori (retired):
ein kleines Problem gibt es noch, wenn man die Einfügemarke mehrfach einfügt ( das wirkt sich aber nur bei Anhängen aus )
Da werden dann auch die $FILE Daten mehrfach erzeugt; Solange man die Anhänge nicht bearbeitet und wieder in das Dokument einfügt, macht das aber nichts. Außer daß das Dokument in der Groesse anwächst. Ich habe aber schon eine Idee, wie man das lösen kann...
eknori (retired):
Um das Attachment Problem in den Griff zu bekommen, ist mächtig viel zusätzlicher Code nötig.
Hängt man das gleiche Attachment zweimal in ein RichtextFeld, dann sieht das im DXL so aus
1. Attachment
--- Zitat ---<attachmentref name='2nd.jpg' displayname='2nd.jpg'><picture
height='47px' width='43px'><notesbitmap>
--- Ende Zitat ---
2. Attachment, gleicher Dateiname
--- Zitat ---<attachmentref name='ATT5OTO6' displayname='2nd.jpg'><picture
height='47px' width='43px'><notesbitmap>
--- Ende Zitat ---
Verwendet man nun n-Mal den Tag <<RT:RTONE>>, dann werden auch diese Informationen dupliziert.
Das wäre soweit nicht weiter schlimm, wenn der DXLIMporter das merken würde und die
<attachmentref name='ATTxxxxxx> entsprechend selber anpassen würde. Tut er aber nicht. Das Ding ist dumm wie Brot und importiert daß, was man ihm vorsetzt; Hauptsache Well-Formed.
Probleme bekommt man dann, wenn man im Nachhinein eins der doppelten Attachments mit gleicher <attachmentref name='ATT bearbeitet. PENG !!!
Man kann jetzt sagen, OK, dann darf es halt keine doppelten Platzhalter geben. Aber daß Problem tritt auch dann auf, wenn man ( wie es in !!HELP!! beabsichtigt ist )
<<RT:RTONE>>
<<RT:RTTWO>>
verwendet, wobei RTONE und RTTWO aus unterschiedlichen Dokumenten kommen, aber durchaus das gleiche Attachment haben können ( nicht müssen )
Also muss man, nachdem das komplette XML im RT zusammengebastelt ist, <attachmentref name='ATTxxxxx und die dazugehörenden DisplayName - Tags unique machen.
Das ist noch eine Menge Arbeit, ist aber nicht unlösbar ( NotesRichTextNavigator und NotesRichTextRange )
Ich denke, daß es mit DXL im Backend eine Menge Möglichkeiten gibt. Solange es nicht zeitkritisch ist.
Schön ist auch, daß man im DXl mal sieht, wie so ein RT-Field intern "tickt".
Allerdings suche ich noch nach Informationen, wie man den DXLImporter ein wenig mehr detailliertere Informationen entlockt als ewig die gleiche monotone Fehlermeldung, wenn das XML nicht well-formed ist.
flaite:
Hi,
kannst du vielleicht einfach mal eine Beispieldatenbank posten?
Oder kann ich einfach meine HELP Version nehmen, deinen Agenten da rein pasten und dann bestimmte Felder mit bestimmten Werten füllen?
--- Zitat ---Allerdings suche ich noch nach Informationen, wie man den DXLImporter ein wenig mehr detailliertere Informationen entlockt als ewig die gleiche monotone Fehlermeldung, wenn das XML nicht well-formed ist.
--- Ende Zitat ---
Nicht normal. Aus allen mir bekannten xml Parsern bekommt man die Zeilen/Spaltennummer bzgl. wo es nicht well formed ist.
Navigation
[0] Themen-Index
[#] Nächste Seite
[*] Vorherige Sete
Zur normalen Ansicht wechseln