Just for a bit of variety (it's very old and therefore not well written)...
;********************************************************************************************
;*** Blitz Mail Library
;*** Yan 2001 - yan@...
;********************************************************************************************
;Updated (well, hacked at) 03/12/04 - Fixed multi Line response bug.
; Added Base64 decoder and Login stuff.
SeedRnd MilliSecs()
Type html_image
Field filename$, cid$, idata$
End Type
Type inc_data
Field filename$, idata$
End Type
; Sends the processed mail.
; mailfrom$ = A string holding the senders mail address
; fromname$ = A string holding the senders name
; mailto$ = A string holding the recipients mail address
; toname$ = A string holding the recipients name - optional
; subject$ = A string holding the subject of the mail
; body$ = A string holding the processed MIME mail
; mailhost$ = A string holding the servers IP address or DNS (SMTP / ESMTP)
; username$ = A string holding the account username
; userpass$ = A string holding the account password
; This function returns a string containing 'success' if successful or an error message if not
Function send_mail$ (mailfrom$, fromname$, mailto$, toname$ = "", subject$, body$, mailhost$, username$="", userpass$="")
Local host, code$, resp$, err$ = "Success", qt$ = Chr$(34)
If toname$ = "" Then toname$ = mailto$
host = OpenTCPStream(mailhost$, 25)
If host
resp$ = ReadLine(host)
code$ = Left$(resp$, 3)
If code$ = "220"
While Left$(resp$, 4) = "220-"
resp$ = ReadLine(host)
Wend
WriteLine(host, "EHLO Blitz Mail Library")
resp$ = ReadLine(host)
If Left$(resp$, 3) = "250"
While Left$(resp$, 4) = "250-"
resp$ = ReadLine(host)
Wend
If Left$(resp$, 3) = "250"
WriteLine(host, "AUTH LOGIN")
resp$ = ReadLine(host)
While Left$(resp$, 3) = "334"
If Instr(Lower$(base64_dec$(Right$(resp$, Len(resp$) - 4))), "username:") > 0
WriteLine(host, base64_enc$(username$, 0))
resp$ = ReadLine(host)
ElseIf Instr(Lower$(base64_dec$(Right$(resp$, Len(resp$) - 4))), "password:") > 0
WriteLine(host, base64_enc$(userpass$, 0))
resp$ = ReadLine(host)
EndIf
Wend
Else
err$ = resp$
EndIf
Else
WriteLine(host, "HELO Blitz Mail Library")
resp$ = ReadLine(host)
EndIf
If (Left$(resp$, 3) = "250") Or (Left$(resp$, 3) = "235")
WriteLine(host, "MAIL FROM: <" + mailfrom$ + ">")
resp$ = ReadLine(host)
code$ = Left$(resp$, 3)
If code$ = "250"
WriteLine(host, "RCPT TO: <" + mailto$ + ">")
resp$ = ReadLine(host)
code$ = Left$(resp$, 3)
If code$ = "250"
WriteLine(host, "DATA")
resp$ = ReadLine(host)
If Left$(resp$, 3) = "354"
WriteLine(host, "From: " + qt$ + mailname$ + qt$ + " <" + mailfrom$ + ">")
WriteLine(host, "To: " + qt$ + toname$ + qt$ + " <" + mailto$ + ">")
WriteLine(host, "Subject: " + subject$)
WriteLine(host, "X-Mailer: Blitz Mail Library v1.01")
WriteLine(host, body$)
WriteLine(host, ".")
resp$ = ReadLine(host)
If Left$(resp$, 3) = "250"
WriteLine(host, "QUIT")
resp$ = ReadLine(host)
If Left$(resp$, 3) <> "221"
err$ = resp$
EndIf
Else
err$ = resp$
EndIf
Else
err$ = resp$
EndIf
Else
If code$ = "501"
err$ = "Email recipient not specified (or invalid address)"
Else
err$ = resp$
EndIf
EndIf
Else
If code$ = "501"
err$ = "Email sender not specified (or invalid address)"
Else
err$ = resp$
EndIf
EndIf
Else
err$ = resp$
EndIf
Else
If code$ = "421"
err$ = "Service not available"
Else
err$ = resp$
EndIf
EndIf
CloseTCPStream host
If err$ = "" Then err$ = "Timeout error"
Return err$
Else
Return "Failed to connect to server " + "'" + mailhost$ + "'"
EndIf
Return err$
End Function
; Encodes the processed HTML text and/or plain text into MIME format
; html$ = A string holding the processed HTML text - optional
; plain$= A string holding the plain text - optional
; This function returns a string containing the MIME mail body text
;
; You're probably wondering why BOTH of the parameters are optional?
; If you wanted to send a blank mail with just an attachment.
; You still need to run this function to MIME encode the attachment - build_mime$()
Function build_mime$(html$="", plain$="")
Local out$, nl$ = Chr$(13) + Chr$(10), qt$ = Chr$(34)
Local bound$ = "=_PART_00_" + unique()
Local bound1$ = "=_PART_01_" + unique()
Local bound2$ = "=_PART_02_" + unique()
If plain$ = "" And html$ <> ""
plain$ = "This is a HTML mail. Your mail app may not be able to display the main body of this mail."
EndIf
out$ = out$ + "MIME-Version: 1.0" + nl$
out$ = out$ + "Content-Type: multipart/mixed;" + nl$ + Chr$(9)
out$ = out$ + "boundary=" + qt$ + bound$ + qt$ + nl$ + nl$
out$ = out$ + "This is a MIME encoded message" + nl$ + nl$
out$ = out$ + "--" + bound$ + nl$
If html$ <> ""
If First html_image = Null
out$ = out$ + "Content-Type: multipart/alternative;" + nl$ + Chr$(9)
out$ = out$ + "boundary=" + qt$ + bound1$ + qt$ + nl$ + nl$ + nl$
out$ = out$ + "--" + bound1$ + nl$
out$ = out$ + "Content-Type: text/plain; charset=" + qt$ + "iso-8859-1" + qt$ + nl$
out$ = out$ + "Content-Transfer-Encoding: quoted-printable" + nl$ + nl$
out$ = out$ + qp_enc$(plain$) + nl$
out$ = out$ + "--" + bound1$ + nl$
out$ = out$ + "Content-Type: text/html; charset=" + qt$ + "iso-8859-1" + qt$ + nl$
out$ = out$ + "Content-Transfer-Encoding: quoted-printable" + nl$ + nl$
out$ = out$ + html$ + nl$
Else
out$ = out$ + "Content-Type: multipart/related;" + nl$ + Chr$(9)
out$ = out$ + "boundary=" + qt$ + bound1$ + qt$ + nl$ + nl$ + nl$
out$ = out$ + "--" + bound1$ + nl$
out$ = out$ + "Content-Type: multipart/alternative;" + nl$ + Chr$(9)
out$ = out$ + "boundary=" + qt$ + bound2$ + qt$ + nl$ + nl$ + nl$
out$ = out$ + "--" + bound2$ + nl$
out$ = out$ + "Content-Type: text/plain; charset=" + qt$ + "iso-8859-1" + qt$ + nl$
out$ = out$ + "Content-Transfer-Encoding: quoted-printable" + nl$ + nl$
out$ = out$ + qp_enc$(plain$) + nl$
out$ = out$ + "--" + bound2$ + nl$
out$ = out$ + "Content-Type: text/html; charset=" + qt$ + "iso-8859-1" + qt$ + nl$
out$ = out$ + "Content-Transfer-Encoding: quoted-printable" + nl$ + nl$
out$ = out$ + html$ + nl$
out$ = out$ + "--" + bound2$ + "--" + nl$ + nl$
For image.html_image=Each html_image
out$ = out$ + "--" + bound1$ + nl$
out$ = out$ + "Content-Type: image/" + Right$(image.html_image\filename$, 3)
out$ = out$ + "; name=" + qt$ + image.html_image\filename$ + qt$ + nl$
out$ = out$ + "Content-Transfer-Encoding: base64" + nl$
out$ = out$ + "Content-ID: <" + image.html_image\cid$ + ">" + nl$ + nl$
out$ = out$ + image.html_image\idata$ + nl$
Next
EndIf
out$ = out$ + "--" + bound1$ + "--" + nl$ + nl$
Else
out$ = out$ + "Content-Type: text/plain;" + nl$ + nl$
out$ = out$ + "Content-Transfer-Encoding: quoted-printable" + nl$
out$ = out$ + qp_enc$(plain$) + nl$
EndIf
If First inc_data <> Null
For inc.inc_data=Each inc_data
out$ = out$ + "--" + bound$ + nl$
out$ = out$ + "Content-Type: application/octete-stream"
out$ = out$ + "; name=" + qt$ + inc.inc_data\filename$ + qt$ + nl$
out$ = out$ + "Content-Transfer-Encoding: base64" + nl$
out$ = out$ + "Content-Disposition: attachment; filename=" + qt$ + inc.inc_data\filename$ + qt$ + nl$ + nl$
out$ = out$ + inc.inc_data\idata$ + nl$
Next
EndIf
out$ = out$ + "--" + bound$ + "--" + nl$
Delete Each html_image
Delete Each inc_data
Return out$
End Function
; Converts an external file into a string
; inp$ = A string containing the filepath to the required file
; This function returns a string containing the files data
Function file_to_string$(inp$)
Local file, out$
file = ReadFile(inp$)
If (Not file) Then RuntimeError "Couldn't open '" + inp$ + "' for encoding."
Repeat
out$ = out$ + Chr$(ReadByte(file))
Until Eof(file)
CloseFile(file)
Return out$
End Function
; Encodes files as attachments
; file$ = A string containing the filepath to the required file
Function process_include$(file$)
inc.inc_data = New inc_data
inc.inc_data\filename$ = file$
inc.inc_data\idata$ = base64_enc$(file_to_string$(file$))
End Function
; Scans the HTML string loads and encodes any images and replaces their filename with a ContentIDentifier
; inp$ = A string containing the HTML text
; dir$ = A string containing the path to the original HTML file - optional (if the HTML file is in the same directory
; as your code)
; This function returns a string containing the processed HTML text
Function process_html$(inp$, dir$="")
Local out$ = inp$, img$, ifrom, ito = 1, fnd
If dir$ <> "" And Right$(dir$, 1) <> "" Then dir$ = dir$ + ""
Repeat
ifrom = Instr(Lower$(inp$), "<img", ito)
If ifrom
ifrom = Instr(Lower$(inp$), "src", ifrom + 4) + 3
ifrom = Instr(Lower$(inp$), Chr$(34), ifrom) + 1
ito = Instr(Lower$(inp$), Chr$(34), ifrom)
fnd = False
For image.html_image=Each html_image
If image.html_image\filename$ = Mid$(inp$, ifrom, ito - ifrom) Then fnd = True
Next
If (Not fnd)
image.html_image = New html_image
image.html_image\filename$ = Mid$(inp$, ifrom, ito - ifrom)
image.html_image\cid$ = unique$()
image.html_image\idata$ = base64_enc$(file_to_string$(dir$ + image.html_image\filename$))
out$ = Replace$(out$, image.html_image\filename$, "cid:" + image.html_image\cid$)
EndIf
EndIf
Until (Not ifrom)
Return qp_enc$(out$)
End Function
; Encodes a string using the base64 algorithm
; inp$ = A string containing the data to be encoded
; add_nl = 1 - adds a newline seguence at the end of the encoded string, 0 - no newline (if string is < 76 chars)
; This function returns a string containing the encoded data
; You shouldn't need to call this directly. But feel free.
Function base64_enc$(inp$, add_nl=1)
Local b64_enc$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Local nl$ = Chr$(13) + Chr$(10)
Local out$, trp$, char, i = 1
Repeat
trp$ = Mid$(inp$, i, 3)
Select Len(trp$)
Case 3
out$ = out$ + Mid$(b64_enc$, (Asc(Mid$(trp$, 1, 1)) Shr 2) + 1, 1)
out$ = out$ + Mid$(b64_enc$, (((Asc(Mid$(trp$, 1, 1)) Shl 4) Or (Asc(Mid$(trp$, 2, 1)) Shr 4)) And $3f) + 1, 1)
out$ = out$ + Mid$(b64_enc$, (((Asc(Mid$(trp$, 2, 1)) Shl 2) Or (Asc(Mid$(trp$, 3, 1)) Shr 6)) And $3f) + 1, 1)
out$ = out$ + Mid$(b64_enc$, (Asc(Mid$(trp$, 3, 1)) And $3f) + 1, 1)
Case 2
out$ = out$ + Mid$(b64_enc$, (Asc(Mid$(trp$, 1, 1)) Shr 2) + 1, 1)
out$ = out$ + Mid$(b64_enc$, (((Asc(Mid$(trp$, 1, 1)) Shl 4) Or (Asc(Mid$(trp$, 2, 1)) Shr 4)) And $3f) + 1, 1)
out$ = out$ + Mid$(b64_enc$, ((Asc(Mid$(trp$, 2, 1)) Shl 2) And $3f) + 1, 1)
out$ = out$ + "="
Case 1
out$ = out$ + Mid$(b64_enc$, (Asc(Mid$(trp$, 1, 1)) Shr 2) + 1, 1)
out$ = out$ + Mid$(b64_enc$, ((Asc(Mid$(trp$, 1, 1)) Shl 4) And $3f) + 1, 1)
out$ = out$ + "=="
End Select
i = i + 3
char = char + 4
If char = 76
out$ = out$ + nl$
char = 0
EndIf
Until i > Len(inp$)
If char And add_nl Then out$ = out$ + nl$
Return out$
End Function
; Decodes a string that's been encoded with the base64 algorithm
; inp$ = A string containing the encoded data
; This function returns a string containing the decoded data
; You shouldn't need to call this directly. But feel free.
Function base64_dec$(inp$)
Local b64_enc$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Local out$, oct, i = 1, qc, char
Repeat
char = Instr(b64_enc$, Mid$(inp$, i, 1))
If char > 0
If char = 65 Then char = 1
oct = (oct Shl 6) Or ((char - 1) And $3f)
qc = qc + 1
EndIf
If qc = 4
out$ = out$ + Chr$((oct Shr 16) And $ff) + Chr$((oct Shr 8) And $ff) + Chr$(oct And $ff)
oct = 0
qc = 0
EndIf
i = i + 1
Until i > Len(inp$)
Return out$
End Function
; Encodes a string using the quoted printable algorithm
; inp$ = A string containing the text to be encoded
; This function returns a string containing the encoded text
; You shouldn't need to call this directly. But feel free.
Function qp_enc$(inp$)
Local qp_asc$ = Chr$(9) + " !#$%&'()*+,-./0123456789:;<>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
Local nl$ = Chr$(13) + Chr$(10)
Local out$, cnt, char$, i
Repeat
i = i + 1
char$ = Mid$(inp$, i, 1)
If Instr(qp_asc$, char$)
out$ = out$ + char$
cnt = cnt + 1
Else
If Mid$(inp$, i, 2) <> nl$
If cnt > 72
out$ = out$ + "=" + nl$
cnt = 0
EndIf
out$ = out$ + "=" + Right$(Hex$(Asc(char$)), 2)
cnt = cnt + 3
Else
out$ = out$ + nl$
i = i + 1
cnt = 0
EndIf
EndIf
If cnt = 75
out$ = out$ + "=" + nl$
cnt = 0
EndIf
Until i >= Len(inp$)
If cnt Then out$ = out$ + nl$
Return out$
End Function
; Spits out a 24 digit (96 bit) random(ish) hexadecimal string
Function unique$()
Local out$, i
For i= 1 To 12
out$ = out$ + Right$(Hex$(Rand(1, 255)), 2)
Next
Return out$
End FunctionUsage example (you'll need to supply your own HTML message and attachment ZIP)...
;************************************************************************
;*** Blitz Mail Library Demo
;*** Yan 2001 - yan@...
;************************************************************************
Graphics 640, 480, 0, 2
; Add the MIME library
Include "BlitzMailInc.bb"
; Get the required parameters
name_from$ = Input$("Enter your name : ")
Repeat
mail_from$ = Input$("Enter your e-mail address : ")
Until mail_from$ <> "" And Instr(mail_from$, "@") > 0
Print
to_name$ = Input$("Enter the recipients name : ")
Repeat
to_mail$ = Input$("Enter the recipients e-mail address : ")
Until to_mail$ <> "" And Instr(to_mail$, "@") > 0
Print
subject$ = Input$("Enter subject text : ")
Print
server$ = Input$("Enter SMTP server name (default - 'mail.crosswinds.net') : ")
If server$ = "" Then server$ = "mail.crosswinds.net"
; Add 'text.zip' as an include
process_include$("text.zip")
; We're using an external file for the HTML. So, lets convert it to a string
tmp_html$ = file_to_string$("demomail2.htm")
; Lets scan the HTML string for images, load and encode them. Then insert their CID into the relevant image tags
; If the HTML was in a different directory to this code - tmp_html$ = process_html$(tmp_html$, "HTML directory")
tmp_html$ = process_html$(tmp_html$)
; Now assemble all of the data into one MIME mail complete with relevant encoding.
html$ = build_mime$(tmp_html$, "Some Plain Text incase the receiving mail client can't cope with HTML.")
; The above could have been accomplished with...
;html$ = build_mime$(process_html$(file_to_string$("demomail2.htm")), "Some Demo Text")
Print
Print "Sending Mail (for dial up networks you may have to connect manually first)"
Print
Delay 100 ; Hmmm...You need this delay to get the above text to print ???
; Now send the mail
Print send_mail$(mail_from$, name_from$, to_mail$, to_name$, subject$, html$, server$)
Print
Print "Any key to exit"
WaitKey()
End