001000$CONTROL USLINIT 001100 IDENTIFICATION DIVISION. 001200 PROGRAM-ID. COBCMC. 001300 AUTHOR. TOM KIRBY, 3k Associates, Inc. 001400 ENVIRONMENT DIVISION. 001500 CONFIGURATION SECTION. 001600 SOURCE-COMPUTER. HP-3000. 001700 OBJECT-COMPUTER. HP-3000. 001800 DATA DIVISION. 001900 WORKING-STORAGE SECTION. 002000 002100* FIELDS USED BY CMC CALLS 002200 002300* CMC return code 002400 01 RC PIC 9(9) COMP VALUE 0. 002500 002600* CMC session id 002700 01 SID PIC 9(9) COMP VALUE 0. 002800 01 TEMP-ID PIC 9(9) COMP VALUE 0. 002900 003000* CMC message structure 003100 01 MSG. 003200 02 MSG-ENTRY OCCURS 2 TIMES. 003300 03 MESSAGE-REFERENCE PIC S9(9) BINARY VALUE 0. 003400 03 MESSAGE-TYPE PIC S9(9) BINARY VALUE 0. 003500 03 SUBJECT PIC S9(9) BINARY VALUE 0. 003600 03 TIME-SENT. 003700 04 FILLER OCCURS 3 TIMES PIC 9(9) COMP. 003800 03 TEXT-NOTE PIC S9(9) BINARY VALUE 0. 003900 03 RECIPIENTS PIC S9(9) BINARY VALUE 0. 004000 03 ATTACHMENTS PIC S9(9) BINARY VALUE 0. 004100 03 MESSAGE-FLAGS PIC S9(9) BINARY VALUE 0. 004200 03 MESSAGE-EXTENSIONS PIC S9(9) BINARY VALUE 0. 004300 004400* CMC flags parameter 004500 01 FLGS PIC 9(9) COMP VALUE 0. 004600 004700* CMC user interface ID (not used by us) 004800 01 UI-ID PIC 9(9) COMP VALUE 0. 004900 005000* NETMAIL user 005100 01 USER PIC X(17) VALUE SPACES. 005200 005300* NETMAIL user password 005400 01 PASS PIC X(9) VALUE SPACES. 005500 005600* CMC version (must match RL) 005700 01 VERS PIC 9(4) COMP VALUE 0. 005800 005900* CMC attachment structure 006000 01 ATTCH. 006100 02 A-ENTRY OCCURS 10 TIMES. 006200 03 ATTACH-TITLE PIC S9(9) BINARY VALUE 0. 006300 03 ATTACH-TYPE PIC 9(9) COMP VALUE 0. 006400 03 ATTACH-FILENAME PIC S9(9) BINARY VALUE 0. 006500 03 ATTACH-FLAGS PIC 9(9) COMP VALUE 0. 006600 03 ATTACH-EXTENSIONS PIC S9(9) BINARY VALUE 0. 006700 006800* CMC recipient structure 006900 01 RECPT. 007000 02 REC OCCURS 3 TIMES. 007100 03 RNAME PIC S9(9) BINARY. 007200 03 NAME-TYPE PIC S9(9) COMP. 007300 03 RADDRESS PIC S9(9) BINARY. 007400 03 ROLE PIC S9(9) COMP. 007500 03 RECIP-FLAGS PIC 9(9) COMP. 007600 03 RECIP-EXTENSIONS PIC S9(9) BINARY. 007700 007800* Another recipient structure for the second message in the 007900* message structure... 008000 01 RECPT-2. 008100 02 R2NAME PIC S9(9) BINARY. 008200 02 R2NAME-TYPE PIC S9(9) COMP. 008300 02 R2ADDRESS PIC S9(9) BINARY. 008400 02 R2ROLE PIC S9(9) COMP. 008500 02 R2RECIP-FLAGS PIC 9(9) COMP. 008600 02 R2RECIP-EXTENSIONS PIC S9(9) BINARY. 008700 008800* CMC extensions structure (not used) 008900 01 EXTENSIONS PIC S9(9) BINARY VALUE 0. 009000 009100* CMC object identifier (character set), also not used 009200 01 CHARSET PIC S9(9) BINARY VALUE 0. 009300 009400* CMC service (not used) 009500 01 SERVICE PIC S9(9) BINARY VALUE 0. 009600 009700* VARIABLES TO TAKE THE PLACE OF CMC DEFINES 009800 009900 01 CMC-MSG-TEXT-NOTE-AS-FILE PIC 9(9) COMP VALUE 2. 010000 01 CMC-RECIP-LAST-ELEMENT PIC 9(9) COMP. 010100 01 CMC-MSG-LAST-ELEMENT PIC 9(9) COMP. 010200 01 CMC-ATT-LAST-ELEMENT PIC 9(9) COMP. 010300 01 CMC-TYPE-INDIVIDUAL PIC 9(9) COMP VALUE 1. 010400 01 CMC-ROLE-TO PIC 9(9) COMP VALUE 0. 010500 01 CMC-ROLE-CC PIC 9(9) COMP VALUE 1. 010600 01 CMC-ROLE-BCC PIC 9(9) COMP VALUE 2. 010700 01 CMC-ATT-OID-BINARY. 010800 02 FILLER PIC X(18) VALUE "1 2 840 113658 1 1". 010900 02 FILLER PIC X VALUE %0. 011000 01 CMC-ATT-OID-TEXT. 011100 02 FILLER PIC X(20) VALUE "1 2 840 113658 1 1 0". 011200 02 FILLER PIC X VALUE %0. 011300 01 CMC-CONFIG-CHARACTER-SET PIC 9(9) COMP VALUE 1. 011400 01 CMC-CONFIG-LINE-TERM PIC 9(9) COMP VALUE 2. 011500 01 CMC-CONFIG-DEFAULT-SERVICE PIC 9(9) COMP VALUE 3. 011600 01 CMC-CONFIG-DEFAULT-USER PIC 9(9) COMP VALUE 4. 011700 01 CMC-CONFIG-REQ-PASSWORD PIC 9(9) COMP VALUE 5. 011800 01 CMC-CONFIG-REQ-SERVICE PIC 9(9) COMP VALUE 6. 011900 01 CMC-CONFIG-REQ-USER PIC 9(9) COMP VALUE 7. 012000 01 CMC-CONFIG-UI-AVAIL PIC 9(9) COMP VALUE 8. 012100 01 CMC-CONFIG-SUP-NOMKMSGREAD PIC 9(9) COMP VALUE 9. 012200 01 CMC-CONFIG-SUP-COUNTED-STR PIC 9(9) COMP VALUE 10. 012300 01 CMC-CONFIG-VER-IMPLEM PIC 9(9) COMP VALUE 11. 012400 01 CMC-CONFIG-VER-SPEC PIC 9(9) COMP VALUE 12. 012500 01 CMC-LINE-TERM-CRLF PIC 9(9) COMP VALUE 0. 012600 01 CMC-LINE-TERM-CR PIC 9(9) COMP VALUE 1. 012700 01 CMC-LINE-TERM-LF PIC 9(9) COMP VALUE 2. 012800 01 CMC-REQUIRED-NO PIC 9(9) COMP VALUE 0. 012900 01 CMC-REQUIRED-YES PIC 9(9) COMP VALUE 1. 013000 01 CMC-REQUIRED-OPT PIC 9(9) COMP VALUE 2. 013010 01 CMC-FALSE PIC 9(4) COMP VALUE 0. 013020 01 CMC-TRUE PIC 9(4) COMP VALUE 1. 013100 013200* WORK AREAS 013300 013400 01 II PIC S9(4) COMP VALUE 0. 013500 01 NULL-TERMINATOR PIC X VALUE LOW-VALUE. 013600 01 CARR-RET PIC X VALUE %15. 013700 01 NEWLINE PIC X VALUE %12. 013800 01 PTR1 PIC S9(9) BINARY VALUE 0. 013900 01 PTR2 PIC S9(9) BINARY VALUE 0. 014000 01 M-SUB PIC X(80) VALUE SPACES. 014100 01 A-FILE PIC X(80) VALUE SPACES. 014200 01 B-FILE PIC X(80) VALUE SPACES. 014300 01 NAME-WORK PIC X(30) VALUE SPACES. 014400 01 NAME-AND-ADDRESS. 014500 02 U-NAME OCCURS 3 TIMES PIC X(30). 014600 02 U-ADDR OCCURS 3 TIMES PIC X(80). 014700 01 U2-NAME PIC X(30). 014800 01 U2-ADDR PIC X(80). 014900 01 N-TEXT PIC X(256) VALUE SPACES. 015000 01 BIG-NUM PIC 9(16) COMP VALUE 0. 015100 01 LIL-NUMS REDEFINES BIG-NUM. 015200 02 FILLER PIC 9(9) COMP. 015300 02 LIL-NUM PIC 9(9) COMP. 015400 015500* FIELDS FOR CMC_SEND_DOCUMENTS 015600 015700* These appear in the CALL statement, and hold addresses... 015800 01 SD-ADDRESSES PIC S9(9) BINARY VALUE 0. 015900 01 SD-TEXT PIC S9(9) BINARY VALUE 0. 016000 01 SD-SUBJECT PIC S9(9) BINARY VALUE 0. 016100 01 SD-FILES PIC S9(9) BINARY VALUE 0. 016200 01 SD-FLAGS PIC 9(9) COMP VALUE 0. 016300 01 SD-TITLES PIC S9(9) BINARY VALUE 0. 016400 01 SD-DELIMITER PIC S9(9) BINARY VALUE 0. 016500 01 SD-UI-ID PIC 9(9) COMP VALUE 0. 016600 016700* These are pointed to by the fields in the CALL statement... 016800 01 SDS-ADDRESSES PIC X(256) VALUE SPACES. 016900 01 SDS-TEXT PIC X(256) VALUE SPACES. 017000 01 SDS-SUBJECT PIC X(80) VALUE SPACES. 017100 01 SDS-TITLES PIC X(256) VALUE SPACES. 017200 01 SDS-FILES PIC X(256) VALUE SPACES. 017300 01 SDS-DELIMITER PIC X VALUE ",". 017400 017500* FIELDS FOR CMC_QUERY_CONFIGURATION 017600 017800 01 CMC-ITEM PIC S9(9) COMP VALUE 0. 017900 01 CMC-ENUMVAL PIC S9(9) COMP VALUE 0. 018000 01 CMC-CELL PIC S9(9) BINARY VALUE 0. 018100 01 CMC-CELLPTR PIC S9(9) BINARY VALUE 0. 018200 01 CMC-BOOLEAN PIC 9(4) COMP VALUE 0. 018300 01 CMC-UINT PIC 9(4) COMP VALUE 0. 018400 018500 01 CELL-CONTENTS PIC X(60) VALUE SPACES. 018600 01 CELL-ADDR PIC S9(9) BINARY VALUE 0. 018700 018800 PROCEDURE DIVISION. 018900 XXXX-MAIN. 019000 MOVE LOW-VALUES TO RECPT, RECPT-2, MSG. 019100 MOVE 2147483648 TO BIG-NUM. 019200 MOVE LIL-NUM TO CMC-RECIP-LAST-ELEMENT 019300 CMC-ATT-LAST-ELEMENT 019400 CMC-MSG-LAST-ELEMENT. 019500 019600* 0000, 1000 and 3000 are used for mailing via CMC_SEND, while 2000 019700* is used for the CMC_SEND_DOCUMENTS method (simpler to use, but 019800* higher in overhead costs)... 019900 020000 PERFORM 4000-PRINT-CONFIG THRU 4999-EXIT. 020100 020200* PERFORM 0000-CMCLOGON THRU 0999-EXIT. 020300* PERFORM 1000-CMCSEND-FILE THRU 1999-EXIT. 020400* PERFORM 2000-CMCSENDDOC THRU 2999-EXIT. 020500* PERFORM 3000-CMCLOGOFF THRU 3999-EXIT. 020600 020700 STOP RUN. 020800 020900 0000-CMCLOGON. 021000* CMCLOGON 021100************************************************************* 021200* This will not be needed with CMC_send_document, but it is * 021300* needed with CMC_send. * 021400************************************************************* 021500 021600* UI-ID is not used anyway, set to 0 * 021700 MOVE 0 to UI-ID. 021800 021900* USER must be 16 or less characters, terminated with a \0 * 022000 STRING "MY_USER" NULL-TERMINATOR DELIMITED BY SIZE 022100 INTO USER. 022200* NOTE: If you wish to pass a NULL, you must move 0 to PTR1, 022300* because a string of spaces doth not a true NULL make. 022400* Otherwise, you can skip the PTR1 step and just pass 022500* the variable USER to the CMC routine. 022600* 022700* If you use PTR1, be sure to pass it as \PTR1\, because 022800* its value of 0 is what you really want to pass... 022900* MOVE 0 TO PTR1. 023000 023100* PASS must be 8 characters, terminated with a \0 * 023200 STRING "pAsSwOrD" NULL-TERMINATOR DELIMITED BY SIZE 023300 INTO PASS. 023400* NOTE: If you wish to pass a NULL, you must move 0 to PTR2, 023500* because a string of spaces doth not a true NULL make. 023600* Otherwise, you can skip the PTR2 step and just pass 023700* the variable PASS to the CMC routine. 023800* 023900* If you use PTR2, be sure to pass it as \PTR2\, because 024000* its value of 0 is what you really want to pass... 024100* MOVE 0 TO PTR2. 024200 024300* SERVICE, CHARACTER SET, AND EXTENSIONS ARE NOT USED, PASS NULLS. * 024400 024500* Programmed to specification 1.00 * 024600 MOVE 100 TO VERS. 024700 024800* Pass a 0 in FLGS because we don't support LOGON_UI, ERROR_UI, * 024900* or COUNTED_STRING_TYPE. * 025000 MOVE 0 TO FLGS. 025100 025200* SID is the session ID that must be used in all the other calls. * 025300 CALL "CMC_LOGON" USING \SERVICE\, USER, PASS, 025400 \CHARSET\, \UI-ID\, \VERS\, 025500 \FLGS\, SID, \EXTENSIONS\ 025600 GIVING RC. 025700 025800* I am just printing the return, you will probably want to stop * 025900* if you don't get a 0 return... * 026000 DISPLAY "LOGON = " RC. 026100 026200 0999-EXIT. 026300 EXIT. 026400 026500 1000-CMCSEND-FILE. 026600* CMCSEND 026700****************************************************************** 026800* There are two ways of sending a text file. First, there is the * 026900* sending as a file method. Here is how to do this method: * 027000****************************************************************** 027100 027200* FLGS is 0 because we don't support COUNTED_STRING_TYPE or any * 027300* of the UIs... * 027400 MOVE 0 TO FLGS. 027500 027600* To indicate that the message text is a file, we set the * 027700* CMC_MSG_TEXT_NOTE_AS_FILE flag in the CMC_message * 027800* structure. * 027900 MOVE 0 TO BIG-NUM. 028000 028100* NOTE: If you wish to set more than one of the flags, just add 028200* them together. If you need to set the CMC_MSG_LAST_ELEMENT 028300* flag, MOVE it to something like BIG-NUM first, add the 028400* others, and move the second half of BIG-NUM into your 028500* FLGS. I do this because COBOL may come up with funny 028600* results moving what is actually a 10-digit number into 028700* a field that specifies 9 (but will actually hold some of 028800* the low 10's)... 028900 029000* Set the CMC_MSG_TEXT_NOTE_AS_FILE flag * 029100 ADD CMC-MSG-TEXT-NOTE-AS-FILE TO BIG-NUM. 029200 MOVE LIL-NUM TO MESSAGE-FLAGS (1). 029300 029400* MESSAGE-REFERENCE, MESSAGE-TYPE are ignored. * 029500 029600* TEXT-NOTE is NULL in this case because the text is in a file. * 029700 MOVE 0 TO TEXT-NOTE (1). 029800 029900* SUBJECT is a string terminated by \0. * 030000 STRING "Re: Geoff's behavior..." NULL-TERMINATOR DELIMITED 030100 BY SIZE INTO M-SUB. 030200 CALL INTRINSIC ".LOC." USING M-SUB GIVING SUBJECT (1). 030300 030400* NOTE: The CMC routines were meant to be called from C, or some 030500* other pointer-intensive language. We must simulate this in 030600* COBOL, as in the above example... 030700 030800* Load attachments with attachment structures. * 030900 CALL INTRINSIC ".LOC." USING ATTCH GIVING ATTACHMENTS (1). 031000 031100* attach_title isn't used yet... * 031200* Actually, you can go ahead and put one in, but currently, the 031300* NETMAIL engine won't use it... 031400* If you do use TITLE, be sure to put POINTERS in these fields... 031500 MOVE 0 TO ATTACH-TITLE (1). 031600 MOVE 0 TO ATTACH-TITLE (2). 031700 031800* attach_type isn't used yet... * 031900* You can put one in, either CMC-ATT-OID-BINARY or -TEXT, but 032000* it will have no affect... 032100* If you do use TYPE, once again, these are POINTERS... 032200 MOVE 0 TO ATTACH-TYPE (1). 032300 MOVE 0 TO ATTACH-TYPE (2). 032400 032500* Set the ATT_LAST_ELEMENT flag in the second entry... * 032600 MOVE 0 TO ATTACH-FLAGS (1). 032700 MOVE CMC-ATT-LAST-ELEMENT TO ATTACH-FLAGS (2). 032800 032900* attach_filename is a string terminated by a \0... * 033000 STRING "FILE.GRP.ACCT01" NULL-TERMINATOR DELIMITED BY SIZE 033100 INTO A-FILE. 033200 CALL INTRINSIC ".LOC." USING A-FILE 033300 GIVING ATTACH-FILENAME (1). 033400 STRING "FILE.GRP.ACCT02" NULL-TERMINATOR 033500 DELIMITED BY SIZE INTO B-FILE. 033600 CALL INTRINSIC ".LOC." USING B-FILE 033700 GIVING ATTACH-FILENAME (2). 033800 033900* Load recipients with the address of our recipient array... * 034000 CALL INTRINSIC ".LOC." USING RECPT GIVING RECIPIENTS (1). 034100 034200* name and address must be strings terminated with a \0... * 034300 STRING "JOHN Q. PUBLIC" NULL-TERMINATOR DELIMITED BY SIZE 034400 INTO U-NAME (1). 034500 STRING "ME@HERE.COM" NULL-TERMINATOR DELIMITED BY SIZE 034600 INTO U-ADDR (1). 034700 034800 CALL INTRINSIC ".LOC." USING U-NAME (1) GIVING RNAME (1). 034900 MOVE CMC-TYPE-INDIVIDUAL TO NAME-TYPE (1). 035000 CALL INTRINSIC ".LOC." USING U-ADDR (1) GIVING RADDRESS (1). 035100 035200* This one (entry 0) goes on the "TO:" list... * 035300 MOVE CMC-ROLE-TO TO ROLE (1). 035400 035500* The recip_flags available are CMC_RECIP_IGNORE, * 035600* CMC_RECIP_LIST_TRUNCATED, and CMC_RECIP_LAST_ELEMENT. * 035700* We don't need any of these for this recipient... * 035800 MOVE 0 TO RECIP-FLAGS (1). 035900 036000* Same stuff for entry 1... * 036100 STRING "JOHN DOE" NULL-TERMINATOR DELIMITED BY SIZE 036200 INTO U-NAME (2). 036300 STRING "YOU@THERE.COM" NULL-TERMINATOR DELIMITED BY SIZE 036400 INTO U-ADDR (2). 036500 CALL INTRINSIC ".LOC." USING U-NAME (2) GIVING RNAME (2). 036600 CALL INTRINSIC ".LOC." USING U-ADDR (2) GIVING RADDRESS (2). 036700 MOVE CMC-TYPE-INDIVIDUAL TO NAME-TYPE (2). 036800 036900* This one (entry 1) goes on the "CC:" list... * 037000 MOVE CMC-ROLE-CC TO ROLE (2). 037100 MOVE 0 TO RECIP-FLAGS (2). 037200 037300* Entry 2, same story (almost)... * 037400 STRING "CAPTAIN E-MAIL" NULL-TERMINATOR DELIMITED BY SIZE 037500 INTO U-NAME (3). 037600 STRING "BOSS@HERE.COM" NULL-TERMINATOR DELIMITED BY SIZE 037700 INTO U-ADDR (3). 037800 CALL INTRINSIC ".LOC." USING U-NAME (3) GIVING RNAME (3). 037900 CALL INTRINSIC ".LOC." USING U-ADDR (3) GIVING RADDRESS (3). 038000 MOVE CMC-TYPE-INDIVIDUAL TO NAME-TYPE (3). 038100 038200* Entry 2 is goes on the "BCC:" list... * 038300 MOVE CMC-ROLE-BCC TO ROLE (3). 038400* Last recipient, set the flag... * 038500 MOVE CMC-RECIP-LAST-ELEMENT TO RECIP-FLAGS (3). 038600 038700* 2nd message... 038800 038900* NO ATTACHMENTS used in this message... 039000 MOVE 0 TO ATTACHMENTS (2). 039100 039200* Notice that this time around, CMC_MSG_TEXT_NOTE_AS_FILE is * 039300* *NOT* set, but I am setting CMC-MSG-LAST-ELEMENT... * 039400 MOVE CMC-MSG-LAST-ELEMENT TO MESSAGE-FLAGS (2). 039500 CALL INTRINSIC ".LOC." USING M-SUB GIVING SUBJECT (2). 039600 039700* Load the message into text_note, terminated by a \0... * 039800 STRING "NOTHING IN PARTICULAR" CARR-RET NEWLINE 039900 NULL-TERMINATOR DELIMITED BY SIZE INTO N-TEXT. 040000 CALL INTRINSIC ".LOC." USING N-TEXT GIVING TEXT-NOTE (2). 040100 040200* Load recipients with the address of our recipient array... * 040300 CALL INTRINSIC ".LOC." USING RECPT-2 GIVING RECIPIENTS (2). 040400 040500 STRING "CAPTAIN E-MAIL" NULL-TERMINATOR DELIMITED BY SIZE 040600 INTO U2-NAME. 040700 STRING "YOU@THERE.COM" NULL-TERMINATOR DELIMITED BY SIZE 040800 INTO U2-ADDR. 040900 CALL INTRINSIC ".LOC." USING U2-NAME GIVING R2NAME. 041000 CALL INTRINSIC ".LOC." USING U2-ADDR GIVING R2ADDRESS. 041100 MOVE CMC-TYPE-INDIVIDUAL TO R2NAME-TYPE. 041200 041300 MOVE CMC-ROLE-TO TO R2ROLE. 041400 MOVE CMC-RECIP-LAST-ELEMENT TO R2RECIP-FLAGS. 041500 041600 CALL "CMC_SEND" USING \SID\, MSG, \FLGS\, \UI-ID\, 041700 \EXTENSIONS\ 041800 GIVING RC. 041900 042000* I am just printing the return, you will probably want to stop * 042100* if you don't get a 0 return... * 042200 DISPLAY "SEND(1) = " RC. 042300 042400 1999-EXIT. 042500 EXIT. 042600 042700 2000-CMCSENDDOC. 042800 042900* SET UP ADDRESSES 043000 STRING "YOU@THERE.COM" SDS-DELIMITER "ME@HERE.COM" 043100 SDS-DELIMITER 043200 "BCC:BOSS@HERE.COM" NULL-TERMINATOR DELIMITED BY SIZE 043300 INTO SDS-ADDRESSES. 043400 043500* SET UP TEXT 043600 STRING "Thou art lucky. I have sent thee a document." 043700 NULL-TERMINATOR DELIMITED BY SIZE 043800 INTO SDS-TEXT. 043900* If you have no text, use the next line in place of the above, 044000* and replace SDS-TEXT with \SD-TEXT\ on the CALL statement... 044100* MOVE 0 TO SD-TEXT. 044200 044300* SET UP SUBJECT 044400 STRING "ALMOST FREE UNLIMITED TIME OFFER!" NULL-TERMINATOR 044500 DELIMITED BY SIZE INTO SDS-SUBJECT. 044600* If you have no subject, use the next line in place of the above, 044700* and replace SDS-SUBJECT with \SD-SUBJECT\ on the CALL statement... 044800* MOVE 0 TO SD-SUBJECT. 044900 045000* SET UP TITLES 045100 STRING "Some Text" SDS-DELIMITER "A Program" NULL-TERMINATOR 045200 DELIMITED BY SIZE INTO SDS-TITLES. 045300* If you have no titles, use the next line in place of the above, 045400* and replace SDS-TITLES with \SD-TITLES\ on the CALL statement... 045500* MOVE 0 TO SD-TITLES. 045600 045700* SET UP FILES 045800 STRING "FILE.GRP.ACCT01" SDS-DELIMITER "FILE.GRP.ACCT02" 045900 NULL-TERMINATOR DELIMITED BY SIZE INTO SDS-FILES. 046000* If you have no files, use the next line in place of the above, 046100* and replace SDS-FILES with \SD-FILES\ on the CALL statement... 046200* MOVE 0 TO SD-FILES. 046300 046400* NOTE: SDS-DELIMITER and SDS-ADDRESS are always required, so they 046500* can be passed straight. SDS-TEXT, SDS-FILES, and SDS-TITLES 046600* may be null, and since this is NOT an OPTION VARIABLE 046700* procedure, the address of 0 must be passed. It is put in a 046800* variable to make sure there is not confusion: a 32-bit 0 046900* address is passed. SD-UI-ID and SD-FLAGS are passed by 047000* value. If you plan to use SDS-TEXT, SDS-FILES and/or 047100* SDS-TITLES, you may pass them directly. 047200 047300* LEAVE FLAGS AT 0 THIS TIME. 047400 047500* CALL... 047600 CALL "CMC_SEND_DOCUMENTS" USING SDS-ADDRESSES, SDS-SUBJECT, 047700 SDS-TEXT, \SD-FLAGS\, SDS-FILES, 047800 SDS-TITLES, SDS-DELIMITER, 047900 \SD-UI-ID\ 048000 GIVING RC. 048100 048200 DISPLAY "SEND_DOC = " RC. 048300 048400 2999-EXIT. 048500 EXIT. 048600 048700 3000-CMCLOGOFF. 048800* CMCLOGOFF * 048900* Set FLGS to 0 because we don't support any UIs... * 049000 MOVE 0 TO FLGS. 049100 049200 CALL "CMC_LOGOFF" USING \SID\, \UI-ID\, \FLGS\, 049300 \EXTENSIONS\ 049400 GIVING RC. 049500 049600* I am just printing the return, you will probably want to stop * 049700* if you don't get a 0 return... * 049800 DISPLAY "LOGOFF = " RC. 049900 050000 3999-EXIT. 050100 EXIT. 050200 050300 4000-PRINT-CONFIG. 050400 050500* NOTE: Some items returned by cmc_query_configuration are malloc'ed 050600* pointers, which COBOL cannot read directly. Therefore, a new 050700* routine, cmc_cobol_cell_read, is used to move data from these 050800* pointers into static WORKING-STORAGE areas. 050900 051000* We will use TEMP-ID and its current value, because we aren't 051100* actually logging on... 051200 051300* First, what character sets are available? 051400 051500 MOVE CMC-CONFIG-CHARACTER-SET TO CMC-ITEM. 051800 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 051900 CMC-CELLPTR, 052000 \EXTENSIONS\ 052100 GIVING RC. 052200 IF RC = 0 052300 CALL "CMC_COBOL_CELL_READ" USING \CMC-CELLPTR\, CELL-ADDR, 052400 4, 1 052500 PERFORM VARYING II FROM 1 BY 1 UNTIL CELL-ADDR = 0 052510 MOVE SPACES TO CELL-CONTENTS 052600 CALL "CMC_COBOL_CELL_READ" USING \CELL-ADDR\, 052700 CELL-CONTENTS, 052800 60, 0 052900 DISPLAY "Char set: " CELL-CONTENTS 053000 CALL "CMC_FREE" USING \CELL-ADDR\ 053100 COMPUTE CMC-CELL = CMC-CELLPTR + (II * 4) 053200 CALL "CMC_COBOL_CELL_READ" USING \CMC-CELL\, 053300 CELL-ADDR, 4, 1 053400 END-PERFORM 053500 CALL "CMC_FREE" USING \CMC-CELLPTR\ 053600 ELSE 053700 DISPLAY "Char set: ???". 053800 053900* Next, what do we use as a line terminator? 054000 054100 MOVE CMC-CONFIG-LINE-TERM TO CMC-ITEM. 054400 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 054500 CMC-ENUMVAL, 054600 \EXTENSIONS\ 054700 GIVING RC. 054800 DISPLAY "Line terminator: " WITH NO ADVANCING. 054900 IF RC = 0 055000 EVALUATE CMC-ENUMVAL 055100 WHEN CMC-LINE-TERM-CRLF 055200 DISPLAY "CR/LF" 055300 WHEN CMC-LINE-TERM-LF 055400 DISPLAY "LF" 055500 WHEN CMC-LINE-TERM-CR 055600 DISPLAY "CR" 055700 WHEN OTHER 055800 DISPLAY "BOGUS RETURN!" 055900 END-EVALUATE 056000 ELSE 056100 DISPLAY "???". 056200 056300* Next, what default service? 056400 056500 MOVE CMC-CONFIG-DEFAULT-SERVICE TO CMC-ITEM. 056800 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 056900 CMC-CELL, 057000 \EXTENSIONS\ 057100 GIVING RC. 057200 IF RC = 0 057210 MOVE SPACES TO CELL-CONTENTS 057300 CALL "CMC_COBOL_CELL_READ" USING \CMC-CELL\, 057400 CELL-CONTENTS, 057500 60, 0 057600 DISPLAY "Default service: " CELL-CONTENTS 057700 CALL "CMC_FREE" USING \CMC-CELL\ 057800 ELSE 057900 DISPLAY "Default service: ???". 058000 058100* Next, what default user? 058200 058300 MOVE CMC-CONFIG-DEFAULT-USER TO CMC-ITEM. 058600 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 058700 CMC-CELL, 058800 \EXTENSIONS\ 058900 GIVING RC. 059000 IF RC = 0 059010 MOVE SPACES TO CELL-CONTENTS 059100 CALL "CMC_COBOL_CELL_READ" USING \CMC-CELL\, 059200 CELL-CONTENTS, 059300 16, 0 059400 DISPLAY "Default user: " CELL-CONTENTS 059500 CALL "CMC_FREE" USING \CMC-CELL\ 059600 ELSE 059700 DISPLAY "Default user: ???". 059800 059810* Next, is a password required? 059820 059830 MOVE CMC-CONFIG-REQ-PASSWORD TO CMC-ITEM. 059860 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 059870 CMC-ENUMVAL, 059880 \EXTENSIONS\ 059890 GIVING RC. 059891 DISPLAY "Password: " WITH NO ADVANCING. 059892 IF RC = 0 059893 EVALUATE CMC-ENUMVAL 059894 WHEN CMC-REQUIRED-NO 059895 DISPLAY "Not required" 059896 WHEN CMC-REQUIRED-YES 059897 DISPLAY "Required" 059898 WHEN CMC-REQUIRED-OPT 059899 DISPLAY "Optional" 059950 WHEN OTHER 059960 DISPLAY "BOGUS RETURN!" 059970 END-EVALUATE 059980 ELSE 059990 DISPLAY "???". 062200 062300* Next, is a service name required? 062310 062410 MOVE CMC-CONFIG-REQ-SERVICE TO CMC-ITEM. 062440 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 062450 CMC-ENUMVAL, 062460 \EXTENSIONS\ 062470 GIVING RC. 062480 DISPLAY "Service name: " WITH NO ADVANCING. 062490 IF RC = 0 062491 EVALUATE CMC-ENUMVAL 062492 WHEN CMC-REQUIRED-NO 062493 DISPLAY "Not required" 062494 WHEN CMC-REQUIRED-YES 062495 DISPLAY "Required" 062496 WHEN CMC-REQUIRED-OPT 062497 DISPLAY "Optional" 062498 WHEN OTHER 062499 DISPLAY "BOGUS RETURN!" 062570 END-EVALUATE 062580 ELSE 062590 DISPLAY "???". 064600 064710* Next, is a user name required? 064720 064730 MOVE CMC-CONFIG-REQ-USER TO CMC-ITEM. 064760 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 064770 CMC-ENUMVAL, 064780 \EXTENSIONS\ 064790 GIVING RC. 064791 DISPLAY "User: " WITH NO ADVANCING. 064792 IF RC = 0 064793 EVALUATE CMC-ENUMVAL 064794 WHEN CMC-REQUIRED-NO 064795 DISPLAY "Not required" 064796 WHEN CMC-REQUIRED-YES 064797 DISPLAY "Required" 064798 WHEN CMC-REQUIRED-OPT 064799 DISPLAY "Optional" 064840 WHEN OTHER 064850 DISPLAY "BOGUS RETURN!" 064860 END-EVALUATE 064870 ELSE 064880 DISPLAY "???". 064890 064900* Next, do we support any user interfaces? 065000 065100 MOVE CMC-CONFIG-UI-AVAIL TO CMC-ITEM. 065200 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 065300 CMC-BOOLEAN, 065400 \EXTENSIONS\ 065500 GIVING RC. 065600 IF RC = 0 065700 IF CMC-BOOLEAN = CMC-TRUE 065800 DISPLAY "UI: Available" 065900 ELSE 066000 DISPLAY "UI: Not Available" 066100 ELSE 066200 DISPLAY "UI: ???". 068100 068210* Next, is DO_NOT_MARK_AS_READ supported? 068220 068230 MOVE CMC-CONFIG-SUP-NOMKMSGREAD TO CMC-ITEM. 068240 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 068250 CMC-BOOLEAN, 068260 \EXTENSIONS\ 068270 GIVING RC. 068280 IF RC = 0 068290 IF CMC-BOOLEAN = CMC-TRUE 068291 DISPLAY "DO_NOT_MARK_AS_READ supported: Yes" 068292 ELSE 068293 DISPLAY "DO_NOT_MARK_AS_READ supported: No" 068294 ELSE 068295 DISPLAY "DO_NOT_MARK_AS_READ supported: ???". 069200 069310* Next, is DO_NOT_MARK_AS_READ supported? 069320 069330 MOVE CMC-CONFIG-SUP-COUNTED-STR TO CMC-ITEM. 069340 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 069350 CMC-BOOLEAN, 069360 \EXTENSIONS\ 069370 GIVING RC. 069380 IF RC = 0 069390 IF CMC-BOOLEAN = CMC-TRUE 069391 DISPLAY "Counted string: Supported" 069392 ELSE 069393 DISPLAY "Counted string: Not supported" 069394 ELSE 069395 DISPLAY "Counted string: ???". 070300 070310* Next, which version is this implementation? 070320 070330 MOVE CMC-CONFIG-VER-IMPLEM TO CMC-ITEM. 070340 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 070350 CMC-UINT, 070360 \EXTENSIONS\ 070370 GIVING RC. 070380 IF RC = 0 070390 DISPLAY "Version (implementation): " CMC-UINT 070430 ELSE 070431 DISPLAY "Version (implementation): ???". 071100 071110* Finally, which version is our specification? 071111 071120 MOVE CMC-CONFIG-VER-SPEC TO CMC-ITEM. 071130 CALL "CMC_QUERY_CONFIGURATION" USING \TEMP-ID\, \CMC-ITEM\, 071140 CMC-UINT, 071150 \EXTENSIONS\ 071160 GIVING RC. 071170 IF RC = 0 071180 DISPLAY "Version (specs): " CMC-UINT 071190 ELSE 071200 DISPLAY "Version (specs): ???". 071300 071900 4999-EXIT. 072000 EXIT.