IMPORT os IMPORT util DEFINE rv INTEGER DEFINE logtext STRING DEFINE smtplog base.StringBuffer DEFINE ext2mime DYNAMIC ARRAY OF RECORD ext STRING, mime STRING, encoding STRING END RECORD TYPE cnf_t RECORD hostname STRING, smtphost STRING, smtpport INTEGER, senderemail STRING, clave STRING, cnxtimeout INTEGER END RECORD DEFINE cnf cnf_t &define MB(array, idx, line) \ LET array[idx] = line \ LET idx = idx + 1 FUNCTION genmail(senderemail, recipients, subject, mailtext, attachments, mailbody, rcpt) DEFINE senderemail STRING DEFINE subject STRING DEFINE recipients DYNAMIC ARRAY OF RECORD mode STRING, recipient STRING END RECORD DEFINE mailtext STRING DEFINE sbmt base.StringBuffer DEFINE i, found INTEGER DEFINE rcpt DYNAMIC ARRAY OF STRING DEFINE attachments DYNAMIC ARRAY OF RECORD fname, sname STRING END RECORD DEFINE nl INTEGER DEFINE nrcpt INTEGER DEFINE nr INTEGER DEFINE extension STRING DEFINE mimeid INTEGER DEFINE tz STRING DEFINE boundary STRING DEFINE mailbody DYNAMIC ARRAY OF STRING LET nl = 1 LET nr = 1 LET nrcpt = 0 # Add mail date MB(mailbody, nl, SFMT("Date: %1 %2 %3\r", TODAY USING "ddd, dd mmm yyyy", TIME(CURRENT), tz)) # First add headers MB(mailbody, nl, SFMT("From: %1\r", senderemail)) # Add user agent MB(mailbody, nl, "User-Agent: maildemo sample program.\r") # Add MIME version MB(mailbody, nl, "MIME-Version: 1.0\r") # Add To: recipients LET found = 0 FOR i = 1 TO recipients.getLength() IF recipients[i].mode == "To" THEN IF found THEN LET mailbody[nl] = mailbody[nl].append(SFMT(", %1", recipients[i].recipient)) ELSE LET mailbody[nl]=SFMT("To: %1", recipients[i].recipient) LET found = 1 END IF MB(rcpt, nr, SFMT("RCPT TO: %1", extract_email(recipients[i].recipient))) END IF END FOR IF found == 1 THEN LET mailbody[nl] = mailbody[nl].append("\r") LET nl = nl + 1 END IF # Add CC: recipients LET found = 0 FOR i = 1 TO recipients.getLength() IF recipients[i].mode == "CC" THEN IF found THEN LET mailbody[nl] = mailbody[nl].append(SFMT(", %1", recipients[i].recipient)) ELSE LET mailbody[nl]=SFMT("CC: %1", recipients[i].recipient) LET found = 1 END IF MB(rcpt, nr, SFMT("RCPT TO: %1", extract_email(recipients[i].recipient))) END IF END FOR IF found == 1 THEN LET mailbody[nl] = mailbody[nl].append("\r") LET nl = nl + 1 END IF # Add CC: recipients LET found = 0 FOR i = 1 TO recipients.getLength() IF recipients[i].mode == "BCC" THEN IF found THEN LET mailbody[nl] = mailbody[nl].append(SFMT(", %1", recipients[i].recipient)) ELSE LET mailbody[nl]=SFMT("BCC: %1", recipients[i].recipient) LET found = 1 END IF MB(rcpt, nr, SFMT("RCPT TO: %1", extract_email(recipients[i].recipient))) END IF END FOR IF found == 1 THEN LET mailbody[nl] = mailbody[nl].append("\r") LET nl = nl + 1 END IF MB(mailbody, nl, SFMT("Subject: %1\r", subject)) # Now add the message content # Multipart message not handled # Should check the body is really 7bit and not line starts with ., ... # To be conformant with 7bit encoding. See RFC for details. # \n.\n is the DATA section end mark. # Should be replaced by \n..\n LET sbmt = base.StringBuffer.create() CALL sbmt.append(mailtext) # Need to do it twice to properly handle following case: \n.\n.\n.\n.\n.\n CALL sbmt.replace("\n.\n", "\n..\n", 0) CALL sbmt.replace("\n.\n", "\n..\n", 0) LET mailtext=sbmt.toString() IF attachments.getLength() == 0 THEN MB(mailbody, nl, SFMT("Content-Type: text/plain; charset=%1\r", "ISO-8859-1")) MB(mailbody, nl, SFMT("Content-Transfer-Encoding: %1\r", "7bit")) MB(mailbody, nl, "\r") MB(mailbody, nl, mailtext) MB(mailbody, nl, "\r") ELSE MB(mailbody, nl, "Content-Type: multipart/mixed;\r") MB(mailbody, nl, ' boundary="' || boundary || '"\r') MB(mailbody, nl, "\r") MB(mailbody, nl, "This is a multi-part message in MIME format.\r") # Add message text MB(mailbody, nl, "--" || boundary || "\r") MB(mailbody, nl, SFMT("Content-Type: text/plain; charset=%1; format=flowed\r", "ISO-8859-1")) MB(mailbody, nl, SFMT("Content-Transfer-Encoding: %1\r", "7bit")) MB(mailbody, nl, "\r") MB(mailbody, nl, mailtext) MB(mailbody, nl, '\r') FOR i = 1 TO attachments.getLength() MB(mailbody, nl, "--" || boundary || "\r") LET extension = os.Path.extension(attachments[i].fname) LET mimeid = getmime(extension) IF mimeid == -1 THEN # Unknown extension. # Default to application/octet-stream, base64 encoded LET mimeid = 1 END IF CASE ext2mime[mimeid].encoding WHEN "base64" MB(mailbody, nl, SFMT("Content-Type: %1;\r", ext2mime[mimeid].mime)) MB(mailbody, nl, ' name="'|| attachments[i].fname || '"\r') MB(mailbody, nl, 'Content-Transfer-Encoding: base64\r') MB(mailbody, nl, 'Content-Disposition: inline;\r') MB(mailbody, nl, ' filename="'|| os.Path.basename(attachments[i].fname) || '"\r') MB(mailbody, nl, '\r') LET nl = file_to_base64(attachments[i].sname, mailbody, nl) WHEN "7bit" MB(mailbody, nl, SFMT("Content-Type: %1;\r", ext2mime[mimeid].mime)) MB(mailbody, nl, ' name="'|| attachments[i].fname || '"\r') MB(mailbody, nl, 'Content-Transfer-Encoding: 7bit\r') MB(mailbody, nl, 'Content-Disposition: inline;\r') MB(mailbody, nl, ' filename="'|| os.Path.basename(attachments[i].fname) || '"\r') MB(mailbody, nl, '\r') LET nl = file_to_7bit(attachments[i].sname, mailbody, nl) # OTHERWISE # CALL mbox_ok("Attachment encoding", SFMT("Unsupported encoding %1.", ext2mime[mimeid].encoding), "stop") EXIT PROGRAM 1 END CASE END FOR MB(mailbody, nl, "--" || boundary || "--\r") END IF # Add end of message marker MB(mailbody, nl, ".\r") END FUNCTION # Convert a file to a base64 string REPORT gen_base64(l) DEFINE l BYTE OUTPUT PAGE LENGTH 1 TOP MARGIN 0 BOTTOM MARGIN 0 LEFT MARGIN 0 FORMAT ON EVERY ROW PRINTX name=base64_l l END REPORT # Convert a file to 7bit encoding (fake) FUNCTION file_to_7bit(fname, mailbody, nl) DEFINE fname STRING DEFINE mailbody DYNAMIC ARRAY OF STRING DEFINE ac base.Channel DEFINE line STRING DEFINE nl INTEGER LET ac = base.Channel.create() CALL ac.openFile(fname, "rb") WHILE NOT ac.isEof() LET line = ac.readLine() MB(mailbody, nl, line) END WHILE CALL ac.close() RETURN nl END FUNCTION FUNCTION smtpSend(ch, command) DEFINE ch base.Channel DEFINE command STRING DEFINE smtpStatus INTEGER DEFINE smtpMessage STRING CALL clientWrite(ch, command) CALL readSmtpAnswer(ch) RETURNING smtpStatus, smtpMessage RETURN smtpStatus, smtpMessage END FUNCTION FUNCTION extract_email(email) DEFINE email STRING DEFINE s, e INTEGER LET s = email.getIndexOf("<", 1) LET e = email.getIndexOf(">", 1) IF s == 0 OR e == 0 OR s >= e THEN RETURN email END IF RETURN email.subString(s + 1, e - 1) END FUNCTION # Returns the mime entry index for the extension `ext' # -1 if not entry matching the extension is found. FUNCTION getmime(ext) DEFINE ext STRING DEFINE j INTEGER FOR j = 1 TO ext2mime.getLength() IF ext2mime[j].ext == ext THEN RETURN j END IF END FOR RETURN -1 END FUNCTION FUNCTION file_to_base64(fname, mailbody, nl) DEFINE mailbody DYNAMIC ARRAY OF STRING DEFINE fname STRING DEFINE nl INTEGER DEFINE l BYTE DEFINE lfn STRING DEFINE doc om.DomDocument DEFINE node om.DomNode DEFINE lnode om.NodeList LET lfn = fname || ".xml" LOCATE l IN FILE fname CALL fgl_report_set_document_handler(om.XmlWriter.createFileWriter(lfn)) START REPORT gen_base64 TO FILE "dummy_report_file" OUTPUT TO REPORT gen_base64(l) FINISH REPORT gen_base64 # Load the generated XML file LET doc = om.DomDocument.createFromXmlFile(lfn) LET node = doc.getDocumentElement() LET lnode = node.selectByTagName("Item") LET node = lnode.item(1) MB(mailbody, nl, node.getAttribute("value")) # IF NOT os.Path.delete(lfn) THEN # CALL mbox_ok("Warning", SFMT("The temporary file %1 could not be removed.", lfn), "stop") # END IF RETURN nl END FUNCTION FUNCTION readSmtpAnswer(ch) DEFINE ch base.Channel DEFINE line STRING DEFINE smtpStatus INTEGER DEFINE smtpMessage STRING LET smtpMessage = "" WHILE 1 LET line = serverRead(ch) IF line IS NULL THEN RETURN -1, "COULD NOT READ SMTP ANSWER" END IF IF line MATCHES "[0-9][0-9][0-9] *" THEN IF smtpMessage.getLength() != 0 THEN LET smtpMessage=smtpMessage || "\n" END IF LET smtpMessage=smtpMessage.append(line.subString(4, line.getLength())) LET smtpStatus = line.subString(1,3) RETURN smtpStatus, smtpMessage END IF IF line MATCHES "[0-9][0-9][0-9]-*" THEN IF smtpMessage.getLength() != 0 THEN LET smtpMessage=smtpMessage || "\n" END IF LET smtpMessage=smtpMessage.append(line.subString(4, line.getLength())) END IF END WHILE END FUNCTION FUNCTION clientWrite(mc, line) DEFINE mc base.Channel DEFINE line STRING CALL smtplog.append('C> ') CALL smtplog.append(line) CALL smtplog.append("
") LET logtext=smtplog.toString() CALL mc.writeLine(line) DISPLAY "log:> ",line END FUNCTION FUNCTION serverRead(mc) DEFINE line STRING DEFINE mc base.Channel LET line = mc.readLine() CALL smtplog.append("S> ") CALL smtplog.append(line) CALL smtplog.append("
") LET logtext=smtplog.toString() RETURN line END FUNCTION FUNCTION sendmail(rcpt, mailbody) DEFINE mailbody DYNAMIC ARRAY OF STRING DEFINE rcpt DYNAMIC ARRAY OF STRING DEFINE smtpStatus INTEGER DEFINE smtpMessage STRING DEFINE mc base.Channel DEFINE i INTEGER LET cnf.smtphost = 'smtp.office365.com' LET cnf.smtpport = 587 LET cnf.hostname='smtp.office365.com' LET CNF.senderemail = 'nominas@marmotech.com.do' LET cnf.clave = 'Marmotech22' LET cnf.cnxtimeout=10 LET smtplog = base.StringBuffer.create() LET mc = base.Channel.create() TRY DISPLAY "INICIO ",current CALL mc.openClientSocket(cnf.smtphost, cnf.smtpport, "ub", cnf.cnxtimeout) CATCH CALL fgl_winmessage("INFO","FALLO CONEXION","INFO") # CALL mbox_ok("Socket error", "The connection to the SMTP Server failed.\n", "stop") RETURN FALSE END TRY CALL readSmtpAnswer(mc) RETURNING smtpStatus, smtpMessage CALL smtpSend(mc, "HELO " || cnf.hostname || "\r") RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF CALL smtpSend(mc, "STARTTLS \r") RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF CALL smtpSend(mc, cnf.senderemail CLIPPED ||" "|| cnf.clave CLIPPED) RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF CALL smtpSend(mc, SFMT("MAIL FROM: %1\r", extract_email(cnf.senderemail))) RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF DISPLAY "TERMINO ",current FOR i = 1 TO rcpt.getLength() CALL smtpSend(mc, rcpt[i]) RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF END FOR CALL smtpSend(mc, "DATA\r") RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF FOR i = 1 TO mailbody.getLength() CALL clientWrite(mc, mailbody[i]) END FOR CALL readSmtpAnswer(mc) RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF CALL smtpSend(mc, "QUIT\r") RETURNING smtpStatus, smtpMessage IF smtpStatus >= 400 THEN CALL smtpError(mc, smtpMessage) RETURN FALSE END IF CALL mc.close() RETURN TRUE END FUNCTION # Deletes temporary attachment files FUNCTION clear_attachments(attachments) DEFINE attachments DYNAMIC ARRAY OF RECORD fname, sname STRING END RECORD DEFINE i INTEGER FOR i = 1 TO attachments.getLength() LET rv = os.Path.delete(attachments[i].sname) END FOR END FUNCTION FUNCTION smtpError(mc, msg) DEFINE msg STRING DEFINE mc base.Channel DEFINE smtpStatus INTEGER DEFINE smtpMessage STRING CALL mbox_ok("SMTP Error", msg, "stop") CALL smtpSend(mc, "QUIT\r") RETURNING smtpStatus, smtpMessage CALL mc.close() END FUNCTION