Hallo,
Ich habe eine recht einfache Notes-Datenbank, die nur zwei benötigte Felder enthält: Subject und Body. Dabei kann in einem Dokument das Body-Feld vom Typ Rich Text mehrfach vorkommen.
Auf das Body-Feld kann ich über den Browser einfach zugreifen und der Inhalt wird inklusive Bilder, Umbrüche und Text-Stile korrekt dargestellt:
https://mailserver/datenbank.nsf/All Documents/Eindeutiger-Titel/Body?OpenField
Wenn ich den Inhalt aber versuche über PHP und cUrl abrufen möchte, erhalte ich die Fehlermeldung: Unknown or unsupported protocol version
Der Aufruf eines Agenten in derselben Datenbank funktioniert mit demselben Code ohne Probleme.
Daher habe ich es mit einem Agenten versucht, scheitere aber wohl an meinen bescheidenen Programmierkenntnissen für Lotusscript. Das Print rtitem funktioniert nicht wegen "Type mismatch".
Außerdem sucht mein Script nach allen Richtext-Feldern, nicht nur nach Body (auch wenn bei mir sicher nur das Body-Feld vom Typ Richtext ist.
Wie kann ich den den kompletten Body (alle Body-Felder) inklusive der Text-Stile und der Bilder ausgeben, entweder als html oder gerne auch als RTF?
Set view = db.GetView("All Documents")
Set doc = view.Getfirstdocument()
While Not(doc Is Nothing)
If doc.Subject(0) = subject Then
ForAll item In doc.Items
If item.Type = RICHTEXT Then
Set rtitem = item.GetUnformattedText()
Print rtitem
End If
End ForAll
End If
Set doc = view.GetNextDocument(doc)
Wend
Dafür gibt es eine ganz einfache Methode:
Set rtitem = docCalProfile.Getfirstitem("Body")
html = rtitem .Converttohtml()
Dafür gibt es eine ganz einfache Methode:
Set rtitem = docCalProfile.Getfirstitem("Body")
html = rtitem .Converttohtml()
Vielen Dank, damit bekomme ich schonmal den Text-Inhalt, aber kann ich auch die Bilder bekommen? Diese werden mir als Broken Link angezeigt.
Ich habe versucht, die Images als EmbeddedObjects zu holen und direkt in den HTML-Code zu packen, bekomme aber einen Type Mismatch in der ForAll-Zeile.
While Not(doc Is Nothing)
If doc.Subject(0) = subject Then
Set rtitem = doc.Getfirstitem("Body")
htmlContent = htmlContent & rtitem.Converttohtml()
If rtitem.Type = RICHTEXT Then
ForAll o In rtitem.EmbeddedObjects
If o.Type = EMBED_ATTACHMENT Then
imageTag = "<img src='data:image/png;base64," & o.GetEncodedObject() & "' />"
htmlContent = htmlContent & imageTag
End If
End ForAll
Print htmlContent
End If
End If
Set doc = view.GetNextDocument(doc)
Wend
https://stackoverflow.com/questions/1880511/how-to-export-rich-text-fields-as-html-from-notes-with-lotusscript
Die Idee mit dem GetHtmlFromField werde ich mal testen. Ist zwar ein wenig "von hinten durch die Brust ins Auge", aber auch schlank und schick ;) , wenn es funktioniert.
Function GetHtmlFromField(doc As NotesDocument, fieldname As String) As String
Dim obj
Set obj = CreateObject("Microsoft.XMLHTTP")
obj.open "GET", "http://www.mydomain.dk/database.nsf/0/" + doc.Universalid + "/" + fieldname + "?openfield&charset=utf-8", False, "", ""
obj.send("")
Dim html As String
html = Trim$(obj.responseText)
GetHtmlFromField = html
End Function
Ich habe es mit
obj.open "GET", url, False, "username", "password"
Auch ein
obj.setRequestHeader "Username", "username"
obj.setRequestHeader "Password", "password"
Noch jemand eine Idee?
Jetzt habe ich wohl das Authentifizierungsproblem gelöst, stehe dann aber wieder genau am Anfang, denn auch hier werden mir jetzt die Grafiken als Broken Links angezeigt.
Kopiere ich die Grafikadresse und kopiere sie in einen Browser-Tab, bekomme ich ein "Object not found'.
Hier der bisherige Code:
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim view As NotesView
Dim arg As String
Dim qs As String
Dim argarray As Variant
Dim subject As String
Dim rtitem As NotesRichTextItem
Dim htmlContent As String
Dim imageData As Variant
Dim imagebase64 As String
Dim imageTag As String
Dim NotesEmbeddedObject As NotesEmbeddedObject
Dim stream As NotesStream
On Error GoTo ErrHandler
Set doc = s.DocumentContext
qs = doc.query_string(0)
arg = urlDecode(qs)
argarray = Split(arg,"&")
subject = argarray(1)
Set db = s.GetDatabase("Mailserver/Firma, "knowledgebase.nsf", False)
If Not db.IsOpen Then Call db.Open("", "")
Set view = db.GetView("All Documents")
Set doc = view.Getfirstdocument()
While Not(doc Is Nothing)
If doc.Subject(0) = subject Then
htmlContent = GetHtmlFromField(doc, "Body")
Print htmlContent
End If
Set doc = view.GetNextDocument(doc)
Wend
ErrResume:
Exit Sub
ErrHandler:
Print "** GetDocument ** Error occured " & Str(Err) & ": " & Error$ & " in line " & Str(Erl) & ". Agent stopped."
Resume ErrResume
End Sub
Public Function urlDecode(s As String) As String
If Len(s) = 0 Then Exit Function
Dim i As Integer
Dim tmp As String
Dim c As String
For i = 1 To Len(s)
c = Mid$(s, i, 1)
If c = "+" Then c = " "
If c = "%" Then
c = Chr$("&H" + Mid$(s, i + 1, 2))
i = i + 2
End If
tmp = tmp + c
Next i
urlDecode = tmp
End Function
Function GetHtmlFromField(doc As NotesDocument, fieldname As String) As String
Dim obj
Dim url As String
Set obj = CreateObject("Microsoft.XMLHTTP")
url = "https://mailserver.de/knowledgebase.nsf/0/" + doc.Universalid + "/" + fieldname + "?openfield&charset=utf-8"
obj.open "GET", url, False
obj.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
obj.setRequestHeader "Authorization", "Basic " & Base64Encode("benutzername", "kennwort")
obj.send("")
Dim html As String
html = Trim$(obj.responseText)
GetHtmlFromField = html
End Function
Function Base64Encode(User As String, Password As String) As String
Dim session As New NotesSession
Dim stream As NotesStream
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim body As NotesMIMEEntity
Set stream = session.CreateStream
Call stream.WriteText (User & ":" & Password)
Set db = session.CurrentDatabase
Set doc = db.CreateDocument
Set body = doc.CreateMIMEEntity
Call body.SetContentFromText (stream, "", ENC_NONE)
Call body.EncodeContent (ENC_BASE64)
Base64Encode = body.ContentAsText
Base64Encode = Replace(Replace(Base64Encode, Chr(13), ""), Chr(10),"")
Call stream.Close
Delete doc
Exit Function
End Function