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.


The biggest plugin in space...