IDENTIFICATION DIVISION. PROGRAM-ID. COB_MAIL. AUTHOR. Roland Hughes. DATE-WRITTEN. 2005-02-09. DATE-COMPILED. TODAY. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. ********** * Data declarations ********** WORKING-STORAGE SECTION. 01 CONSTANTS. 05 SEND-USERNAME PIC S9(9) COMP VALUE 19. * MAIL$_SEND_USERNAME. 05 SEND-TO-LINE PIC S9(9) COMP VALUE 16. * MAIL$_SEND_TO_LINE. 05 SEND-FROM-LINE PIC S9(9) COMP VALUE 8. * MAIL$_SEND_FROM_LINE. 05 SEND-SUBJECT-LINE PIC S9(9) COMP VALUE 14. * MAIL$_SEND_SUBJECT. 05 SEND-FILENAME PIC S9(9) COMP VALUE 7. * MAIL$_SEND_FILENAME. 05 SEND-USERNAME-TYPE PIC S9(9) COMP VALUE 20. * MAIL$_SEND_USERNAME_TYPE. 05 MAIL-TO PIC S9(4) COMP VALUE 1. * MAIL$_TO. 05 MAIL-TO-PTR POINTER VALUE REFERENCE MAIL-TO. 05 A-ZERO PIC S9(9) COMP VALUE 0. 01 ITEM-LIST-TBL. 05 ITEM-LIST-1 OCCURS 5 TIMES. 10 ITEM-ELEMENT-1. 15 BUFFER-LENGTH PIC S9(4) COMP. 15 ITEM-CODE PIC S9(4) COMP. 15 BUFFER-ADDRESS PIC S9(9) COMP. 15 RETURN-LENGTH PIC S9(9) COMP. 10 ITEM-TERMINATOR REDEFINES ITEM-ELEMENT-1. 15 TERMINATOR PIC S9(9) COMP. 05 ITEM-LIST-2 OCCURS 5 TIMES. 10 ITEM-ELEMENT-2. 15 BUFFER-LENGTH PIC S9(4) COMP. 15 ITEM-CODE PIC S9(4) COMP. 15 BUFFER-ADDRESS PIC S9(9) COMP. 15 RETURN-LENGTH PIC S9(9) COMP. 10 ITEM-TERMINATOR REDEFINES ITEM-ELEMENT-2. 15 TERMINATOR PIC S9(9) COMP. 01 STUFF. 05 L-STAT PIC S9(9) COMP. 05 L-SUB PIC 999. 05 L-TALLY PIC 999. 05 TRANSLATED-NAME PIC X(255). 05 WORK-STR PIC X(255). 05 L-CONTEXT PIC S9(9) COMP. 05 FROM-LINE PIC X(6) VALUE 'HUGHES'. 05 FROM-LINE-PTR POINTER VALUE REFERENCE FROM-LINE. 05 TO-LINE PIC X(17) VALUE 'MEGA_SUPPORT_LIST'. 05 TO-LINE-PTR POINTER VALUE REFERENCE TO-LINE. 05 SUBJECT-LINE PIC X(24) VALUE 'MEGA System Notification'. 05 SUBJECT-LINE-PTR POINTER VALUE REFERENCE SUBJECT-LINE. 05 FILE-NAME PIC X(9) VALUE 'HELLO.TXT'. 05 FILE-NAME-PTR POINTER VALUE REFERENCE FILE-NAME. 01 DESTINATION-STUFF. 05 DEST-STRINGS PIC X(30) OCCURS 20 TIMES. 01 SINGLE-DESTINATION-STUFF. 05 DEST-STR PIC X(30). 05 DEST-STR-PTR POINTER VALUE REFERENCE DEST-STR. PROCEDURE DIVISION. A000-SEND-MAIL. * * Establish a mail context * MOVE ZERO TO L-CONTEXT, L-STAT. CALL 'MAIL$SEND_BEGIN' USING BY REFERENCE L-CONTEXT BY REFERENCE A-ZERO BY REFERENCE A-ZERO GIVING L-STAT. * * Assign the message attributes * MOVE FUNCTION LENGTH( TO-LINE) TO BUFFER-LENGTH IN ITEM-LIST-1(1). MOVE SEND-TO-LINE TO ITEM-CODE IN ITEM-LIST-1(1). MOVE TO-LINE-PTR TO BUFFER-ADDRESS IN ITEM-LIST-1(1). MOVE ZERO TO RETURN-LENGTH IN ITEM-LIST-1(1). MOVE FUNCTION LENGTH( FROM-LINE) TO BUFFER-LENGTH IN ITEM-LIST-1(2). MOVE SEND-FROM-LINE TO ITEM-CODE IN ITEM-LIST-1(2). MOVE FROM-LINE-PTR TO BUFFER-ADDRESS IN ITEM-LIST-1(2). MOVE ZERO TO RETURN-LENGTH IN ITEM-LIST-1(2). MOVE FUNCTION LENGTH( SUBJECT-LINE) TO BUFFER-LENGTH IN ITEM-LIST-1(3). MOVE SEND-SUBJECT-LINE TO ITEM-CODE IN ITEM-LIST-1(3). MOVE SUBJECT-LINE-PTR TO BUFFER-ADDRESS IN ITEM-LIST-1(3). MOVE ZERO TO RETURN-LENGTH IN ITEM-LIST-1(3). MOVE ZERO TO TERMINATOR IN ITEM-LIST-1(4). CALL 'MAIL$SEND_ADD_ATTRIBUTE' USING BY REFERENCE L-CONTEXT BY REFERENCE ITEM-LIST-1(1) BY REFERENCE A-ZERO GIVING L-STAT. * * Add the text file * MOVE FUNCTION LENGTH( FILE-NAME) TO BUFFER-LENGTH IN ITEM-LIST-2(1). MOVE SEND-FILENAME TO ITEM-CODE IN ITEM-LIST-2(1). MOVE FILE-NAME-PTR TO BUFFER-ADDRESS IN ITEM-LIST-2(1). MOVE ZERO TO RETURN-LENGTH IN ITEM-LIST-2(1). CALL 'MAIL$SEND_ADD_BODYPART' USING BY REFERENCE L-CONTEXT BY REFERENCE ITEM-LIST-2(1) BY REFERENCE A-ZERO GIVING L-STAT. * * See if we have a logical to parse * MOVE SPACES TO TRANSLATED-NAME. CALL 'LIB$GET_LOGICAL' USING BY DESCRIPTOR TO-LINE BY DESCRIPTOR TRANSLATED-NAME. IF TRANSLATED-NAME IS GREATER THAN SPACES PERFORM B000-PARSE-MAIL-LOGICAL ELSE MOVE TO-LINE TO DEST-STR PERFORM U000-ADD-MAIL-ADDRESS. * * Send the mail message * CALL 'MAIL$SEND_MESSAGE' USING BY REFERENCE L-CONTEXT BY REFERENCE A-ZERO BY REFERENCE A-ZERO GIVING L-STAT. * * End the mail interface * CALL 'MAIL$SEND_END' USING BY REFERENCE L-CONTEXT BY REFERENCE A-ZERO BY REFERENCE A-ZERO GIVING L-STAT. STOP RUN. ***** * Paragraph to parse the mail logical * getting each definition and adding a new * destination for each one. ***** B000-PARSE-MAIL-LOGICAL. MOVE ZERO TO L-SUB, L-TALLY. UNSTRING TRANSLATED-NAME DELIMITED BY ',' OR SPACE INTO DEST-STRINGS(1) DEST-STRINGS(2) DEST-STRINGS(3) DEST-STRINGS(4) DEST-STRINGS(5) DEST-STRINGS(6) DEST-STRINGS(7) DEST-STRINGS(8) DEST-STRINGS(9) DEST-STRINGS(10) DEST-STRINGS(11) DEST-STRINGS(12) DEST-STRINGS(13) DEST-STRINGS(14) DEST-STRINGS(15) DEST-STRINGS(16) DEST-STRINGS(17) DEST-STRINGS(18) DEST-STRINGS(19) DEST-STRINGS(20) TALLYING IN L-TALLY. PERFORM VARYING L-SUB FROM 1 BY 1 UNTIL DEST-STRINGS( L-SUB) IS EQUAL TO SPACES MOVE DEST-STRINGS( L-SUB) TO DEST-STR PERFORM U000-ADD-MAIL-ADDRESS END-PERFORM. ***** * Paragraph to add a destination address to the email ***** U000-ADD-MAIL-ADDRESS. MOVE FUNCTION LENGTH( DEST-STR) TO BUFFER-LENGTH IN ITEM-LIST-1(1). MOVE SEND-USERNAME TO ITEM-CODE IN ITEM-LIST-1(1). MOVE DEST-STR-PTR TO BUFFER-ADDRESS IN ITEM-LIST-1(1). MOVE ZERO TO RETURN-LENGTH IN ITEM-LIST-1(1). MOVE 2 TO BUFFER-LENGTH IN ITEM-LIST-1(2). MOVE SEND-USERNAME-TYPE TO ITEM-CODE IN ITEM-LIST-1(2). MOVE MAIL-TO-PTR TO BUFFER-ADDRESS IN ITEM-LIST-1(2). MOVE ZERO TO RETURN-LENGTH IN ITEM-LIST-1(2). MOVE ZERO TO TERMINATOR IN ITEM-LIST-1(3). CALL 'MAIL$SEND_ADD_ADDRESS' USING BY REFERENCE L-CONTEXT BY REFERENCE ITEM-LIST-1(1) BY REFERENCE A-ZERO GIVING L-STAT. END PROGRAM COB_MAIL.