000100 ID DIVISION. 00010000
000200 PROGRAM-ID. TRPGM80. 00020000
000300*AUTHOR. Kenneth W. Caldwell. 00030000
000400*INSTALLATION. Train-Right. 00040000
000500*DATE-WRITTEN. February 11, 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 TCP/IP Web based program. 00110000
001200* It receives the http request via the commarea. 00120000
001300* It sends an http response via the commarea 00130000
001400* (An http response header is required). 00140000
001500* CICS will convert the EBCDIC to ASCII. 00150000
001600* The client is a Web Browser. 00160000
001700* 00170000
001800 DATA DIVISION. 00180000
001900 WORKING-STORAGE SECTION. 00190000
002000 COPY TRRECORD REPLACING tr-record BY tr-trvsam-record. 00200000
002100 COPY TRRECORD REPLACING tr-record BY tr-trlock-record. 00210000
002200 01. 00220000
002300 05 crlfcrlf PIC X(4) VALUE X'0D250D25'. 00230000
002400 05 crlf REDEFINES crlfcrlf PIC X(2). 00240000
002500 00250000
002600 01 html-out. 00260000
002700 05 html-length PIC S9(8) BINARY. 00270000
002800 05 html-text PIC X(2000). 00280000
002900 05 bad-num pic s9(5) packed-decimal. 00290000
003000 00300000
003100 LINKAGE SECTION. 00310000
003200 01 dfhcommarea. 00320000
003300 05 http-request PIC X OCCURS 0 TO 32767 TIMES 00330000
003400 DEPENDING ON eibcalen. 00340000
003500 00350000
003600 PROCEDURE DIVISION. 00360000
003700 Main. 00370000
003800* No http request means not a Web client. 00380000
003900 IF eibcalen = ZERO 00390000
004000 THEN MOVE 'Client is not an HTTP Web Browser.' TO html-text 00400000
004100 EXEC CICS SEND FROM(html-text) LENGTH(34) ERASE END-EXEC00410000
004200 EXEC CICS RETURN END-EXEC 00420000
004300 END-IF. 00430000
004400 00440000
004500 Process-Data. 00450000
004600 add +1 to bad-num. 00460001
004700* Build http response and html output. 00470000
004800 MOVE +1 TO html-length. 00480000
004900 STRING 'HTTP/1.0 501 NOT OK' crlf 00490000
005000 'Content-Type: text/html' crlfcrlf 00500000
005100 '' 00510000
005200 'Train-Right Advanced CICS Programming Concepts' 00520000
005300 '' 00530000
005400 '' 00540000
005500 '
' 00550000
005600 'Train-Right CICS WEB COBOL - TRPGM89
' 00560000
005700 '
' 00570000
005800 DELIMITED BY SIZE 00580000
005900 INTO html-text 00590000
006000 WITH POINTER html-length 00600000
006100 END-STRING. 00610000
006200 00620000
006300* String statement points to next byte. 00630000
006400 SUBTRACT +1 FROM html-length. 00640000
006500* Html output length includes the length field. 00650000
006600 ADD +4 TO html-length. 00660000
006700 00670000
006800 Send-Result. 00680000
006900 MOVE html-out(1:html-length) TO dfhcommarea. 00690000
007000 00700000
007100 Process-Exit. 00710000
007200 EXEC CICS RETURN END-EXEC. 00720000
007300* Dummy GOBACK. 00730000
007400 GOBACK. 00740000