000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM71. 00020000 000300*AUTHOR. Kenneth W. Caldwell. 00030000 000400*INSTALLATION. Train-Right. 00040000 000500*DATE-WRITTEN. January 1, 2011. 00050000 000600*DATE-COMPILED. 00060000 000700* 00070000 000800*SECURITY. This program is for students of Train-Right 00080000 000900* courses ONLY!. 00090000 001000* 00100000 001100*REMARKS. This is a 3270 and TCP/IP Web based program. 00110000 001200* It either receives a 3270 terminal request or 00120000 001300* it process a query string from a invoking URL. 00130000 001400* 00140000 001500 DATA DIVISION. 00150000 001600 WORKING-STORAGE SECTION. 00160000 001700 01. 00170000 001800 05 query-string-length PIC S9(8) BINARY. 00180000 001900 05 query-string-count PIC S9(4) BINARY VALUE ZERO. 00190000 002000 05 query-string PIC X(20) VALUE SPACES. 00200000 002100 05 query-string-symbol PIC X(11) VALUE SPACES. 00210000 002200 05 query-string-value PIC X(8) VALUE SPACES. 00220000 002300 00230000 002400 05 pgm-choice PIC 9 PACKED-DECIMAL. 00240000 002500 05 result. 00250000 002600 10. 00260000 002700 15 user-input. 00270000 002800 20 user-tranid PIC X(5) VALUE SPACES. 00280000 002900 20 user-choice PIC X(8) VALUE SPACES. 00290000 003000 15 PIC X(67) VALUE SPACES. 00300000 003100 10 msg1 PIC X(80). 00310000 003200 10 msg2 PIC X(80) VALUE 00320000 003300 'Change your choice and press ENTER to play again. Cle00330000 003400- 'ar screen to stop playing.'. 00340000 003500 00350000 003600 PROCEDURE DIVISION. 00360000 003700 Main. 00370000 003800 COMPUTE pgm-choice ROUNDED = 00380000 003900 FUNCTION RANDOM(eibtaskn + eibtime) * 2 00390000 004000 END-COMPUTE. 00400000 004100 00410000 004200 Receive-Trans-Input. 00420000 004300 EXEC CICS IGNORE CONDITION LENGERR END-EXEC. 00430000 004400 00440000 004500 IF eibtrnid = 'CWBA' 00450000 004600 THEN MOVE LENGTH OF query-string TO query-string-length 00460000 004700 00470000 004800 EXEC CICS WEB EXTRACT QUERYSTRING(query-string) 00480000 004900 QUERYSTRLEN(query-string-length) 00490000 005000 END-EXEC 00500000 005100 MOVE FUNCTION UPPER-CASE(query-string) TO query-string 00510000 005200 00520000 005300 UNSTRING query-string 00530000 005400 DELIMITED BY '=' 00540000 005500 INTO query-string-symbol 00550000 005600 query-string-value 00560000 005700 TALLYING IN query-string-count 00570000 005800 ON OVERFLOW CONTINUE 00580000 005900 END-UNSTRING 00590000 006000 00600000 006100 IF query-string-count = 1 00610000 006200 THEN MOVE query-string-symbol TO user-choice 00620000 006300 ELSE MOVE query-string-value TO user-choice 00630000 006400 END-IF 00640000 006500 ELSE 00650000 006600 EXEC CICS RECEIVE INTO(user-input) 00660000 006700 MAXFLENGTH(LENGTH OF user-input) 00670000 006800 END-EXEC 00680000 006900 END-IF. 00690000 007000 00700000 007100 Process-Data. 00710000 007200 EVALUATE user-choice ALSO pgm-choice 00720000 007300 WHEN 'ROCK' ALSO 0 00730000 007400 MOVE 'Two Rocks is a tie.' TO msg1 00740000 007500 WHEN 'PAPER' ALSO 1 00750000 007600 MOVE 'Two Papers is a tie.' TO msg1 00760000 007700 WHEN 'SCISSORS' ALSO 2 00770000 007800 MOVE 'Two Scissors is a tie.' TO msg1 00780000 007900 WHEN 'ROCK' ALSO 1 00790000 008000 MOVE 'Paper covers Rock - I win!' TO msg1 00800000 008100 WHEN 'ROCK' ALSO 2 00810000 008200 MOVE 'Rock smashes Scissors - You win!' TO msg1 00820000 008300 WHEN 'PAPER' ALSO 0 00830000 008400 MOVE 'Paper covers Rock - You win!' TO msg1 00840000 008500 WHEN 'PAPER' ALSO 2 00850000 008600 MOVE 'Scissors cut Paper - I win!' TO msg1 00860000 008700 WHEN 'SCISSORS' ALSO 0 00870000 008800 MOVE 'Rock smashes Scissors - I win!' TO msg1 00880000 008900 WHEN 'SCISSORS' ALSO 1 00890000 009000 MOVE 'Scissors cut Paper - You win!' TO msg1 00900000 009100 WHEN OTHER 00910000 009200 MOVE 'You did not select "Rock", "Paper", or "Scissors". Pl00920000 009300- 'ease try again.' TO msg1 00930000 009400 END-EVALUATE. 00940000 009500 00950000 009600 Send-Result. 00960000 009700 IF eibtrnid = 'CWBA' 00970000 009800 THEN EXEC CICS WEB SEND FROM(result) 00980000 009900 FROMLENGTH(LENGTH OF result) 00990000 010000 SERVERCONV(DFHVALUE(SRVCONVERT)) 01000000 010100 END-EXEC 01010000 010200 ELSE 01020000 010300 EXEC CICS SEND FROM(result) 01030000 010400 FLENGTH(LENGTH OF result) 01040000 010500 ERASE 01050000 010600 END-EXEC 01060000 010700 EXEC CICS SEND CONTROL CURSOR(LENGTH OF user-tranid) 01070000 010800 END-EXEC 01080000 010900 END-IF. 01090000 011000 01100000 011100 Process-Exit. 01110000 011200 EXEC CICS RETURN END-EXEC. 01120000 011300* Dummy GOBACK. 01130000 011400 GOBACK. 01140000