使用COBOL编写在IBM i上发送电子邮件的程序

本示例展示了如何使用COBOL编写在IBM i（OS/400）上发送电子邮件的程序。程序通过IBM i主机上配置的SMTP服务器发送邮件，支持附件和HTML格式。

IDENTIFICATION DIVISION.
       PROGRAM-ID. SENDMAIL.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT EMAIL ASSIGN TO EMAILFILE.
           SELECT ATTACHMENT ASSING TO ATTFILE.
       DATA DIVISION.
       FILE SECTION.
       FD EMAIL
           LABEL RECORDS ARE STANDARD
           DATA RECORD IS EMAIL-RECORD.
       01 EMAIL-RECORD.
           05 EMAIL-TO PIC X(80).
           05 EMAIL-FROM PIC X(80).
           05 EMAIL-SUBJECT PIC X(80).
           05 EMAIL-BODY PIC X(4000).
       FD ATTACHMENT
           LABEL RECORDS ARE STANDARD
           DATA RECORD IS ATTACHMENT-RECORD.
       01 ATTACHMENT-RECORD.
           05 ATT-FILENAME PIC X(80).
           05 ATT-DATA OCCURS 0 TO 200 TIMES DEPENDING ON ATT-SIZE.
               10 ATT-SIZE COMP PIC S9(8) VALUE 0.
               10 ATT-BYTES PIC X(4096).
       WORKING-STORAGE SECTION.
       77 SMTP-SERVER PIC X(40) VALUE 'smtp.example.com'.
       77 SMTP-USER PIC X(15) VALUE 'username'.
       77 SMTP-PASS PIC X(15) VALUE 'password'.
       77 EMAIL-COUNT PIC S9(8) VALUE 0.
       77 ATT-COUNT PIC S9(8) VALUE 0.
       PROCEDURE DIVISION.
       MAIN.
           OPEN INPUT EMAIL ATTACHMENT.
           PERFORM UNTIL EOF(EMAIL)
               READ EMAIL INTO EMAIL-RECORD
                   AT END SET EOF(EMAIL) TO TRUE
               END-READ.
               PERFORM UNTIL EOF(ATTACHMENT)
                   READ ATTACHMENT INTO ATTACHMENT-RECORD
                       AT END SET EOF(ATTACHMENT) TO TRUE
                   END-READ.
                   IF ATT-COUNT = 0
                       CALL 'QP2SHELL' USING '/QOpenSys/usr/bin/base64 -w 0 ' ATT-FILENAME
                       ATT-BYTES = QUOTE(_)SPACE.
                       ATT-SIZE = LENGTH(ATT-BYTES).
                       ATT-COUNT = ATT-COUNT + 1.
                   END-IF.
               END-PERFORM.
               CALL 'QP2SHELL' USING 'openssl s_client -host 'SMTP-SERVER' -port 465 -crlf
                   -authenticate_login -user 'SMTP-USER' 'SMTP-PASS''.
               IF EMAIL-COUNT = 0
                   DISPLAY 'EHLO 'SMTP-SERVER'.
                   DISPLAY 'AUTH LOGIN'.
                   CALL 'QP2SHELL' USING 'echo 'SMTP-USER' | base64 -w 0'.
                   CALL 'QP2SHELL' USING 'echo 'SMTP-PASS' | base64 -w 0'.
                   EMAIL-COUNT = EMAIL-COUNT + 1.
               END-IF.
               DISPLAY 'MAIL FROM:<'EMAIL-FROM'>'.
               DISPLAY 'RCPT TO:<'EMAIL-TO'>'.
               DISPLAY 'DATA'.
               DISPLAY 'MIME-VERSION: 1.0'.
               DISPLAY 'CONTENT-TYPE: MULTIPART/MIXED; BOUNDARY=IAA00000000'.
               DISPLAY 'SUBJECT:' EMAIL-SUBJECT.
               DISPLAY 'TO:' EMAIL-TO.
               DISPLAY 'FROM:' EMAIL-FROM.
               DISPLAY '--IAA00000000'.
               DISPLAY 'CONTENT-TYPE: TEXT/HTML; CHARSET="US-ASCII"'.
               DISPLAY 'CONTENT-TRANSFER-ENCODING: 8BIT'.
               DISPLAY QUOTE(EMAIL-BODY).
               IF ATT-COUNT > 0
                   DISPLAY '--IAA00000000'.
                   DISPLAY 'CONTENT-TYPE: APPLICATION/MSWORD; NAME="'ATT-FILENAME'"'.
                   DISPLAY 'CONTENT-TRANSFER-ENCODING: BASE64'.
                   PERFORM VARYING I FROM 1 BY 55
                       UNTIL I > ATT-SIZE
                       DISPLAY QUOTE(SUBSTRING(ATT-BYTES FROM I FOR 55)) '=='.
                   END-PERFORM.
                   DISPLAY '--IAA00000000--'.
               END-IF.
               DISPLAY '.'.
               DISPLAY 'QUIT'.
           END-PERFORM.
           CLOSE EMAIL ATTACHMENT.
           STOP RUN.

免责申明：文章和图片全部来源于公开网络，如有侵权，请通知删除 server@dude6.com