GeMIS_WEB/adressen/sendsmtpmail.p

/*------------------------------------------------------------------------
    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.