Platforms to show: All Mac Windows Linux Cross-Platform
/CURL/Receive Email/Email Viewer
Required plugins for this example: MBS CURL Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /CURL/Receive Email/Email Viewer
This example is the version from Sat, 2nd Oct 2015.
Project "Email Viewer.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control LoadButton Inherits PushButton
ControlInstance LoadButton Inherits PushButton
EventHandler Sub Action()
dim f as FolderItem = GetOpenFolderItem(FileTypes1.All)
if f = nil then Return
load f
End EventHandler
End Control
Control HeaderList Inherits Listbox
ControlInstance HeaderList Inherits Listbox
End Control
Control RecipientsList Inherits Listbox
ControlInstance RecipientsList Inherits Listbox
End Control
Control PopupAttachment Inherits PopupMenu
ControlInstance PopupAttachment Inherits PopupMenu
EventHandler Sub Change()
SaveButton.Enabled = me.ListIndex >= 0
End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control PlainText Inherits TextArea
ControlInstance PlainText Inherits TextArea
End Control
Control HTMLText Inherits HTMLViewer
ControlInstance HTMLText Inherits HTMLViewer
End Control
Control SaveButton Inherits PushButton
ControlInstance SaveButton Inherits PushButton
EventHandler Sub Action()
if PopupAttachment.ListIndex = -1 then Return
dim a as MimeAttachmentMBS = PopupAttachment.RowTag(PopupAttachment.ListIndex)
if a = nil then Return
dim f as FolderItem = GetSaveFolderItem("", a.Filename)
if f = nil then Return
dim b as BinaryStream = BinaryStream.Create(f, true)
b.Write a.data
b.Close
Exception io as IOException
MsgBox "Failed to write file."+EndOfLine+EndOfLine+io.message
End EventHandler
End Control
Control Subject Inherits TextField
ControlInstance Subject Inherits TextField
End Control
Sub Add(label as string, list as MimeAddressListMBS)
if list = nil then Return
for each a as MimeAddressMBS in list.Addresses
if a.isGroup then
Add label, a.Group
else
Add label, a.Mailbox
end if
next
End Sub
Sub Add(label as string, g as MimeGroupMBS)
if g = nil then Return
dim emails() as string
for each m as MimeMailboxMBS in g.Mailboxes
emails.Append m.Email
next
RecipientsList.AddRow "to", g.NameDecoded, Join(emails, ", ")
End Sub
Sub Add(label as string, list as MimeMailboxListMBS)
if list = nil then Return
for each m as MimeMailboxMBS in list.Mailboxes
Add label, m
next
End Sub
Sub Add(label as string, m as MimeMailboxMBS)
if m = nil then Return
RecipientsList.AddRow label, m.LabelDecoded, m.Email
End Sub
Sub ShowHTML(e as MimeEmailMBS)
dim HTML as string = e.HTMLText
// patch html with charset = UTF-8 if needed
if html.Encoding = encodings.UTF8 then
dim p as integer = instr(HTML, "<head>")
if p > 0 then
HTML = ReplaceAll(HTML, "<head>", "<head><meta charset=""utf-8"" />")
end if
end if
// not the best way
// but to write in temp folder the inlines and referencing them in html works
dim tmpfolder as FolderItem = SpecialFolder.Temporary.Child("temp email viewer "+str(rnd*1000000,"000000"))
tmpfolder.CreateAsFolder
for each a as MimeAttachmentMBS in e.Inlines
dim Filename as string = a.Filename
Filename = ConvertEncoding(Filename, encodings.ASCII)
Filename = ReplaceAll(Filename, " ", "_")
Filename = ReplaceAll(Filename, "?", "_")
Filename = ReplaceAll(Filename, ":", "_")
dim f as FolderItem = tmpfolder.Child(Filename)
dim b as BinaryStream = BinaryStream.Create(f, true)
b.Write a.Data
dim ID as string = a.contentId
if id.Left(1) = "<" then
id = mid(id,2)
end if
if id.Right(1) = ">" then
id = left(id, len(id)-1)
end if
html = Replace(html, "cid:"+id, Filename)
next
// now write html and load it
dim f as FolderItem = tmpfolder.Child("email.html")
dim b as BinaryStream = BinaryStream.Create(F, true)
b.Write HTML
HTMLText.LoadPage f
End Sub
Sub load(f as FolderItem)
// clear
HeaderList.DeleteAllRows
RecipientsList.DeleteAllRows
PlainText.Text = ""
Subject.Text = ""
PopupAttachment.DeleteAllRows
// parse
dim e as MimeEmailMBS
try
e = new MimeEmailMBS(f)
catch ex as runtimeException
// a few things could go wrong
MsgBox Introspection.GetType(ex).fullname+EndOfLine+EndOfLine+ex.message
end try
Subject.Text = e.Subject
PlainText.Text = e.PlainText
if e.Date <> nil then
HeaderList.AddRow "Date parsed", e.Date.SQLDateTime
end if
dim h as MimeHeaderMBS = e.Header
for each ff as MimeFieldMBS in h.Fields
HeaderList.AddRow ff.Name, ff.Value
next
Add "from", h.from
Add "to", h.too
Add "cc", h.cc
Add "bcc", h.bcc
Add "replyto", h.replyto
Add "sender", h.sender
dim Attachments() as MimeAttachmentMBS = e.Attachments
dim Inlines() as MimeAttachmentMBS = e.Inlines
for each a as MimeAttachmentMBS in Attachments
PopupAttachment.AddRow a.Filename
PopupAttachment.RowTag(PopupAttachment.ListCount-1) = a
next
if TargetMacOS and Inlines.ubound >= 0 and Attachments.ubound >= 0 then
PopupAttachment.AddSeparator
end if
for each a as MimeAttachmentMBS in Inlines
PopupAttachment.AddRow a.Filename
PopupAttachment.RowTag(PopupAttachment.ListCount-1) = a
next
PopupAttachment.Enabled = True
ShowHTML e
End Sub
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
FileTypes1
Filetype text/email
Filetype text/plain
End FileTypes1
End Project
See also:
The items on this page are in the following plugins: MBS CURL Plugin.