HCL Notes / Domino / Diverses > Entwicklung

Richtext Inhalt an Webserver übergeben?

<< < (2/2)

schroederk:
Ich habe leider noch Probleme mit der Authentifizierung.

Ich habe es mit

--- Code: ---obj.open "GET", url, False, "username", "password"
--- Ende Code ---
probiert, aber ohne Erfolg. Es wird die Login-Maske des Servers zurückgeliefert.

Auch ein

--- Code: ---obj.setRequestHeader "Username", "username"
obj.setRequestHeader "Password", "password"

--- Ende Code ---
brachte nicht den erhofften Erfolg.

Noch jemand eine Idee?

schroederk:
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:


--- 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

--- Ende Code ---

schroederk:
Ich habe (endlich eine nutzbare Lösung gefunden.
Letztlich benutze ich die erste Lösung von Thorsten und hole mir den ganzen Text. Dabei bekomme ich auch die Bilder, wenn auch erstmal als Broken Link.
Die URLs der Bilder extrahiere ich und rufe dann die den Agent mit dieser URL nochmal auf. Dieser liefert mir jetzt das Bild.
Ich muss noch prüfen, ob es sich wirklich um ein Bild handelt und nicht vielleicht auch um irgendein Attachment, aber vielen Dank für die Unterstützung.  :knuddel:

Navigation

[0] Themen-Index

[*] Vorherige Sete