| products/sources/formale sprachen/Cobol/verschiedene-Autoren/CICS/ca84/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: objserv.cob Sprache: CobolOriginal von: verschiedene© |
|
||||||
|
*******************************************
* * MODULE NAME OBJSERV.COB * * DESCRIPTIVE NAME CICS for MVS/ESA CWI Graphics Server Sample Program * * Statement: Licensed Materials - Property of IBM * * CA84 SupportPac * (c) Copyright IBM Corp. 1997 * * All rights reserved. * * U.S. Government Users Restricted Rights - use, * duplication or disclosure restricted by GSA * ADP Schedule Contract with IBM Corp. * * Status: Version 1 Release 0 Modification 1 * Last Modified 10 October 1997 * Modified template manager comm-area creation step * to set address of returned data * Author: Steve Wall * * NOTES :- * DEPENDENCIES CICS for MVS/ESA V4.1 * Internet Connection Server for MVS/ESA * * This program is a cobol CWI converter program which implements * one method of delivering graphics through the CWI. * It will serve graphics from a URL * of the form http://your.cics.system/objserv/graphic.gif . * ******************************************* ******************************************* * * PROGRAM NAME: OBJSERV * * TITLE: Cobol Sample CWI Graphics Server Converter Program. * * PROGRAM DESCRIPTION: * * This program will show an example of how to code a converter * to send binary objects up to 32K in length over the web. * * SYSTEM LEVEL: CICS 4.1 or higher. * * INPUT: * * The target file is passed in the URL. * * OUTPUT: * * The target file is returned to the browser. If an error occurs * then a 404 is returned. * ***************************************** PROCESS XOPTS(NOLINKAGE) IDENTIFICATION DIVISION. PROGRAM-ID. OBJSERV. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. COPY DFHWBUCO. ****** * Data items. ****** * Simple data types used for interaction with CICS. ****** 77 conv-pointer POINTER. 77 init-val PIC X VALUE LOW-VALUES. 77 resp PIC S9(4). 77 resp2 PIC S9(4). ****** * Specific stuff for the decode function. ****** 77 file-name PIC X(8). 77 counter PIC S9(4) COMP. 77 url-character-ptr POINTER. ****** * Http header stuff. ****** 01 mime-type. 05 filler PIC X(6) VALUE IS 'image/'. 05 extension PIC X(4) VALUE IS '****'. 01 header. 05 filler PIC X(23) VALUE IS 'HTTP/1.0 200 Image file'. 05 filler PIC X(2) VALUE IS x'0D25'. 05 filler PIC X(16) VALUE IS 'Content-Length: '. 05 clen PIC 9(5). 05 filler PIC X(2) VALUE IS x'0D25'. 05 filler PIC X(14) VALUE IS 'Content-Type: '. 05 type-of-data PIC X(10) VALUE IS '**********'. 05 filler PIC X(2) VALUE IS x'0D25'. 05 filler PIC X(2) VALUE IS x'0D25'. 01 failure-header. 05 filler PIC X(13) VALUE IS 'HTTP/1.0 404 '. 05 filler PIC X(14) VALUE IS 'File not found'. 05 filler PIC X(2) VALUE IS x'0D25'. 05 filler PIC X(2) VALUE IS x'0D25'. ****** * Data constants. ****** 01 lower PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'. 01 filler REDEFINES lower. 05 lowerc PIC X OCCURS 26 INDEXED BY lowerc-idx. 01 upper PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. 01 filler REDEFINES upper. 05 upperc PIC X OCCURS 26. COPY DFHWBTLO. ****** * Now for the overlay structures. ****** LINKAGE SECTION. COPY DFHEIBLC. COPY DFHWBCDO. 01 returned-data. 05 http-len PIC 9(8) COMP. 05 header1 PIC X(76). 05 the-binary-data PIC X(32683). 77 the-url PIC X(1000). 77 url-character PIC X. PROCEDURE DIVISION USING DFHEIBLK DFHCOMMAREA. ****** * First part: set up the pointers and structures, perform * sanity checks and the call the decode/encode functions. ****** * Just return if no commarea because there's nowhere to work. ****** IF EIBCALEN = 0 EXEC CICS RETURN END-EXEC END-IF ****** * Set up addressability to the commarea. ****** EXEC CICS ADDRESS COMMAREA(conv-pointer) END-EXEC. SET ADDRESS OF CONVERTER-PARMS TO conv-pointer. ****** * Validate the commarea eyecatcher. ****** IF (CONVERTER-EYECATCHER NOT = DECODE-EYECATCHER-INIT) AND (CONVERTER-EYECATCHER NOT = ENCODE-EYECATCHER-INIT) MOVE URP-INVALID TO CONVERTER-RESPONSE MOVE URP-CORRUPT-CLIENT-DATA TO CONVERTER-REASON EXEC CICS RETURN END-EXEC END-IF IF CONVERTER-RESPONSE NOT = 0 EXEC CICS RETURN END-EXEC END-IF IF CONVERTER-REASON NOT = 0 EXEC CICS RETURN END-EXEC END-IF EVALUATE CONVERTER-FUNCTION ****** * If decode is set then do all the interesting stuff. ****** WHEN URP-DECODE PERFORM DECODE ****** * If encode is set then return. (Encode is a null function) ****** WHEN URP-ENCODE MOVE URP-OK TO CONVERTER-RESPONSE ****** * otherwise there is a problem ****** WHEN OTHER MOVE URP-DISASTER TO CONVERTER-RESPONSE MOVE URP-CORRUPT-CLIENT-DATA TO CONVERTER-REASON EXEC CICS RETURN END-EXEC END-EVALUATE ****** * Now we return. ****** EXEC CICS RETURN END-EXEC. A999-EXIT. EXIT. ******************** BB-DECODE SECTION. ******************** DECODE. *************** ****** * First we need to find the file name. ****** * Set up pointers to the url. ****** MOVE DECODE-RESOURCE-LENGTH TO counter SET ADDRESS OF the-url TO DECODE-RESOURCE-PTR SET ADDRESS OF url-character TO ADDRESS OF the-url(counter : 1) ****** * Find the last '/' in the url. ****** PERFORM WITH TEST BEFORE UNTIL url-character = '/' COMPUTE counter = counter - 1 SET ADDRESS OF url-character TO ADDRESS OF the-url(counter : 1) END-PERFORM COMPUTE counter = counter + 1 SET ADDRESS OF the-url TO ADDRESS OF the-url(counter : 1) ****** * Save the filename and extension + convert to upper case. ****** UNSTRING the-url DELIMITED BY ';' OR '?' OR '.' OR ' ' INTO file-name extension PERFORM WITH TEST AFTER VARYING counter FROM 1 BY +1 UNTIL counter = 26 INSPECT file-name REPLACING ALL lowerc(counter) BY upperc(counter) INSPECT extension REPLACING ALL lowerc(counter) BY upperc(counter) END-PERFORM ****** * Create the mime type and embed it in the http header * assume a default of 'gif' if the extension isn't recognised. ****** EVALUATE extension(1:3) WHEN 'JPE' MOVE 'jpeg' TO extension WHEN 'JPG' MOVE 'jpeg' TO extension WHEN OTHER MOVE 'gif' TO extension END-EVALUATE MOVE mime-type TO type-of-data ****** * Having found the filename we need to recover the file. ****** * Create the template manager comm-area. ****** SET ADDRESS OF returned-data TO DECODE-DATA-PTR MOVE LOW-VALUES TO DFHWBTL-ARG ****** * Set up and run the template manager. We are using it simply * to copy the binary image data to the data buffer, no * symbol replacements are required. ****** MOVE 0 TO WBTL-VERSION-NO MOVE WBTL-BUILD-HTML-PAGE TO WBTL-FUNCTION MOVE file-name TO WBTL-TEMPLATE-NAME SET WBTL-HTML-BUFFER-PTR TO ADDRESS OF the-binary-data MOVE LENGTH OF the-binary-data TO WBTL-HTML-BUFFER-LEN EXEC CICS LINK PROGRAM('DFHWBTL') COMMAREA(DFHWBTL-ARG) LENGTH(56) RESP(resp) RESP2(resp2) END-EXEC ****** * If theres an error then handle it. ****** IF resp NOT = WBTL-OK PERFORM CREATE-ERROR-RESPONSE END-IF ****** * Now the binary data is in place we set up the length * fields and add the header. ****** * Calculate the length of the http response. An extra 2 * bytes are deducted to nullify the CRLF character pair * that the template manager automatically adds to the end * of the data. ****** COMPUTE http-len = (LENGTH OF returned-data - WBTL-HTML-BUFFER-LEN) - 2 COMPUTE clen = (LENGTH OF the-binary-data - WBTL-HTML-BUFFER-LEN) - 2 ****** * And finaly add the header that we've been building up. ****** MOVE header TO header1. BB999-EXIT. EXIT. ****************** C-ERROR SECTION. ****************** CREATE-ERROR-RESPONSE. ************************ ****** * If any error is detected return a 404 to the browser. ****** COMPUTE http-len = LENGTH OF failure-header + 4 MOVE failure-header TO header1 EXEC CICS RETURN END-EXEC. ****** * And that's it. ****** CC999-EXIT. EXIT. ¤ Dauer der Verarbeitung: 0.28 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
