1.00 |
********START OF PGM : SECTTOSTMF **************************************** |
2.00 |
*================================================================ |
3.00 |
* |
4.00 |
* After compiling this module, create the program as follow: |
5.00 |
* |
6.00 |
* CRTPGM PGM(CGICBLDEV2/SECTTOSTMF) MODULE(CGICBLDEV2/SECTTOSTMF) |
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. SECTTOSTMF. |
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 xrequest PIC X(1000). |
33.00 |
05 xqty PIC X(1000). |
34.00 |
05 xqty10 PIC X(10). |
35.00 |
05 qty PIC S9(9) comp-4. |
36.00 |
* Variables to load external HTML |
37.00 |
05 fn PIC X(10) VALUE 'HTMLEXAMPL'. |
38.00 |
05 lib PIC X(10) VALUE 'CGICBLDEV2'. |
39.00 |
05 mbr PIC X(10) VALUE 'SECTTOSTMF'. |
40.00 |
* Variables for QUpdHtmlVar procedure |
41.00 |
05 varnameout PIC X(30). |
42.00 |
05 varvalout PIC X(1000). |
43.00 |
* Variable for QWrtSection / QwrtSectionToStmf procedures |
44.00 |
05 HtmlSects PIC X(1000). |
45.00 |
* Variables for QChkNbr procedure |
46.00 |
05 char32 PIC X(32). |
47.00 |
05 isNumeric PIC S9(9) comp-4. |
48.00 |
* Variables for QRandomString procedure |
49.00 |
05 randomString PIC X(1024). |
50.00 |
05 stringLen PIC S9(9) comp-4. |
51.00 |
05 firstChar PIC X(12). |
52.00 |
05 remainChar PIC X(12). |
53.00 |
05 winner1 PIC X(3). |
54.00 |
05 winner2 PIC X(5). |
55.00 |
* Variables for QWrtSectionToStmf procedure |
56.00 |
05 stmf PIC X(1024). |
57.00 |
05 codePage PIC S9(9) comp-4 value 819. |
58.00 |
05 dataType PIC x(5) VALUE '*TEXT'. |
59.00 |
05 retcode PIC S9(9) comp-4. |
60.00 |
* Variables to perform loop B-PARA |
61.00 |
05 WSA PIC S9(9) comp-4 VALUE 0. |
62.00 |
05 WSA_END PIC S9(9) comp-4 VALUE 0. |
63.00 |
05 edited-WSA PIC Z,ZZZ,ZZ9. |
64.00 |
*================================================================= |
65.00 |
* M A I N - L I N E |
66.00 |
*================================================================= |
67.00 |
PROCEDURE DIVISION. |
68.00 |
A-start-pgm. |
69.00 |
* Load the external HTML |
70.00 |
call 'QGETHTML' using fn lib mbr. |
71.00 |
* Obtain input variables |
72.00 |
call 'QZHBGETINPUT'. |
73.00 |
* 1- get input variable 'xrequest' into "xrequest" |
74.00 |
move 'xrequest' to varnamein. |
75.00 |
call 'QZHBGETVAR' using |
76.00 |
by content varnamein |
77.00 |
returning into xrequest. |
78.00 |
* 2- get input variable 'xqty' into "xqty" |
79.00 |
move 'xqty' to varnamein. |
80.00 |
call 'QZHBGETVAR' using |
81.00 |
by content varnamein |
82.00 |
returning into xqty. |
83.00 |
* convert "xqty" to numeric "qty" |
84.00 |
move xqty to xqty10. |
85.00 |
call 'QCHARTONUM' using |
86.00 |
by content xqty10 |
87.00 |
returning into qty. |
88.00 |
* Perform |
89.00 |
if xrequest = ' ' |
90.00 |
perform Case1 thru z-Case1 |
91.00 |
else |
92.00 |
perform Case2 thru z-Case2 |
93.00 |
end-if. |
94.00 |
*---------------------------------- |
95.00 |
B-end-pgm. |
96.00 |
goback. |
97.00 |
*================================================================= |
98.00 |
Case1. |
99.00 |
*Ask the user to select a quantity |
100.00 |
* Send out the page |
101.00 |
move 'header top question bottom *fini' |
102.00 |
to HtmlSects |
103.00 |
call 'QWRTSECTION' using HtmlSects. |
104.00 |
*---------------------------------- |
105.00 |
z-Case1. |
106.00 |
EXIT. |
107.00 |
*================================================================= |
108.00 |
Case2. |
109.00 |
*Create and fill the IFS stream file /tmp/stripes.html |
110.00 |
* Clear the output buffer |
111.00 |
call 'QCLRHTMLBUFFER'. |
112.00 |
* Create the stream file and write initial HTML to it |
113.00 |
move 'top tabstr' to HtmlSects. |
114.00 |
move '/tmp/stripes.html' to stmf. |
115.00 |
call 'QWRTSECTIONTOSTMF' using |
116.00 |
HtmlSects |
117.00 |
stmf |
118.00 |
dataType |
119.00 |
codePage. |
120.00 |
* Loop writing HTML (stripes) to the stream file |
121.00 |
move 'tabrow' to HtmlSects. |
122.00 |
compute WSA_END = qty + 1. |
123.00 |
perform B-PARA varying WSA from 1 by 1 until WSA=WSA_END. |
124.00 |
* Write final HTML (stripes) and close the stream file |
125.00 |
move 'tabend bottom *fini' to HtmlSects. |
126.00 |
call 'QWRTSECTIONTOSTMF' using |
127.00 |
HtmlSects. |
128.00 |
* Allow *PUBLIC to access the stream file |
129.00 |
move 'CHGAUT OBJ(''/tmp/stripes.html'') |
130.00 |
- USER(*PUBLIC) DTAAUT(*RWX) OBJAUT(*ALL)' |
131.00 |
to cmd. |
132.00 |
call 'QDOCMD' using cmd |
133.00 |
returning into rc. |
134.00 |
* Send response to the WEB browser |
135.00 |
call 'QCLRHTMLBUFFER'. |
136.00 |
move 'header top answer bottom *fini' |
137.00 |
to HtmlSects. |
138.00 |
call 'QWRTSECTION' using HtmlSects. |
139.00 |
*---------------------------------- |
140.00 |
z-Case2. |
141.00 |
EXIT. |
142.00 |
B-PARA. |
143.00 |
move 'rownbr' to varnameout. |
144.00 |
move WSA to edited-WSA. |
145.00 |
move edited-WSA to varvalout. |
146.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
147.00 |
call 'QWRTSECTIONTOSTMF' using |
148.00 |
HtmlSects. |
149.00 |
********* END OF PGM : SECTTOSTMF **************************************** |