Member HTMLTOSTMF in CGICBLDEV2 / QCBLLESRC

1.00 
 ********START OF PGM : HTMLTOSTMF  ****************************************
2.00 
       *================================================================
3.00 
       *
4.00 
       *  After compiling this module, create the program as follow:
5.00 
       *
6.00 
       *  CRTPGM  PGM(CGICBLDEV2/HTMLTOSTMF) MODULE(CGICBLDEV2/HTMLTOSTMF)
7.00 
       *          BNDDIR(CGICBLDEV2/CGICBLDEV2)
8.00 
       *          ACTGRP(*NEW) AUT(*USE)
9.00 
       *
10.00 
       *================================================================
11.00 
        PROCESS NOXREF APOST
12.00 
        ID    DIVISION.
13.00 
        PROGRAM-ID. HTMLTOSTMF.
14.00 
        ENVIRONMENT DIVISION.
15.00 
        CONFIGURATION SECTION.
16.00 
        SPECIAL-NAMES.
17.00 
              copy CPYSPCNAME of CGICBLDEV2-QCBLLESRC.
18.00 
        INPUT-OUTPUT SECTION.
19.00 
        FILE-CONTROL.
20.00 
       *=================================================================
21.00 
        DATA DIVISION.
22.00 
        FILE SECTION.
23.00 
       *=================================================================
24.00 
        WORKING-STORAGE SECTION.
25.00 
       *=================================================================
26.00 
        01         HTML-DATA.
27.00 
       * Variables to execute a command
28.00 
            05     rc                  PIC  S9(9) comp-4.
29.00 
            05     cmd                 PIC  X(2000).
30.00 
       * Variables to parse the input string
31.00 
            05     varnamein           PIC  X(50).
32.00 
            05     request             PIC  X(1000).
33.00 
       * Variables to load external HTML
34.00 
            05     fn                  PIC  X(10) VALUE 'HTMLEXAMPL'.
35.00 
            05     lib                 PIC  X(10) VALUE 'CGICBLDEV2'.
36.00 
            05     mbr                 PIC  X(10) VALUE 'HTMLTOSTMF'.
37.00 
       * Variable for QWrtSection procedure
38.00 
            05     HtmlSects           PIC  X(1000).
39.00 
       * Variables for QUpdHtmlVar procedure
40.00 
            05     varnameout          PIC  X(30).
41.00 
            05     varvalout           PIC  X(1000).
42.00 
       * Variables for QChkNbr procedure
43.00 
            05     char32              PIC  X(32).
44.00 
            05     isNumeric           PIC  S9(9) comp-4.
45.00 
       * Variables for QRandomString procedure
46.00 
            05     randomString        PIC  X(1024).
47.00 
            05     stringLen           PIC  S9(9) comp-4.
48.00 
            05     firstChar           PIC  X(12).
49.00 
            05     remainChar          PIC  X(12).
50.00 
            05     winner1             PIC  X(3).
51.00 
            05     winner2             PIC  X(5).
52.00 
       * Variables for QWrtHtmlToStmf procedure
53.00 
            05     stmf                PIC  X(1024).
54.00 
            05     codePage            PIC  S9(9) comp-4 value 819.
55.00 
            05     retcode             PIC  S9(9) comp-4.
56.00 
       *=================================================================
57.00 
       *                M A I N  -  L I N E
58.00 
       *=================================================================
59.00 
        PROCEDURE DIVISION.
60.00 
        A-start-pgm.
61.00 
       * Load the external HTML
62.00 
            call 'QGETHTML' using fn lib mbr.
63.00 
       * Retrieve input variables
64.00 
            call 'QZHBGETINPUT'.
65.00 
            move 'request' to varnamein.
66.00 
            call 'QZHBGETVAR' using
67.00 
                              by content varnamein
68.00 
                              returning into request.
69.00 
       * Perform
70.00 
            if request = ' '
71.00 
            perform Case1                  thru z-Case1
72.00 
            else
73.00 
            perform Case2                  thru z-Case2
74.00 
            end-if.
75.00 
       *----------------------------------
76.00 
        B-end-pgm.
77.00 
            goback.
78.00 
       *=================================================================
79.00 
        Case1.
80.00 
       *Ask the user to perform an action
81.00 
       * Send out the page
82.00 
            move 'top dynatop jplogo weblogo press end endend *fini'
83.00 
                 to HtmlSects
84.00 
            call 'QWRTSECTION' using HtmlSects.
85.00 
       *----------------------------------
86.00 
        z-Case1.
87.00 
            EXIT.
88.00 
       *=================================================================
89.00 
        Case2.
90.00 
       *Create the dynastatic page (run the lottery)
91.00 
       *Run the lottery
92.00 
            compute stringLen = 3
93.00 
            move '*upperLetter' to firstChar
94.00 
            move '*upperLetter' to remainChar
95.00 
            call 'QRANDOMSTRING' using
96.00 
                                 stringLen
97.00 
                                 firstChar
98.00 
                                 remainChar
99.00 
                                 returning randomString.
100.00 
            move randomString to winner1.
101.00 
            compute stringLen = 5
102.00 
            move '*digit' to firstChar
103.00 
            move '*digit' to remainChar
104.00 
            call 'QRANDOMSTRING' using
105.00 
                                 stringLen
106.00 
                                 firstChar
107.00 
                                 remainChar
108.00 
                                 returning randomString.
109.00 
            move randomString to winner2.
110.00 
            move 'winner1' to varnameout
111.00 
            move winner1 to  varvalout
112.00 
            call 'QUPDHTMLVAR' using varnameout varvalout.
113.00 
            move 'winner2' to varnameout
114.00 
            move winner2 to  varvalout
115.00 
            call 'QUPDHTMLVAR' using varnameout varvalout.
116.00 
       * Write out the dynaststic page to the output buffer
117.00 
            move 'dynatop weblogo winner endend'
118.00 
                 to HtmlSects
119.00 
            call 'QWRTSECTION' using HtmlSects.
120.00 
       * Write the output buffer to the stream file
121.00 
            move '/cgicbldev2/dynastatic/lottery.html' to stmf
122.00 
            call 'QWRTHTMLTOSTMF' using stmf codePage
123.00 
                                  returning into retcode.
124.00 
       * Clear the output buffer
125.00 
            call 'QCLRHTMLBUFFER'.
126.00 
       *Send out the user page
127.00 
            perform Case1                  thru z-Case1.
128.00 
       *----------------------------------
129.00 
        z-Case2.
130.00 
            EXIT.
131.00 
 ********* END OF PGM : HTMLTOSTMF ****************************************
0.044 sec.s