Platforms to show: All Mac Windows Linux Cross-Platform

/CURL/Receive Email/CURLS email client


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/CURLS email client

This example is the version from Wed, 3rd Jan 2023.

Project "CURLS email client.xojo_binary_project"
FileTypes
Filetype text
End FileTypes
Class Window1 Inherits Window
Control Server Inherits TextField
ControlInstance Server Inherits TextField
End Control
Control Username Inherits TextField
ControlInstance Username Inherits TextField
End Control
Control Passwort Inherits TextField
ControlInstance Passwort Inherits TextField
End Control
Control ResultText Inherits Label
ControlInstance ResultText Inherits Label
End Control
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub Change() if me.ListIndex >= 0 then dim e as MimeEmailMBS = me.RowTag(me.ListIndex) ShowEmail e else ClearEmail end if End EventHandler
End Control
Control DebugText Inherits TextArea
ControlInstance DebugText Inherits TextArea
End Control
Control RadioPOP3 Inherits RadioButton
ControlInstance RadioPOP3 Inherits RadioButton
End Control
Control RadioIMAP Inherits RadioButton
ControlInstance RadioIMAP Inherits RadioButton
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
Control MailButton Inherits PushButton
ControlInstance MailButton Inherits PushButton
EventHandler Sub Action() if server.Text.len = 0 then MsgBox "please enter a server!" Return end if QueryList End EventHandler
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action() CurlMulti.Perform End EventHandler
End Control
EventHandler Sub Open() CurlMulti = new MyCURLSMulti End EventHandler
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 ClearEmail() HeaderList.DeleteAllRows RecipientsList.DeleteAllRows PlainText.Text = "" Subject.Text = "" PopupAttachment.DeleteAllRows PopupAttachment.Enabled = False SaveButton.Enabled = False End Sub
Sub QueryList() MailButton.Enabled = False List.DeleteAllRows ClearEmail redim EmailsToQuery(-1) // imap dim curl as new MyCURL // ask for TLSv1.2 curl.OptionSSLVersion = curl.kSSLVersionTLSv12 curl.OptionUseSSL = curl.kUseSSLall If RadioIMAP.Value Then curl.imap = True curl.OptionURL = "imap://"+Server.Text+"/INBOX" curl.OptionCustomRequest = "FETCH 1:* FLAGS" Elseif RadioPOP3.Value Then curl.pop3 = true curl.OptionURL = "pop3://"+Server.Text+"/" else Break Return end if curl.OptionUsername = Username.Text curl.OptionPassword = Passwort.Text AddHandler curl.Finished, WeakAddressOf QueryListFinished call CurlMulti.AddCURL curl End Sub
Sub QueryListFinished(c as MyCURL, Result as Integer) // show debug info dim s as string = c.DebugMessages if s.Encoding = nil then s = DefineEncoding(s, encodings.ISOLatin1) end if s = ReplaceLineEndings(s, EndOfLine) DebugText.Text = s // problem? if result <> 0 then MailButton.Enabled = true MsgBox "CURL Error code: "+str(result) Return end if // parse list dim content as string = c.OutputData if content.Encoding = nil then content = DefineEncoding(content, encodings.ISOLatin1) end if content = ReplaceLineEndings(content, EndOfLine) EmailsToQuery = Split(content, EndOfLine) QueryNextEmail End Sub
Sub QueryNextEmail() if EmailsToQuery.Ubound = -1 then Return // done dim EmailID as string = EmailsToQuery.pop EmailID = trim(EmailID) if EmailID = "" then QueryNextEmail Return end if dim curl as new MyCURL // ask for TLSv1.2 curl.OptionSSLVersion = curl.kSSLVersionTLSv12 curl.OptionUseSSL = curl.kUseSSLall if RadioIMAP.Value then // * 6 FETCH (FLAGS (\Seen)) if left(EmailID,2) = "* " then // ok EmailID = NthField(EmailID, " ", 2) else break // unexpected? Return end if // imap curl.OptionURL = "imap://"+Server.Text+"/INBOX;UID="+EmailID elseif RadioPOP3.Value then EmailID = NthField(EmailID, " ", 1) curl.OptionURL = "pop3://"+Server.Text+"/"+EmailID else Break Return end if curl.OptionUsername = Username.Text curl.OptionPassword = Passwort.Text AddHandler curl.Finished, WeakAddressOf QueryNextEmailFinished call CurlMulti.AddCURL curl End Sub
Sub QueryNextEmailFinished(c as MyCURL, Result as Integer) // show debug info dim s as string = c.DebugMessages if s.Encoding = nil then s = DefineEncoding(s, encodings.ISOLatin1) end if s = ReplaceLineEndings(s, EndOfLine) DebugText.Text = s // problem? if result <> 0 then MailButton.Enabled = true MsgBox "CURL Error code: "+str(result) Return end if QueryNextEmail dim content as string = c.OutputData // parse dim e as MimeEmailMBS try e = new MimeEmailMBS(content) List.AddRow e.FromLabel, e.ToLabel, e.Subject List.RowTag(List.LastIndex) = e catch ex as runtimeException // a few things could go wrong MsgBox Introspection.GetType(ex).fullname+EndOfLine+EndOfLine+ex.message return end try End Sub
Sub ShowEmail(e as MimeEmailMBS) // clear ClearEmail if e = nil then Return Subject.Text = e.Subject PlainText.Text = e.PlainText 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 ShowHTML e PopupAttachment.Enabled = True 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
Property CurlMulti As MyCURLSMulti
Property EmailsToQuery() As string
End Class
MenuBar MenuBar1
MenuItem UntitledMenu1 = ""
MenuItem FileMenu = "&File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu5 = ""
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "Clear"
MenuItem UntitledMenu4 = ""
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = ""
End MenuBar
Class App Inherits Application
End Class
Class MyCURLSMulti Inherits CURLSMultiMBS
End Class
Class MyCURL Inherits CURLSMBS
Sub Constructor() me.YieldTime = true me.OptionVerbose = true me.CollectDebugMessages = true me.CollectOutputData = true End Sub
Property EmailID As string
Property imap As Boolean
Property pop3 As Boolean
End Class
Module UtilityModule
Function FromLabel(extends e as MimeEmailMBS) As string dim h as MimeHeaderMBS = e.Header dim f as MimeMailboxListMBS = h.from if f <> nil then dim Mailboxes() as MimeMailboxMBS = f.Mailboxes for each m as MimeMailboxMBS in Mailboxes dim l as string = m.LabelDecoded if l = "" then l = m.Email end if return l next end if End Function
Function ToLabel(extends e as MimeEmailMBS) As string dim h as MimeHeaderMBS = e.Header dim f as MimeAddressListMBS = h.too dim parts() as string if f <> nil then dim Addresses() as MimeAddressMBS = f.Addresses for each a as MimeAddressMBS in Addresses dim g as MimeGroupMBS = a.Group if g <> nil then parts.Append g.NameDecoded else dim m as MimeMailboxMBS = a.Mailbox if m <> nil then dim s as string = m.LabelDecoded if s = "" then s = m.Email end if parts.Append s end if end if next end if Return Join(parts, ", ") End Function
End Module
End Project

See also:

The items on this page are in the following plugins: MBS CURL Plugin.


The biggest plugin in space...