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.