IDENTIFICATION DIVISION. PROGRAM-ID. SENDMAIL. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. INTERACTIVE-COBOL. OBJECT-COMPUTER. INTERACTIVE-COBOL. * Sample program using the IC_SEND_MAIL builtin * added in 3.50 of ICOBOL * * * Make sure the the environment parament ICSMTPSERVER is set * to find the SMTP server. (ICSMTPPORT is optional) * * RHJ 3.50 New. * INPUT-OUTPUT SECTION. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 77 ICSMTPSERVER-ENV PIC X(20) VALUE "ICSMTPSERVER". 77 ICSMTPSERVER-ENTRY PIC X(70) VALUE SPACES. 01 MAIL-STUFF. 02 TO-LIST PIC X(80). 02 FROM-LIST PIC X(80). 02 CC-LIST PIC X(80). 02 BCC-LIST PIC x(80). 02 SUBJECT PIC X(80). 02 TOTAL-BODY. 04 BODY-PART OCCURS 12 TIMES PIC x(80). * 03 BODY-1 PIC X(80). * 03 BODY-2 PIC X(80). * 03 BODY-3 PIC X(80). * 03 BODY-4 PIC X(80). * 03 BODY-5 PIC X(80). * 03 BODY-6 PIC X(80). * 03 BODY-7 PIC X(80). * 03 BODY-8 PIC X(80). * 03 BODY-9 PIC X(80). * 03 BODY-10 PIC X(80). * 03 BODY-11 PIC X(80). * 03 BODY-12 PIC X(80). 02 MIME-TYPE PIC X(20). 02 ATT-FILE PIC X(80). 01 I PIC 99. 01 START-LOC PIC 9(5). 01 BODY-LEN PIC 9(5). 01 BODY-TEXT PIC X(4000). 01 BODY-TEXT-START PIC 9(5). 01 BODY-TEXT-LEN PIC 9(5). 01 EXCEPTION-STATUS PIC 9(5). 01 EXCEPT-MSG PIC X(60). 01 ESC-CODE PIC 99. SCREEN SECTION. 01 BLANK-SCREEN. 02 BLANK SCREEN. 01 MAIN-SCREEN. 02 LINE 1 COL 10 BRIGHT " Sample Mail Sender". 02 SMTP-ENTRY. 04 COL 40 "SMTP: ". 04 PIC X(30) USING ICSMTPSERVER-ENTRY. 02 MAIN-ENTRY. 03 FILLER. 04 LINE 2 COL 1 "To: ". 04 PIC X(75) USING TO-LIST. 04 LINE 3 COL 1 "Fr: ". 04 PIC X(75) USING FROM-LIST. 04 LINE 4 COL 1 "CC: ". 04 PIC X(75) USING CC-LIST. 04 LINE 5 COL 1 "BC: ". 04 PIC X(75) USING BCC-LIST. 04 LINE 6 COL 1 "Subject: ". 04 PIC X(40) USING SUBJECT. 04 COL 60 "Mime: ". 04 PIC X(15) USING MIME-TYPE. 04 LINE 7 COL 1 PIC X(80) USING BODY-PART (1). 04 LINE 8 COL 1 PIC X(80) USING BODY-PART (2). 04 LINE 9 COL 1 PIC X(80) USING BODY-PART (3). 04 LINE 10 COL 1 PIC X(80) USING BODY-PART (4). 04 LINE 11 COL 1 PIC X(80) USING BODY-PART (5). 04 LINE 12 COL 1 PIC X(80) USING BODY-PART (6). 04 LINE 13 COL 1 PIC X(80) USING BODY-PART (7). 04 LINE 14 COL 1 PIC X(80) USING BODY-PART (8). 04 LINE 15 COL 1 PIC X(80) USING BODY-PART (9). 04 LINE 16 COL 1 PIC X(80) USING BODY-PART (10). 04 LINE 17 COL 1 PIC X(80) USING BODY-PART (11). 04 LINE 18 COL 1 PIC X(80) USING BODY-PART (12). 03 FILE-ENTRY. 04 LINE 20 COL 1 "File: ". 04 PIC X(70) USING ATT-FILE. 02 LINE 24 COL 1 "ESC to exit, F1 Send NOW, F2 File entry, F3 Change SMTP, use \\ in body for lf". 01 ERROR-MESSAGE. 02 LINE 23 COL 1 "Error: ". 02 PIC ZZZZ9 FROM EXCEPTION-STATUS. 02 COL PLUS 1 PIC X(60) USING EXCEPT-MSG. 01 GOOD-MESSAGE. 02 LINE 23 COL 1 "Success: ". 02 PIC ZZZZ9 FROM EXCEPTION-STATUS. 02 COL PLUS 1 PIC X(60) USING EXCEPT-MSG. 01 ERROR-MESSAGE-BLANK. 02 LINE 22 BLANK LINE. 02 LINE 23 BLANK LINE. PROCEDURE DIVISION. MAIN SECTION. START-UP. * Initialize input MOVE SPACES TO MAIL-STUFF. MOVE "text" to MIME-TYPE. * Clear screen DISPLAY BLANK-SCREEN. CALL "IC_GET_ENV" USING ICSMTPSERVER-ENV, ICSMTPSERVER-ENTRY ON EXCEPTION * Could show warning MOVE "** SMTP server not set **" TO ICSMTPSERVER-ENTRY END-CALL. MAIL-IT. * main Mail Loop DISPLAY MAIN-SCREEN. IF ESC-CODE = 4 ACCEPT SMTP-ENTRY ACCEPT ESC-CODE FROM ESCAPE IF ESC-CODE = 1 GO TO END-IT-EXIT END-IF CALL "IC_SET_ENV" USING ICSMTPSERVER-ENV, ICSMTPSERVER-ENTRY ON EXCEPTION ACCEPT EXCEPTION-STATUS FROM EXCEPTION CALL "IC_MSG_TEXT" USING EXCEPTION-STATUS, EXCEPT-MSG DISPLAY ERROR-MESSAGE MOVE SPACES TO ICSMTPSERVER-ENTRY END-CALL GO TO MAIL-IT END-IF. IF ESC-CODE = 3 ACCEPT FILE-ENTRY ELSE ACCEPT MAIN-ENTRY. * Clear message line from previous loop DISPLAY ERROR-MESSAGE-BLANK. ACCEPT ESC-CODE FROM ESCAPE. IF ESC-CODE = 1 GO TO END-IT-EXIT. IF ESC-CODE = 4 OR ESC-CODE = 3 GO TO MAIL-IT. MOVE SPACES TO BODY-TEXT. MOVE 1 TO BODY-TEXT-START; MOVE 0 TO BODY-TEXT-LEN. CALL "IC_TRIM" USING TOTAL-BODY, START-LOC, BODY-LEN. ADD START-LOC TO BODY-LEN. ADD 79 TO BODY-LEN. DIVIDE 80 INTO BODY-LEN. MOVE 1 TO I. PERFORM BODY-LEN TIMES CALL "IC_TRIM" USING BODY-PART (I), START-LOC, BODY-LEN IF BODY-LEN > 0 IF BODY-LEN NOT = 1 IF BODY-PART (I) (START-LOC + BODY-LEN - 2:2) = "\\" SUBTRACT 2 FROM BODY-LEN END-IF END-IF MOVE BODY-PART (I) (1:BODY-LEN) TO BODY-TEXT (BODY-TEXT-START:) ADD BODY-LEN TO BODY-TEXT-START END-IF MOVE X"0d0a" TO BODY-TEXT (BODY-TEXT-START:2) ADD 2 TO BODY-TEXT-START, BODY-TEXT-LEN ADD 1 TO I END-PERFORM. INSPECT BODY-TEXT REPLACING ALL "\\" BY X"0d0a". IF ATT-FILE = SPACES CALL "IC_SEND_MAIL" USING TO-LIST, FROM-LIST, CC-LIST, BCC-LIST, SUBJECT, BODY-TEXT ON EXCEPTION ACCEPT EXCEPTION-STATUS FROM EXCEPTION CALL "IC_MSG_TEXT" USING EXCEPTION-STATUS, EXCEPT-MSG DISPLAY ERROR-MESSAGE NOT ON EXCEPTION ACCEPT EXCEPTION-STATUS FROM EXCEPTION CALL "IC_MSG_TEXT" USING EXCEPTION-STATUS, EXCEPT-MSG DISPLAY GOOD-MESSAGE END-CALL ELSE CALL "IC_SEND_MAIL" USING TO-LIST, FROM-LIST, CC-LIST, BCC-LIST, SUBJECT, BODY-TEXT, MIME-TYPE, ATT-FILE ON EXCEPTION ACCEPT EXCEPTION-STATUS FROM EXCEPTION CALL "IC_MSG_TEXT" USING EXCEPTION-STATUS, EXCEPT-MSG DISPLAY ERROR-MESSAGE NOT ON EXCEPTION ACCEPT EXCEPTION-STATUS FROM EXCEPTION CALL "IC_MSG_TEXT" USING EXCEPTION-STATUS, EXCEPT-MSG DISPLAY GOOD-MESSAGE END-CALL END-IF. GO TO MAIL-IT. END-IT-EXIT. EXIT PROGRAM. END-IT-STOP. STOP RUN.