* AS WRITTEN, THIS PROGRAM REQUIRES THE FOLLOWING CBL OPTIONS. * CBL MAP,XREF(SHORT),OFFSET,TEST(ALL,SYM),APOST,LIB * CBL TRUNC(BIN),NOZWB * CBL DATA(31),RMODE(ANY) IDENTIFICATION DIVISION. PROGRAM-ID. BSTTEZ23. * * COPYRIGHT TEI 2008-2011 * * THIS PROGRAM TEST THE FTP CONTROL FUNCTIONS OF BSTTEZ20. * * SEE COMMENTS IN BSTTEZ20. * * CHANGE LOG: * MAR 24, 2008 TT NEW PROGRAM. * TT = TONY THIGPEN TONY@VSE2PDF.COM * APR 07, 2008 TT ADDED RI-TSQ-COUNT * APR 07, 2008 TT ADDED ITEM NUMBER TO FIRST TSQ READ ENVIRONMENT DIVISION. CONFIGURATION SECTION. DATA DIVISION. WORKING-STORAGE SECTION. 01 PROGRAM-INFOMATION. 05 PROGRAM-NAME PIC X(08) VALUE 'BSTTEZ23'. 05 PROGRAM-TITLE PIC X(26) VALUE 'EZA FTP TESTING PROGRAM'. 01 LOCAL-SETTINGS. 05 BSTTEZ20 PIC X(08) VALUE 'BSTTEZ20'. 05 LOCAL-HOST PIC X(128) VALUE 'VSE2PDF.COM '. 05 LOCAL-PORT PIC 9(04) VALUE 21. 05 LOCAL-USERID PIC X(32) VALUE 'XXXXXXXX'. 05 LOCAL-PASSWORD PIC X(32) VALUE 'XXXXXX'. 05 LOCAL-DIRECTORY PIC X(32) VALUE SPACES. 01 REQUEST-INFO. 05 RI-SYSID PIC X(02). 05 RI-DEBUG-FLAG PIC X(01). 88 RI-DEBUG-CONSOLE VALUE 'C'. 05 RI-HOST PIC X(128). 05 RI-PORT PIC 9(04) COMP. 05 RI-USERID PIC X(32). 05 RI-PASSWORD PIC X(32). 05 RI-DIRECTORY PIC X(32). 05 RI-COMMAND-COUNT PIC S9(04) COMP. 05 RI-COMMAND-COUNT-DONE PIC S9(04) COMP. 05 RI-COMMAND-COUNT-ERRORS PIC S9(04) COMP. 05 RI-ERROR-MSG PIC X(30). 05 RI-COMMANDS OCCURS 0050. 10 RI-COMMAND PIC X(256). 10 RI-TSQ PIC X(08). 10 RI-TSQ-RECSIZE PIC 9(09). 10 RI-TSQ-COUNT PIC 9(09). 10 RI-TSQ-ENCODING PIC X(01). 88 RI-TSQ-ASCII VALUE 'A'. 88 RI-TSQ-BINARY VALUE 'B'. 88 RI-TSQ-EBCDIC VALUE 'E'. 10 RI-OPTIONAL PIC X(01). 88 RI-IS-OPTIONAL VALUE 'Y'. 10 RI-STATUS PIC X(01). 88 RI-NOT-PROCESSED VALUE 'N'. 88 RI-GOOD VALUE 'G'. 88 RI-BAD-RESPONSE VALUE 'B'. 88 RI-INCOMPLETE-TRANSFER VALUE 'I'. 88 RI-INVALID-QUEUE VALUE 'Q'. 88 RI-RESPONSE-TRUNCATED VALUE 'T'. 88 RI-ERRORS VALUE 'B' 'I' 'Q' 'T'. 10 RI-RC PIC X(03). 10 RI-MESSAGE PIC X(256). 01 REQUEST-INFO-LENGTH PIC S9(04) COMP. 01 ABEND-INFORMATION. 03 CURRENT-FUNCTION PIC X(20) VALUE SPACES. 03 CURRENT-ERROR PIC 9(05) VALUE ZEROES. 03 FILLER PIC X(01) VALUE SPACES. 03 ABEND-CODE PIC 9(04) VALUE ZEROS. 01 MESSAGES. 05 MSG-DONE PIC X(10) VALUE 'EZ23 DONE '. 05 MSG-INVALID-RESPONSE PIC X(31) VALUE 'EZ23 INVALID RESPONSE RECEIVED.'. 05 WS-MESSAGE-TAG PIC X(03). 05 WS-MESSAGE PIC X(100). 05 MSG-EZA. 10 MSG-EZA-TRAN PIC X(04). 10 FILLER PIC X(01). 10 MSG-EZA-TASK PIC 9(07). 10 FILLER PIC X(01). 10 MSG-EZA-FUNCTION PIC X(16). 01 BUFFER-SIZES. 05 WORK-AREA-LENGTH PIC S9(09) COMP. 01 WORK-AREA. 05 WA-BYTE PIC X(01) OCCURS 32767. 01 WS-AREA. 05 WS-SUB0 PIC S9(09) COMP. 05 WS-SUB1 PIC S9(09) COMP. 05 WS-RISUB1 PIC S9(09) COMP. 05 WS-WASUB1X. 10 WS-WASUB1 PIC S9(09) COMP. 05 WS-WORK9LIT PIC X(08). 05 WS-WORK9 PIC 9(09). 05 WS-FCI PIC X(01). 88 HAVE-TERMINAL VALUE X'01'. 01 TEST-DATA. 05 FILLER PIC X(30) VALUE '123456789012345678901234567890'. 05 FILLER PIC X(30) VALUE 'LINE 2 '. 05 FILLER PIC X(30) VALUE 'LINE 3 '. 05 FILLER PIC X(30) VALUE 'LINE 4 '. 05 FILLER PIC X(30) VALUE 'LINE 5 '. 05 FILLER PIC X(30) VALUE 'LINE 6 '. 05 FILLER PIC X(30) VALUE 'LINE 7 '. 05 FILLER PIC X(30) VALUE 'LINE 8 '. 05 FILLER PIC X(30) VALUE 'LINE 9 '. 05 FILLER PIC X(30) VALUE 'LINE 10 '. 05 WS-TDMAX PIC S9(09) COMP VALUE +10. PROCEDURE DIVISION. MAINLINE SECTION. ML-START. EXEC CICS ASSIGN FCI(WS-FCI) NOHANDLE END-EXEC. IF LENGTH OF REQUEST-INFO IS GREATER THAN 32767 GO TO AR-0001. MOVE LENGTH OF REQUEST-INFO TO REQUEST-INFO-LENGTH. MOVE LENGTH OF WORK-AREA TO WORK-AREA-LENGTH. ML-X-BUILD-QUEUE. EXEC CICS DELETEQ TS QUEUE('TSQSTOR') NOHANDLE END-EXEC. MOVE +1 TO WS-SUB1. ML-XLOOP. COMPUTE WS-SUB0 = (WS-SUB1 - 1) * 30 + 1. EXEC CICS WRITEQ TS QUEUE('TSQSTOR') FROM(TEST-DATA(WS-SUB0:)) LENGTH(30) END-EXEC. ADD +1 TO WS-SUB1. IF WS-SUB1 IS NOT GREATER THAN WS-TDMAX GO TO ML-XLOOP. ML-REQUEST-INFO. MOVE LOW-VALUES TO REQUEST-INFO. MOVE LOCAL-HOST TO RI-HOST. MOVE LOCAL-PORT TO RI-PORT. MOVE LOCAL-USERID TO RI-USERID. MOVE LOCAL-PASSWORD TO RI-PASSWORD. MOVE SPACES TO LOCAL-DIRECTORY. MOVE SPACES TO RI-DIRECTORY. * SET RI-DEBUG-CONSOLE TO TRUE. MOVE 'RETR wifi_home' TO RI-COMMAND (01). MOVE 'TSQRETR' TO RI-TSQ (01). MOVE +0 TO RI-TSQ-RECSIZE (01). SET RI-TSQ-EBCDIC (01) TO TRUE. EXEC CICS DELETEQ TS QUEUE(RI-TSQ(01)) NOHANDLE END-EXEC. MOVE 'TYPE I ' TO RI-COMMAND (02). MOVE 'STOR commands' TO RI-COMMAND (03). MOVE 'TSQSTOR' TO RI-TSQ (03). MOVE +0 TO RI-TSQ-RECSIZE (03). MOVE +10 TO RI-TSQ-COUNT (03). SET RI-TSQ-EBCDIC (03) TO TRUE. MOVE 'NOOP' TO RI-COMMAND (04). MOVE 'NOOP' TO RI-COMMAND (05). MOVE +05 TO RI-COMMAND-COUNT. ML-BSTTEZ20. EXEC CICS LINK PROGRAM(BSTTEZ20) COMMAREA(REQUEST-INFO) LENGTH(REQUEST-INFO-LENGTH) END-EXEC. ML-DISPLAY. MOVE 'COUNT' TO WS-WORK9LIT. MOVE RI-COMMAND-COUNT TO WS-WORK9. EXEC CICS WRITE OPERATOR TEXT(WS-WORK9LIT) TEXTLENGTH(17) END-EXEC. MOVE 'DONE' TO WS-WORK9LIT. MOVE RI-COMMAND-COUNT-DONE TO WS-WORK9. EXEC CICS WRITE OPERATOR TEXT(WS-WORK9LIT) TEXTLENGTH(17) END-EXEC. MOVE 'ERRORS' TO WS-WORK9LIT. MOVE RI-COMMAND-COUNT-ERRORS TO WS-WORK9. EXEC CICS WRITE OPERATOR TEXT(WS-WORK9LIT) TEXTLENGTH(17) END-EXEC. EXEC CICS WRITE OPERATOR TEXT(RI-ERROR-MSG) TEXTLENGTH(30) END-EXEC. MOVE +0 TO WS-RISUB1. ML-LOOP. ADD +1 TO WS-RISUB1. IF WS-RISUB1 IS GREATER THAN RI-COMMAND-COUNT GO TO ML-LOOP-END. EXEC CICS WRITE OPERATOR TEXT(RI-COMMAND(WS-RISUB1)) TEXTLENGTH(30) END-EXEC. EXEC CICS WRITE OPERATOR TEXT(RI-STATUS(WS-RISUB1)) TEXTLENGTH(120) END-EXEC. IF RI-TSQ (WS-RISUB1) IS NOT EQUAL TO SPACES AND RI-TSQ (WS-RISUB1) IS NOT EQUAL TO LOW-VALUES PERFORM SHOW-TSQ. GO TO ML-LOOP. ML-LOOP-END. ML-DONE. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(MSG-DONE) LENGTH(LENGTH OF MSG-DONE) ERASE END-EXEC EXEC CICS SEND CONTROL FREEKB END-EXEC ELSE EXEC CICS WRITE OPERATOR TEXT(MSG-DONE) TEXTLENGTH(LENGTH OF MSG-DONE) END-EXEC. EXEC CICS RETURN END-EXEC. ML-EXIT. GOBACK. SHOW-TSQ SECTION. ST-START. EXEC CICS WRITE OPERATOR TEXT(RI-TSQ(WS-RISUB1)) TEXTLENGTH(8) END-EXEC. MOVE 'COUNT ' TO WS-WORK9LIT. MOVE RI-TSQ-COUNT (WS-RISUB1) TO WS-WORK9. EXEC CICS WRITE OPERATOR TEXT(WS-WORK9LIT) TEXTLENGTH(17) END-EXEC. MOVE WORK-AREA-LENGTH TO WS-WASUB1. EXEC CICS READQ TS QUEUE(RI-TSQ(WS-RISUB1)) INTO(WORK-AREA) ITEM(1) LENGTH(WS-WASUB1X(3:2)) NOHANDLE END-EXEC. GO TO ST-READ-RESP. ST-READ. MOVE WORK-AREA-LENGTH TO WS-WASUB1. EXEC CICS READQ TS QUEUE(RI-TSQ(WS-RISUB1)) INTO(WORK-AREA) LENGTH(WS-WASUB1X(3:2)) NOHANDLE END-EXEC. ST-READ-RESP. IF EIBRESP IS EQUAL TO DFHRESP(QIDERR) GO TO ST-NOTFOUND. IF EIBRESP IS EQUAL TO DFHRESP(ITEMERR) GO TO ST-EOF. EXEC CICS WRITE OPERATOR TEXT(WORK-AREA) TEXTLENGTH(WS-WASUB1) END-EXEC. GO TO ST-READ. ST-EOF. GO TO ST-EXIT. ST-NOTFOUND. EXEC CICS WRITE OPERATOR TEXT('TS QUEUE NOT FOUND') TEXTLENGTH(18) END-EXEC. ST-EXIT. EXIT. ABEND SECTION. AR-0001. MOVE 0001 TO ABEND-CODE. GO TO AR-ABEND. AR-ABEND. * MOVE EZA-ERRNO TO CURRENT-ERROR. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(ABEND-INFORMATION) LENGTH(LENGTH OF ABEND-INFORMATION) ERASE END-EXEC EXEC CICS SEND CONTROL FREEKB END-EXEC. EXEC CICS WRITE OPERATOR TEXT(ABEND-INFORMATION) TEXTLENGTH(LENGTH OF ABEND-INFORMATION) END-EXEC. EXEC CICS ABEND ABCODE(ABEND-CODE) END-EXEC. AR-EXIT. EXIT.