000100 ID DIVISION.                                                     00010000
000200 PROGRAM-ID.     TRPGMxx.                                         00020000
000300*AUTHOR.                                                          00030000
000400*INSTALLATION.                                                    00040000
000500*DATE-WRITTEN.                                                    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*         The client is a Web Browser.                            00120000
001300*                                                                 00130000
001400 DATA DIVISION.                                                   00140000
001500 WORKING-STORAGE SECTION.                                         00150000
001600 01.                                                              00160000
001700     05  crlfcrlf                PIC X(4)  VALUE X'0D250D25'.     00170000
001800     05  crlf REDEFINES crlfcrlf PIC X(2).                        00180000
001900                                                                  00190000
002000 01  html-out.                                                    00200000
002100     05  html-length         PIC S9(8) BINARY.                    00210000
002200     05  html-text           PIC X(2000).                         00220000
002300                                                                  00230000
002400 LINKAGE SECTION.                                                 00240000
002500 01  dfhcommarea.                                                 00250000
002600     05  http-request        PIC X OCCURS 0 TO 32767 TIMES        00260000
002700                                   DEPENDING ON eibcalen.         00270000
002800                                                                  00280000
002900 PROCEDURE DIVISION.                                              00290000
003000 Main.                                                            00300000
003100*    No http request means not a Web client.                      00310000
003200     IF eibcalen = ZERO                                           00320000
003300     THEN MOVE 'Client is not an HTTP Web Browser.' TO html-text  00330000
003400          EXEC CICS SEND FROM(html-text) LENGTH(34) ERASE END-EXEC00340000
003500          EXEC CICS RETURN END-EXEC                               00350000
003600     END-IF.                                                      00360000
003700                                                                  00370000
003800 Receive-Trans-Input.                                             00380000
003900                                                                  00390000
004000 Process-Data.                                                    00400000
004100*    Build http response and html output.                         00410000
004200     MOVE +1     TO html-length.                                  00420000
004300     STRING 'HTTP/1.0 200 OK'                        crlf         00430000
004400            'Content-Type: text/html'                crlfcrlf     00440000
004500     DELIMITED BY SIZE                                            00450000
004600     INTO html-text                                               00460000
004700     WITH POINTER html-length                                     00470000
004800     END-STRING.                                                  00480000
004900                                                                  00490000
005000                                                                  00500000
005100     STRING '<!-- WiredMinds eMetrics tracking with Enterprise Edition V5.4 START -->
<script type='text/javascript' src='https://count.carrierzone.com/app/count_server/count.js'></script>
<script type='text/javascript'><!--
wm_custnum='a928458515ea6ad5';
wm_page_name='TRPGMSWC.COBOL';
wm_group_name='/services/webpages/k/e/kencaldwell.com/public/cicsa/cicsaw';
wm_campaign_key='campaign_id';
wm_track_alt='';
wiredminds.count();
// -->
</script>
<!-- WiredMinds eMetrics tracking with Enterprise Edition V5.4 END -->
</body></html>'                                      00510000
005200     DELIMITED BY SIZE                                            00520000
005300     INTO html-text                                               00530000
005400     WITH POINTER html-length                                     00540000
005500     END-STRING.                                                  00550000
005600                                                                  00560000
005700*    String statement points to next byte.                        00570000
005800     SUBTRACT +1   FROM html-length.                              00580000
005900*    Html output length includes the length field.                00590000
006000     ADD      +4     TO html-length.                              00600000
006100                                                                  00610000
006200 Send-Result.                                                     00620000
006300*    CICS converts EBCDIC to ASCII.                               00630000
006400     MOVE html-out(1:html-length) TO dfhcommarea.                 00640000
006500                                                                  00650000
006600 Process-Exit.                                                    00660000
006700     EXEC CICS RETURN END-EXEC.                                   00670000
006800*    Dummy GOBACK.                                                00680000
006900     GOBACK.                                                      00690000