Here's my current code. It's based on Marks Blitzmail but I've added code for sending attachments.
There's probably some superfluous stuff in there.
There's probably some superfluous stuff in there.
Const debugSMTP=True Global encodestring$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ;Email Globals Global mailhost$ Global mailer$ Global mailfrom$ Global mailname$ Global mailto$ Global mode$ Global mymailserverport Global myemailaddress$ Global myname$ Global mymailserver$ Dim myaddressbook$(100,2) ; ----------------------------------------------------------------------------- ; . SMTP functions ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; BlitzMail... ; ----------------------------------------------------------------------------- Function BlitzMail$ (mailfrom$,mailto$, subject$, message$,attachpath$,attachment$) debuglog2 "Attempting to Email file...",2 error$ = "OK" debuglog2 "OPENING TCP STREAM:"+mymailserver$+ "(PORT:"+mymailserverport+")",2 t = OpenTCPStream (mymailserver$, mymailserverport) If t ; --------------------------------------------------------------------- ; Service available? ; --------------------------------------------------------------------- response$ = ReadLine (t) code$ = Code (response$) If code$ <> "220" If code$ = "421" error$ = "Service not available" debuglog2 error$,2 Else error$ = response$+ " FAILED: Expecting 220" debuglog2 error$,2 EndIf Goto abortSMTP EndIf ; --------------------------------------------------------------------- ; Say "Hi" ; --------------------------------------------------------------------- CountHostIPs("") debuglog2 "SENDING: HELO "+DottedIP$(HostIP(1)),2 WriteLine t, "HELO "+DottedIP$(HostIP(1)) response$ = ReadLine (t) If Code (response$) <> "250" error$ = response$+ " FAILED: Expecting 250" Goto abortSMTP EndIf ; --------------------------------------------------------------------- ; Non-existent command -- try it for error message! ; --------------------------------------------------------------------- ; WriteLine t, "LALA BlitzMail Deluxe" ; response$ = ReadLine (t) ; If Code (response$) <> "250" ; error$ = response$ ; Goto abortSMTP ; EndIf ; --------------------------------------------------------------------- ; Tell server who's sending ; --------------------------------------------------------------------- debuglog2 "SENDING: MAIL FROM: <" + myemailaddress$ + ">",2 WriteLine t, "MAIL FROM: <" + myemailaddress$ + ">" response$ = ReadLine (t) code$ = Code (response$) If code$ <> "250" If code$ = "501" error$ = "Email sender not specified (or invalid address)" Else error$ = response$+" FAILED: Expecting 250" EndIf Goto abortSMTP EndIf ; --------------------------------------------------------------------- ; Tell server who it's going to ; --------------------------------------------------------------------- debuglog2 "SENDING: RCPT TO: <" + mailto$ + ">",2 WriteLine t, "RCPT TO: <" + mailto$ + ">" response$ = ReadLine (t) code$ = Code (response$) If code$ <> "250" If code$ = "501" error$ = "Email recipient not specified (or invalid address)" Else error$ = response$+" FAILED: Expecting 250" EndIf Goto abortSMTP EndIf ; --------------------------------------------------------------------- ; Email data ; --------------------------------------------------------------------- debuglog2 "SENDING: DATA",2 WriteLine t, "DATA" response$ = ReadLine (t) If Code (response$) <> "354" error$ = response$+" FAILED: Expecting 345" Goto abortSMTP EndIf ; --------------------------------------------------------------------- ; Headers ; --------------------------------------------------------------------- WriteLine t,"MIME-Version: 1.0" WriteLine t, "Date: " + CurrentDate$ () WriteLine t, "From: " + mailfrom$ + " <" + myemailaddress$ + ">" WriteLine t, "To: " + mailto$ + " <" + mailto$ + ">" WriteLine t, "Subject: " + subject$ WriteLine t, "X-Mailer: " + mailer$ ; --------------------------------------------------------------------- ; Email message ; --------------------------------------------------------------------- debuglog2 "Sending Message Contents",2 WriteLine t,"Content-Type: multipart/mixed; boundary="+Chr$ (34)+"boundarystring"+Chr$(34) WriteLine t,"" WriteLine t,"--boundarystring" WriteLine t,"Content-Type: text/plain" mess=OpenFile (message$) If mess While Not Eof (mess) mbyte=ReadByte (mess) If mbyte=Asc ("#") Select ReadByte(mess) Case Asc ("1") WriteString t,mailto$ Case Asc ("2") WriteString t,mailname$ End Select Else WriteByte t,mbyte EndIf Wend CloseFile (mess) EndIf encode_file (attachpath$,attachment$,t) WriteLine t,"" WriteLine t,"--boundarystring--" debuglog2 "" debuglog2 "--boundarystring--",2 ; --------------------------------------------------------------------- ; End of message ; --------------------------------------------------------------------- WriteLine t, "" WriteLine t, "." response$ = ReadLine (t) If Code (response$) <> "250" error$ = response$ EndIf ; --------------------------------------------------------------------- ; Say "ciao" ; --------------------------------------------------------------------- WriteLine t, "QUIT" response$ = ReadLine (t) If Code (response$) <> "221" error$ = response$ EndIf ; --------------------------------------------------------------------- ; Return error message, if any ; --------------------------------------------------------------------- .abortSMTP CloseTCPStream t If error$ = "" Then error$ = "Timeout error" debuglog2 error$,2 Return error$ Else ; --------------------------------------------------------------------- ; Oops. Forgot to go online (or server isn't there) ; --------------------------------------------------------------------- debuglog2 "Failed to connect to server at " + mymailserver$,22 Return error$ EndIf End Function ; ----------------------------------------------------------------------------- ; Ask server for help (usually list of commands)... not much use, just example ; ----------------------------------------------------------------------------- Function GetHelp (server$) t = OpenTCPStream (mymailserver$, mymailserverport) If t ReadLine (t) ; 220 WriteLine t, "HELO BlitzMail Deluxe" ReadLine (t) ; 250 WriteLine t, "HELP" response$ = ReadLine (t) error$ = Left (response$, 3) If error$ = "214" help$ = response$ Repeat readhelp$ = ReadLine (t) help$ = help$ + Chr (10) + readhelp$ Until readhelp$ = "" RuntimeError help$ Else RuntimeError "Couldn't get help information!" EndIf CloseTCPStream (t) EndIf End Function ; ----------------------------------------------------------------------------- ; Return 3 digit code from server's response ; ----------------------------------------------------------------------------- Function Code$ (code$) If debugSMTP debuglog2 "COMPUTER SAYS:"+code$,1 EndIf Return Left (code$, 3) End Function Function encode_file (path$,name$,stream) debuglog2 "Encoding file attachment...",2 file=OpenFile (path$+name$) If file ;Info WriteLine stream,"" WriteLine stream,"--boundarystring" WriteLine stream,"Content-Type: application/octet-stream; name="+name$ WriteLine stream,"Content-Transfer-Encoding: base64" WriteLine stream,"Content-Disposition: attachment; filename="+name$ WriteLine stream,"" debuglog2 "--boundarystring" ,2 debuglog2 "Content-Type: application/octet-stream; name="+name$,2 debuglog2 "Content-Transfer-Encoding: base64",2 debuglog2 "Content-Disposition: attachment; filename="+name$ ,2 debuglog2 "",2 debuglog2 "(encoded file contents not displayed)",2 linelen=0 While Not Eof (file) ;Fetch 3 bytes value=ReadByte (file) value=(value Shl 8) Or ReadByte (file) value=(value Shl 8) Or ReadByte (file) ;spit out 4 bytes (encoded) WriteByte stream,Asc(Mid$ (encodestring$,1+ ( (value Shr 18) And 63) ) ) WriteByte stream,Asc(Mid$ (encodestring$,1+ ( (value Shr 12) And 63) ) ) WriteByte stream,Asc(Mid$ (encodestring$,1+ ( (value Shr 06) And 63) ) ) WriteByte stream,Asc(Mid$ (encodestring$,1+ ( (value Shr 00) And 63) ) ) ;new line every 64 chars linelen=linelen+4 If linelen>63 WriteLine stream,"" linelen=0 EndIf Wend CloseFile (file) Else debuglog2 "File not found",2 EndIf End Function Function debuglog2 (message$,col=0) If col>0 And debug_enable>0 Select col Case 1 Color 255,255,0 Case 2 Color 255,0,255 Case 3 Color 255,0,0 End Select Print message$ Print EndIf If debug_file WriteLine debug_file,message$ DebugLog (message$) EndIf End Function