/*------------------------------------------------------------------------ File : sendsmtpmail.p Purpose : Syntax : Description : Author(s) : walter.riechsteiner Created : Thu Mar 21 11:36:52 CET 2019 Notes : ----------------------------------------------------------------------*/ /* *************************** Definitions ************************** */ /* ******************** Preprocessor Definitions ******************** */ /* *************************** Main Block *************************** */ /*------------------------------------------------------------------------ File : custom.p Purpose : Syntax : Description : Author(s) : javier.garcia Created : Wed Mar 20 17:36:56 CET 2019 Notes : ----------------------------------------------------------------------*/ /* *************************** Definitions ************************** */ USING System.Net.Mail.SmtpClient FROM ASSEMBLY. USING System.Net.Mail.MailAddress FROM ASSEMBLY. USING System.Net.Mail.MailMessage FROM ASSEMBLY. USING System.Net.Mail.Attachment FROM ASSEMBLY. USING System.Net.Mail.SmtpDeliveryMethod FROM ASSEMBLY. USING System.Net.NetworkCredential FROM ASSEMBLY. DEFINE INPUT PARAMETER iphttSendMail AS HANDLE NO-UNDO. DEFINE OUTPUT PARAMETER opcMessage AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER oplRetVal AS LOG NO-UNDO. { ttsendmail.i } DEFINE VARIABLE smtp AS SmtpClient. DEFINE VARIABLE fromAddress AS MailAddress. DEFINE VARIABLE toAddress AS MailAddress. DEFINE VARIABLE emailmessage AS MailMessage. DEFINE VARIABLE cAttachment AS Attachment. DEFINE VARIABLE lBatch AS LOGICAL NO-UNDO. DEFINE VARIABLE lSuper AS LOGICAL NO-UNDO. DEFINE VARIABLE cLogFile AS CHARACTER NO-UNDO. DEFINE VARIABLE cMessage AS CHARACTER NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE VARIABLE cToFirst AS CHARACTER NO-UNDO. DEFINE VARIABLE cToSecond AS CHARACTER NO-UNDO. DEFINE VARIABLE lcBody AS LONGCHAR NO-UNDO. DEFINE VARIABLE cDateiName AS CHARACTER NO-UNDO. DEFINE VARIABLE cAttached AS CHARACTER NO-UNDO. DEFINE VARIABLE cAttName AS CHARACTER NO-UNDO. DEFINE VARIABLE cProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE cLogFileProg AS CHARACTER NO-UNDO. /* ******************** Preprocessor Definitions ******************** */ /* *************************** Main Block *************************** */ cLogFileProg = SEARCH('writeLogFile.r'). cLogFile = 'C:\TEMP\sendsmtpmail.log'. cProgramm = THIS-PROCEDURE:NAME. RUN VALUE (cLogFileProg) ( cProgramm, cLogFile, 'sendsmtpmail gestartet ' + cLogFileProg + '/' + cProgramm ). ASSIGN opcMessage = '' oplRetVal = FALSE. /*cLogFileProg = SEARCH('writeLogFile.p'). */ /*cProgramm = DYNAMIC-FUNCTION ('makeProgname':U, THIS-PROCEDURE:HANDLE) NO-ERROR.*/ /*cLogFile = DYNAMIC-FUNCTION ('getLogFilePfad':U) NO-ERROR. */ /*IF cLogFile = ? THEN cLogFile = SESSION:TEMP-DIRECTORY. */ /*cLogFile = cLogFile + cProgramm + '.log'. */ EMPTY TEMP-TABLE ttSendMail. CREATE ttSendMail. httSendMail = TEMP-TABLE ttSendMail:DEFAULT-BUFFER-HANDLE. httSendMail:BUFFER-COPY (iphttSendMail). ASSIGN ttSendMail.cTo = REPLACE(ttSendMail.cTo, ',', ';') ttSendMail.cCC = REPLACE(ttSendMail.cCC, ',', ';') ttSendMail.cBC = REPLACE(ttSendMail.cBC, ',', ';') ttSendMail.cAttachedName = REPLACE(ttSendMail.cAttachedName, ',', ';') ttSendMail.cAttachedFile = REPLACE(ttSendMail.cAttachedFile, ',', ';') . IF ttSendMail.cFrom = '' THEN ttSendMail.cFrom = 'admin@adprime.ch'. IF ttSendMail.cFrom = '' OR ttSendMail.cTo = '' THEN DO: opcMessage = 'Mailadresse für Kontoanmeldung oder Maildresse zu "TO" fehlt/fehlen'. RETURN. END. ASSIGN opcMessage = '' oplRetVal = TRUE. DO WHILE ttSendMail.cAttachedFile <> '': DO ix = 1 TO NUM-ENTRIES(ttSendMail.cAttachedFile, ';'): cDateiname = ENTRY(ix, ttSendMail.cAttachedFile, ';'). cDateiname = SEARCH (cDateiName). IF cDateiName = ? THEN DO: opcMessage = SUBSTITUTE('Attachement &1 nicht gefunden', ttSendMail.cAttachedFile). RUN VALUE (cLogFileProg) ( cProgramm, cLogFile, opcMessage ). oplRetVal = FALSE. RETURN. END. ttSendMail.cAttachedFile = cDateiName. END. LEAVE. END. DO WHILE ttSendMail.cBody BEGINS 'File:': cDateiname = TRIM(SUBSTRING(ttSendMail.cBody,06)). cDateiname = SEARCH (cDateiName). IF cDateiName = ? THEN DO: opcMessage = SUBSTITUTE('Datei &1 für Body-Text nicht gefunden', ENTRY(2, ttSendMail.cBody, ':')). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, opcMessage ). oplRetVal = FALSE. RETURN. END. ttSendMail.cBody = 'FILE:' + cDateiName. LEAVE. END. cToFirst = ENTRY(1, ttSendMail.cTo, ';'). cToSecond = ''. IF NUM-ENTRIES(ttSendMail.cTo, ';') > 1 THEN DO: DO ii = 2 TO NUM-ENTRIES(ttSendMail.cTo, ';'): IF ENTRY(ii, ttSendMail.cTo, ';') = '' THEN NEXT. cToSecond = cToSecond + (IF cToSecond = '' THEN '' ELSE ';') + ENTRY(ii, ttSendMail.cTo, ';'). END. END. DO WHILE TRUE: fromAddress = NEW MailAddress(ttSendMail.cFrom). toAddress = NEW MailAddress(cToFirst). smtp = NEW SmtpClient(). smtp:Host = ttSendMail.cMailServer. smtp:Port = INTEGER(ttSendMail.cMailPort). smtp:EnableSsl = ttSendMail.lSSLEnabled. smtp:DeliveryMethod = SmtpDeliveryMethod:Network. smtp:TimeOut = 5000. smtp:TargetName = 'STARTTLS'. IF ttSendMail.lMailAuth THEN DO: IF ttSendMail.cAuthUsername = '' THEN ttSendMail.cAuthUsername = cAuthUserName. IF ttSendMail.cAuthPasswort = '' THEN ttSendMail.cAuthPasswort = cAuthPasswort. smtp:UseDefaultCredentials = FALSE. smtp:Credentials = NEW NetworkCredential(ttSendMail.cAuthUserName, ttSendMail.cAuthPasswort). smtp:TargetName = SUBSTITUTE('STARTTLS/&1', ttSendMail.cMailServer). END. ELSE DO: smtp:Credentials = NEW NetworkCredential(ttSendMail.cMailKonto, ttSendMail.cMailPassw). END. emailmessage = NEW MailMessage(fromAddress, toAddress). IF cToSecond <> '' THEN DO: DO ii = 1 TO NUM-ENTRIES(cToSecond, ';'): IF ENTRY(ii, cToSecond, ';') = '' THEN NEXT. emailmessage:TO:ADD(ENTRY(ii, cToSecond, ';')). END. END. IF ttSendMail.cCC <> '' THEN DO: DO ii = 1 TO NUM-ENTRIES(ttSendMail.cCC, ';'): IF ENTRY(ii, ttSendMail.cCC, ';') = '' THEN NEXT. emailmessage:cc:ADD(ENTRY(ii, ttSendMail.cCC, ';')). END. END. IF ttSendMail.cBC <> '' THEN DO: DO ii = 1 TO NUM-ENTRIES(ttSendMail.cBC, ';'): IF ENTRY(ii, ttSendMail.cBC, ';') = '' THEN NEXT. emailmessage:Bcc:ADD(ENTRY(ii, ttSendMail.cBC, ';')). END. END. IF ttsendmail.cBody BEGINS 'FILE:' THEN DO: cDateiname = REPLACE(ttsendmail.cBody, 'FILE:', ''). COPY-LOB FILE cDateiname TO lcBody. emailmessage:Body = lcBody NO-ERROR. END. ELSE DO: emailmessage:Body = ttsendmail.cBody NO-ERROR. END. IF ERROR-STATUS:ERROR THEN DO: opcMessage = 'Body-Fehler'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, opcMessage ). oplRetVal = FALSE. LEAVE. END. emailmessage:Subject = ttSendMail.cSubject. emailMessage:IsBodyHtml = TRUE. IF ttSendMail.cAttachedName <> '' THEN DO: IF ttSendMail.cAttachedFile = '' THEN ttSendMail.cAttachedFile = ttSendMail.cAttachedName. IF ttSendMail.cAttachedName = '' THEN ttSendMail.cAttachedName = ttSendMail.cAttachedFile. DO ii = 1 TO NUM-ENTRIES(ttSendMail.cAttachedName, ';'): cAttached = ENTRY(ii, ttSendMail.cAttachedFile, ';'). cAttachment = NEW Attachment(cAttached). cAttName = ENTRY(ii, ttSendMail.cAttachedName, ';'). DO WHILE cAttName <> '': cAttName = REPLACE(cAttName, '\', '/'). ii = R-INDEX(cAttName, '/'). IF ii = 0 THEN LEAVE. ii = ii + 1. cAttName = TRIM(SUBSTRING(cAttName,ii)). LEAVE. END. cAttachment:NAME = cAttName. emailmessage:attachments:ADD(cAttachment). DELETE OBJECT cAttachment. END. END. cString = SUBSTITUTE('Sendmail From &1 to &2, cc an &3 mit Subject &4 am &5 um &6 ', emailmessage:From:ToString(), emailmessage:TO:ToString() , emailmessage:CC:ToString() , emailMessage:Subject , STRING(TODAY,"99.99.9999") , STRING(TIME ,"HH:MM:SS") ). RUN VALUE (cLogFileProg) ( cProgramm, cLogFile, cString ). smtp:Send(emailmessage) NO-ERROR. DO WHILE ERROR-STATUS:ERROR: oplRetVal = FALSE. DO ii = 1 TO ERROR-STATUS:NUM-MESSAGES: cString = ERROR-STATUS:GET-MESSAGE(ii). ix = INDEX(cString, ':'). IF ix > 0 THEN cString = TRIM(SUBSTRING(cString, ix + 1)). cMessage = SUBSTITUTE('&1 : &2 -> &3', STRING(NOW,'99.99.9999 HH:MM:SS.SSS'), ERROR-STATUS:GET-NUMBER(ii), cString ). opcMessage = opcMessage + (IF opcMessage = '' THEN '' ELSE CHR(10)) + cMessage. END. RUN VALUE (cLogFileProg) ( cProgramm, cLogFile, opcMessage ). LEAVE. END. IF oplRetVal THEN DO: cString = SUBSTITUTE('Sendmail From &1 to &2, cc an &3 mit Subject &4 am &5 um &6 success', emailmessage:From:ToString(), emailmessage:TO:ToString() , emailmessage:CC:ToString() , emailMessage:Subject , STRING(TODAY,"99.99.9999") , STRING(TIME ,"HH:MM:SS") ). RUN VALUE (cLogFileProg) ( cProgramm, cLogFile, cString ). END. LEAVE. END. DELETE OBJECT fromAddress NO-ERROR. DELETE OBJECT toAddress NO-ERROR. DELETE OBJECT smtp:Credentials NO-ERROR. DELETE OBJECT smtp NO-ERROR. DELETE OBJECT emailmessage NO-ERROR. DELETE OBJECT cAttachment NO-ERROR. RETURN.