000100 ID DIVISION. 00010000
000200 PROGRAM-ID. TRPGM82. 00020000
000300*AUTHOR. Kenneth W. Caldwell. 00030000
000400*INSTALLATION. Train-Right. 00040000
000500*DATE-WRITTEN. May 18, 2007. 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 uses CICS commands to extract http request data. 00120000
001300* It sends an http response via an empty DOCUMENT. 00130000
001400* (Http Response headers are optional). 00140000
001500* WEB RECEIVE specifies to convert the ASCII to EBCDIC. 00150000
001600* WEB SEND specifies to convert the EBCDIC to ASCII. 00160000
001700* The client is a Web Browser. 00170000
001800* 00180000
001900 DATA DIVISION. 00190000
002000 WORKING-STORAGE SECTION. 00200000
002100* Fields for the output HTML. 00210000
002200 01. 00220000
002300 05 html-length PIC S9(8) BINARY. 00230000
002400* 05 html-text PIC X(700). 00240001
002410 05 html-text PIC X(32767). 00241001
002500 00250000
002600 05 temp-length1 PIC ++++,+++,++9. 00260000
002700 05 temp-length2 PIC ++++,+++,++9. 00270000
002800 05 temp-length3 PIC ++++,+++,++9. 00280000
002900 05 temp-length4 PIC ++++,+++,++9. 00290000
003000 05 temp-length5 PIC ++++,+++,++9. 00300000
003100 05 temp-port PIC zzzzzzzz9. 00310000
003200 00320000
003300 05 doc-token PIC X(16). 00330000
003400 00340000
003500* Fields for WEB READNEXT HTTPHEADER and WEB WRITE HTTPHEADER. 00350000
003600 01 work-area. 00360000
003700 05 http-header PIC X(80). 00370000
003800 05 http-header-length PIC S9(8) BINARY. 00380000
003900 05 http-header-value PIC X(700). 00390000
004000 05 http-value-length PIC S9(8) BINARY. 00400000
004100 00410000
004200* Fields for EIB and ASSIGN. 00420000
004300 01 REDEFINES work-area. 00430000
004400 05 temp-time PIC 99/99/99. 00440000
004500 05 temp-date PIC 9/99/999. 00450000
004600 05 facility PIC X(4). 00460000
004700 05 invoking-pgm PIC X(8). 00470000
004800 05 return-pgm PIC X(8). 00480000
004900 05 start-code PIC X(2). 00490000
005000 00500000
005100* Fields for EXTRACT TCPIP. 00510000
005200 01 REDEFINES work-area. 00520000
005300 05 cvda-auth PIC S9(8) BINARY. 00530000
005400 05 cvda-ssl PIC S9(8) BINARY. 00540000
005500 05 cvda-privacy PIC S9(8) BINARY. 00550000
005600 00560000
005700 05 auth-char PIC X(12). 00570000
005800 05 ssl-char PIC X(10). 00580000
005900 05 privacy-char PIC X(12). 00590000
006000 00600000
006100 05 tcpip-service PIC X(8). 00610000
006200 05 port-number-tcpip PIC X(5). 00620000
006300 00630000
006400 05 client-name PIC X(80). 00640000
006500 05 client-name-length PIC S9(8) BINARY. 00650000
006600 05 client-addr PIC X(80). 00660000
006700 05 client-addr-length PIC S9(8) BINARY. 00670000
006800 00680000
006900 05 server-name PIC X(80). 00690000
007000 05 server-name-length PIC S9(8) BINARY. 00700000
007100 05 server-addr PIC X(80). 00710000
007200 05 server-addr-length PIC S9(8) BINARY. 00720000
007300 00730000
007400* Fields for WEB EXTRACT and WEB RECEIVE (request type). 00740000
007500 01 REDEFINES work-area. 00750000
007600 05 cvda-request PIC S9(8) BINARY. 00760000
007700 05 cvda-scheme PIC S9(8) BINARY. 00770000
007800 00780000
007900 05 request-char PIC X(7). 00790000
008000 05 scheme-char PIC X(5). 00800000
008100 00810000
008200 05 host PIC X(116). 00820000
008300 05 host-length PIC S9(8) BINARY. 00830000
008400 00840000
008500 05 http-method PIC X(80). 00850000
008600 05 http-method-length PIC S9(8) BINARY. 00860000
008700 00870000
008800 05 http-version PIC X(80). 00880000
008900 05 http-version-length PIC S9(8) BINARY. 00890000
009000 00900000
009100 05 http-path PIC X(80). 00910000
009200 05 http-path-length PIC S9(8) BINARY. 00920000
009300 00930000
009400 05 port-number-web PIC S9(8) BINARY. 00940000
009500 00950000
009600 05 http-query PIC X(80). 00960000
009700 05 http-query-length PIC S9(8) BINARY. 00970000
009800 00980000
009900* Fields for WEB RECEIVE (See also LINKAGE SECTION). 00990000
010000 77 http-body-length PIC S9(8) BINARY VALUE ZERO. 01000000
010100 01010000
010200 LINKAGE SECTION. 01020000
010300* Http body. 01030000
010400 01 http-body. 01040000
010500 05 PIC X OCCURS 0 TO 32767 TIMES 01050000
010600 DEPENDING ON http-body-length. 01060000
010700 01070000
010800 PROCEDURE DIVISION. 01080000
010900 Main. 01090000
011000 EXEC CICS HANDLE CONDITION INVREQ(Not-Web) END-EXEC. 01100000
011100 01110000
011200*Receive-Trans-Input. 01120000
011300 01130000
011400 Process-Data. 01140000
011500 MOVE 'Content-Type' TO http-header. 01150000
011600 MOVE 'text/html' TO http-header-value. 01160000
011700 01170000
011800 EXEC CICS WEB WRITE HTTPHEADER(http-header) 01180000
011900 NAMELENGTH(12) 01190000
012000 VALUE(http-header-value) 01200000
012100 VALUELENGTH(9) 01210000
012200 END-EXEC. 01220000
012300 01230000
012400 EXEC CICS DOCUMENT CREATE DOCTOKEN(doc-token) END-EXEC. 01240000
012500 01250000
012600 MOVE +1 TO html-length. 01260000
012700 STRING '
' 01270000
012800 'Train-Right Advanced CICS Programming Concepts' 01280000
012900 '' 01290000
013000 '' 01300000
013100 '' 01310000
013200 'Train-Right CICS WEB COBOL - TRPGM82
' 01320000
013300 DELIMITED BY SIZE 01330000
013400 INTO html-text 01340000
013500 WITH POINTER html-length 01350000
013600 END-STRING. 01360000
013700 SUBTRACT +1 FROM html-length. 01370000
013800 01380000
013900 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 01390000
014000 TEXT(html-text) 01400000
014100 LENGTH(html-length) 01410000
014200 END-EXEC. 01420000
014300 01430000
014400 MOVE eibtime TO temp-time. 01440000
014500 INSPECT temp-time CONVERTING '/' TO ':'. 01450000
014600 MOVE eibdate TO temp-date. 01460000
014700 MOVE eibtaskn TO temp-length1. 01470000
014800 MOVE eibcposn TO temp-length2. 01480000
014900 MOVE eibcalen TO temp-length3. 01490000
015000 01500000
015100 MOVE +1 TO html-length. 01510000
015200 STRING 'Execute Interface Block values:' 01520000
015300 '
EIBTIME | ' 01530000
015400 temp-time 01540000
015500 ' |
EIBDATE | ' 01550000
015600 temp-date 01560000
015700 ' |
EIBTRNID | ' 01570000
015800 eibtrnid 01580000
015900 ' |
' 01590000
016000 'EIBTASKN | ' 01600000
016100 temp-length1 01610000
016200 ' |
EIBTRMID | ' 01620000
016300 eibtrmid 01630000
016400 ' |
EIBCPOSN | ' 01640000
016500 temp-length2 01650000
016600 ' |
' 01660000
016700 '
EIBCALEN | ' 01670000
016800 temp-length3 01680000
016900 ' |
' 01690000
017000 DELIMITED BY SIZE 01700000
017100 INTO html-text 01710000
017200 WITH POINTER html-length 01720000
017300 END-STRING. 01730000
017400 SUBTRACT +1 FROM html-length. 01740000
017500 01750000
017600 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 01760000
017700 TEXT(html-text) 01770000
017800 LENGTH(html-length) 01780000
017900 END-EXEC. 01790000
018000 01800000
018100 MOVE SPACES TO facility. 01810000
018200 01820000
018300 EXEC CICS IGNORE CONDITION INVREQ END-EXEC. 01830000
018400 EXEC CICS ASSIGN FACILITY(facility) 01840000
018500 INVOKINGPROG(invoking-pgm) 01850000
018600 RETURNPROG(return-pgm) 01860000
018700 STARTCODE(start-code) 01870000
018800 END-EXEC. 01880000
018900 01890000
019000 MOVE +1 TO html-length. 01900000
019100 STRING 'ASSIGN command values:' 01910000
019200 '
Facility | ' 01920000
019300 facility 01930000
019400 ' |
Invoking program | ' 01940000
019500 invoking-pgm 01950000
019600 ' |
Return program | ' 01960000
019700 return-pgm 01970000
019800 ' |
' 01980000
019900 'Start code | ' 01990000
020000 start-code 02000000
020100 ' |
' 02010000
020200 DELIMITED BY SIZE 02020000
020300 INTO html-text 02030000
020400 WITH POINTER html-length 02040000
020500 END-STRING. 02050000
020600 SUBTRACT +1 FROM html-length. 02060000
020700 02070000
020800 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 02080000
020900 TEXT(html-text) 02090000
021000 LENGTH(html-length) 02100000
021100 END-EXEC. 02110000
021200 02120000
021300 02130000
021400 EXEC CICS IGNORE CONDITION LENGERR END-EXEC. 02140000
021500 02150000
021600 MOVE LENGTH OF client-name TO client-name-length. 02160000
021700 MOVE LENGTH OF client-addr TO client-addr-length. 02170000
021800 MOVE LENGTH OF server-name TO server-name-length. 02180000
021900 MOVE LENGTH OF server-addr TO server-addr-length. 02190000
022000 02200000
022100 EXEC CICS EXTRACT TCPIP 02210000
022200 AUTHENTICATE(cvda-auth) 02220000
022300 CLIENTNAME(client-name) 02230000
022400 CNAMELENGTH(client-name-length) 02240000
022500 SERVERNAME(server-name) 02250000
022600 SNAMELENGTH(server-name-length) 02260000
022700 CLIENTADDR(client-addr) 02270000
022800 CADDRLENGTH(client-addr-length) 02280000
022900 SERVERADDR(server-addr) 02290000
023000 SADDRLENGTH(server-addr-length) 02300000
023100 SSLTYPE(cvda-ssl) 02310000
023200 TCPIPSERVICE(tcpip-service) 02320000
023300 PORTNUMBER(port-number-tcpip) 02330000
023400 PRIVACY(cvda-privacy) 02340000
023500 END-EXEC. 02350000
023600 02360000
023700 EVALUATE cvda-auth 02370000
023800 WHEN DFHVALUE(ASSERTED) MOVE 'Asserted' TO auth-char 02380000
023900 WHEN DFHVALUE(AUTOAUTH) MOVE 'Autoauth' TO auth-char 02390000
024000 WHEN DFHVALUE(AUTOREGISTER) MOVE 'Autoregister' TO auth-char 02400000
024100 WHEN DFHVALUE(BASICAUTH) MOVE 'Basicauth' TO auth-char 02410000
024200 WHEN DFHVALUE(CERTIFICAUTH) MOVE 'Certificauth' TO auth-char 02420000
024300 WHEN DFHVALUE(NOAUTHENTIC) MOVE 'Noauthentic' TO auth-char 02430000
024400 WHEN OTHER MOVE SPACES TO auth-char 02440000
024500 END-EVALUATE. 02450000
024600 02460000
024700 EVALUATE cvda-privacy 02470000
024800 WHEN DFHVALUE(NOTSUPPORTED) 02480000
024900 MOVE 'Notsupported' TO privacy-char 02490000
025000 WHEN DFHVALUE(REQUIRED) 02500000
025100 MOVE 'Required' TO privacy-char 02510000
025200 WHEN DFHVALUE(SUPPORTED) 02520000
025300 MOVE 'Supported' TO privacy-char 02530000
025400 WHEN OTHER 02540000
025500 MOVE SPACES TO privacy-char 02550000
025600 END-EVALUATE. 02560000
025700 02570000
025800 EVALUATE cvda-ssl 02580000
025900 WHEN DFHVALUE(SSL) 02590000
026000 MOVE 'SSL' TO ssl-char 02600000
026100 WHEN DFHVALUE(NOSSL) 02610000
026200 MOVE 'NoSSL' TO ssl-char 02620000
026300 WHEN DFHVALUE(CLIENTAUTH) 02630000
026400 MOVE 'Clientauth' TO ssl-char 02640000
026500 WHEN OTHER 02650000
026600 MOVE SPACES TO ssl-char 02660000
026700 END-EVALUATE. 02670000
026800 02680000
026900 MOVE client-name-length TO temp-length1. 02690000
027000 MOVE client-addr-length TO temp-length2. 02700000
027100 MOVE server-name-length TO temp-length3. 02710000
027200 MOVE server-addr-length TO temp-length4. 02720000
027300 02730000
027400 MOVE +1 TO html-length. 02740000
027500 STRING 'Values returned by EXTRACT TCPIP:' 02750000
027600 '
' 02760000
027700 'TCP/IP Service | ' 02770000
027800 tcpip-service 02780000
027900 ' |
' 02790000
028000 'Port Number | ' 02800000
028100 port-number-tcpip 02810000
028200 ' |
' 02820000
028300 'Authentication (cvda) | ' 02830000
028400 auth-char 02840000
028500 ' |
' 02850000
028600 'SSL Type (cvda) | ' 02860000
028700 ssl-char 02870000
028800 ' |
' 02880000
028900 'Privacy (cvda) | ' 02890000
029000 privacy-char 02900000
029100 ' |
' 02910000
029200 'Client Name | ' 02920000
029300 client-name(1:client-name-length) 02930000
029400 ' | ' 02940000
029500 temp-length1 02950000
029600 ' |
' 02960000
029700 'Client Address | ' 02970000
029800 client-addr(1:client-addr-length) 02980000
029900 ' | ' 02990000
030000 temp-length2 03000000
030100 ' |
' 03010000
030200 'Server Name | ' 03020000
030300 server-name(1:server-name-length) 03030000
030400 ' | ' 03040000
030500 temp-length3 03050000
030600 ' |
' 03060000
030700 'Server Address | ' 03070000
030800 server-addr(1:server-addr-length) 03080000
030900 ' | ' 03090000
031000 temp-length4 03100000
031100 ' |
' 03110000
031200 DELIMITED BY SIZE 03120000
031300 INTO html-text 03130000
031400 WITH POINTER html-length 03140000
031500 END-STRING. 03150000
031600 SUBTRACT +1 FROM html-length. 03160000
031700 03170000
031800 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 03180000
031900 TEXT(html-text) 03190000
032000 LENGTH(html-length) 03200000
032100 END-EXEC. 03210000
032200 03220000
032300 MOVE LENGTH OF http-method TO http-method-length. 03230000
032400 MOVE LENGTH OF http-version TO http-version-length. 03240000
032500 MOVE LENGTH OF http-path TO http-path-length. 03250000
032600 MOVE LENGTH OF http-query TO http-query-length. 03260000
032700 MOVE LENGTH OF host TO host-length. 03270000
032800 03280000
032900 EXEC CICS WEB EXTRACT SCHEME(cvda-scheme) 03290000
033000 HOST(host) 03300000
033100 HOSTLENGTH(host-length) 03310000
033200 HTTPMETHOD(http-method) 03320000
033300 METHODLENGTH(http-method-length) 03330000
033400 HTTPVERSION(http-version) 03340000
033500 VERSIONLEN(http-version-length) 03350000
033600 PATH(http-path) 03360000
033700 PATHLENGTH(http-path-length) 03370000
033800 PORTNUMBER(port-number-web) 03380000
033900 QUERYSTRING(http-query) 03390000
034000 QUERYSTRLEN(http-query-length) 03400000
034100 REQUESTTYPE(cvda-request) 03410000
034200 END-EXEC. 03420000
034300 03430000
034400 EVALUATE cvda-scheme 03440000
034500 WHEN DFHVALUE(HTTP) 03450000
034600 MOVE 'Http' TO scheme-char 03460000
034700 WHEN DFHVALUE(HTTPS) 03470000
034800 MOVE 'Https' TO scheme-char 03480000
034900 WHEN OTHER 03490000
035000 MOVE SPACES TO scheme-char 03500000
035100 END-EVALUATE. 03510000
035200 03520000
035300 EVALUATE cvda-request 03530000
035400 WHEN DFHVALUE(HTTPYES) 03540000
035500 MOVE 'HttpYes' TO request-char 03550000
035600 WHEN DFHVALUE(HTTPNO) 03560000
035700 MOVE 'HttpNo' TO request-char 03570000
035800 WHEN OTHER 03580000
035900 MOVE SPACES TO request-char 03590000
036000 END-EVALUATE. 03600000
036100 03610000
036200 MOVE http-method-length TO temp-length1. 03620000
036300 MOVE http-version-length TO temp-length2. 03630000
036400 MOVE http-path-length TO temp-length3. 03640000
036500 MOVE http-query-length TO temp-length4. 03650000
036600 MOVE host-length TO temp-length5. 03660000
036700 MOVE port-number-web TO temp-port. 03670000
036800 03680000
036900 MOVE +1 TO html-length. 03690000
037000 STRING 'Values returned by WEB EXTRACT:' 03700000
037100 '
' 03710000
037200 'HTTP Request Type (cvda) | ' 03720000
037300 request-char 03730000
037400 ' |
' 03740000
037500 'HTTP Method | ' 03750000
037600 http-method(1:http-method-length) 03760000
037700 ' | ' 03770000
037800 temp-length1 03780000
037900 ' |
' 03790000
038000 'HTTP Version | ' 03800000
038100 http-version(1:http-version-length) 03810000
038200 ' | ' 03820000
038300 temp-length2 03830000
038400 ' |
' 03840000
038500 'Scheme (cvda) | ' 03850000
038600 scheme-char 03860000
038700 ' |
' 03870000
038800 'Host | ' 03880000
038900 host(1:host-length) 03890000
039000 ' | ' 03900000
039100 temp-length5 03910000
039200 ' |
' 03920000
039300 'Port | ' 03930000
039400 temp-port 03940000
039500 ' |
' 03950000
039600 'HTTP Path | ' 03960000
039700 http-path(1:http-path-length) 03970000
039800 ' | ' 03980000
039900 temp-length3 03990000
040000 ' |
' 04000000
040100 'Query String | ' 04010000
040200 http-query(1:http-query-length) 04020000
040300 ' | ' 04030000
040400 temp-length4 04040000
040500 ' |
' 04050000
040600 DELIMITED BY SIZE 04060000
040700 INTO html-text 04070000
040800 WITH POINTER html-length 04080000
040900 END-STRING. 04090000
041000 SUBTRACT +1 FROM html-length. 04100000
041100 04110000
041200 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 04120000
041300 TEXT(html-text) 04130000
041400 LENGTH(html-length) 04140000
041500 END-EXEC. 04150000
041600 04160000
041700 MOVE +1 TO html-length. 04170000
041800 STRING 'Values returned by WEB READNEXT HTTPHEADER:' 04180000
041900 '
' 04190000
042000 DELIMITED BY SIZE 04200000
042100 INTO html-text 04210000
042200 WITH POINTER html-length 04220000
042300 END-STRING. 04230000
042400 SUBTRACT +1 FROM html-length. 04240000
042500 04250000
042600 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 04260000
042700 TEXT(html-text) 04270000
042800 LENGTH(html-length) 04280000
042900 END-EXEC. 04290000
043000 04300000
043100 MOVE LENGTH OF http-header TO http-header-length. 04310000
043200 MOVE LENGTH OF http-header-value TO http-value-length. 04320000
043300 04330000
043400 EXEC CICS WEB STARTBROWSE HTTPHEADER END-EXEC. 04340000
043500 EXEC CICS WEB READNEXT HTTPHEADER(http-header) 04350000
043600 NAMELENGTH(http-header-length) 04360000
043700 VALUE(http-header-value) 04370000
043800 VALUELENGTH(http-value-length) 04380000
043900 NOHANDLE 04390000
044000 END-EXEC. 04400000
044100 04410000
044200 PERFORM UNTIL eibresp = DFHRESP(ENDFILE) 04420000
044300 MOVE http-header-length TO temp-length1 04430000
044400 MOVE http-value-length TO temp-length2 04440000
044500 MOVE +1 TO html-length 04450000
044600 STRING '' 04460000
044700 http-header(1:http-header-length) 04470000
044800 ' | ' 04480000
044900 temp-length1 04490000
045000 ' | ' 04500000
045100 http-header-value(1:http-value-length) 04510000
045200 ' | ' 04520000
045300 temp-length2 04530000
045400 ' |
' 04540000
045500 DELIMITED BY SIZE 04550000
045600 INTO html-text 04560000
045700 WITH POINTER html-length 04570000
045800 END-STRING 04580000
045900 SUBTRACT +1 FROM html-length 04590000
046000 04600000
046100 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 04610000
046200 TEXT(html-text) 04620000
046300 LENGTH(html-length) 04630000
046400 END-EXEC 04640000
046500 04650000
046600 MOVE LENGTH OF http-header TO http-header-length 04660000
046700 MOVE LENGTH OF http-header-value TO http-value-length 04670000
046800 04680000
046900 EXEC CICS WEB READNEXT HTTPHEADER(http-header) 04690000
047000 NAMELENGTH(http-header-length) 04700000
047100 VALUE(http-header-value) 04710000
047200 VALUELENGTH(http-value-length) 04720000
047300 NOHANDLE 04730000
047400 END-EXEC 04740000
047500 END-PERFORM. 04750000
047600 04760000
047700 EXEC CICS WEB ENDBROWSE HTTPHEADER END-EXEC. 04770000
047800 04780000
047900 MOVE '
' TO html-text. 04790000
048000 04800000
048100 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 04810000
048200 TEXT(html-text) 04820000
048300 LENGTH(8) 04830000
048400 END-EXEC. 04840000
048500 04850000
048600 EXEC CICS WEB RECEIVE SET(ADDRESS OF http-body) 04860000
048700 LENGTH(http-body-length) 04870000
048800 CHARACTERSET('iso-8859-1') 04880000
048900 HOSTCODEPAGE('037') 04890000
049000 TYPE(cvda-request) 04900000
049100 NOTRUNCATE 04910000
049200 END-EXEC. 04920000
049300 04930000
049400 EVALUATE cvda-request 04940000
049500 WHEN DFHVALUE(HTTPYES) 04950000
049600 MOVE 'HttpYes' TO request-char 04960000
049700 WHEN DFHVALUE(HTTPNO) 04970000
049800 MOVE 'HttpNo' TO request-char 04980000
049900 WHEN OTHER 04990000
050000 MOVE SPACES TO request-char 05000000
050100 END-EVALUATE. 05010000
050200 05020000
050300 MOVE http-body-length TO temp-length1. 05030000
050400 05040000
050500 MOVE +1 TO html-length. 05050000
050600 STRING 'Values returned by WEB RECEIVE:' 05060000
050700 '
' 05070000
050800 'HTTP Request Type (cvda) | ' 05080000
050900 request-char 05090000
051000 ' |
' 05100000
051100 'Request Body | ' 05110000
051200 http-body(1:http-body-length) 05120000
051300 ' | ' 05130000
051400 temp-length1 05140000
051500 ' |
' 05150000
051600 '
' 05160000
051700 DELIMITED BY SIZE 05170000
051800 INTO html-text 05180000
051900 WITH POINTER html-length 05190000
052000 END-STRING. 05200000
052100 SUBTRACT +1 FROM html-length. 05210000
052200 05220000
052300 EXEC CICS DOCUMENT INSERT DOCTOKEN(doc-token) 05230000
052400 TEXT(html-text) 05240000
052500 LENGTH(html-length) 05250000
052600 END-EXEC. 05260000
052700 05270000
052800 Send-Result. 05280000
052900* Code Page converts EBCDIC to ASCII. 05290000
053000 EXEC CICS WEB SEND DOCTOKEN(doc-token) 05300000
053100 CHARACTERSET('iso-8859-1') 05310000
053200 END-EXEC. 05320000
053300 05330000
053400 Process-Exit. 05340000
053500 EXEC CICS RETURN END-EXEC. 05350000
053600* Dummy GOBACK 05360000
053700 GOBACK. 05370000
053800 05380000
053900 Not-Web. 05390000
054000 MOVE 'Client is not an HTTP Web Browser.' TO html-text. 05400000
054100 EXEC CICS SEND FROM(html-text) LENGTH(34) ERASE END-EXEC. 05410000
054200 EXEC CICS RETURN END-EXEC. 05420000