1.00 |
********START OF PGM : LISTCTRIFS **************************************** |
2.00 |
*================================================================ |
3.00 |
* |
4.00 |
* After compiling this module, create the program as follow: |
5.00 |
* |
6.00 |
* CRTPGM PGM(CGICBLDEV2/LISTCTRIFS) MODULE(CGICBLDEV2/LISTCTRIFS) |
7.00 |
* BNDDIR(CGICBLDEV2/CGICBLDEV2) |
8.00 |
* ACTGRP(LISTCTRIFS) AUT(*USE) |
9.00 |
* |
10.00 |
*================================================================ |
11.00 |
PROCESS NOXREF APOST |
12.00 |
ID DIVISION. |
13.00 |
PROGRAM-ID. LISTCTRIFS. |
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 |
SELECT ctrdvy |
22.00 |
ASSIGN TO DATABASE-ctrdvy |
23.00 |
ORGANIZATION IS INDEXED |
24.00 |
ACCESS IS DYNAMIC |
25.00 |
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY |
26.00 |
FILE STATUS IS STATUS-ctrdvy. |
27.00 |
*---------------------------------- |
28.00 |
DATA DIVISION. |
29.00 |
FILE SECTION. |
30.00 |
*---------------------------------- |
31.00 |
FD ctrdvy |
32.00 |
LABEL RECORD IS STANDARD. |
33.00 |
01 ctrdvy-RECFD. |
34.00 |
COPY DDS-ALL-FORMAT OF ctrdvy. |
35.00 |
*================================================================= |
36.00 |
WORKING-STORAGE SECTION. |
37.00 |
*================================================================= |
38.00 |
* ----- Variables specific to this program ------ |
39.00 |
* |
40.00 |
01 HTML-DATA. |
41.00 |
* Variables to execute a command |
42.00 |
05 rc PIC S9(9) comp-4. |
43.00 |
05 cmd PIC X(2000). |
44.00 |
* Variables to parse the input string |
45.00 |
05 varnamein PIC X(50). |
46.00 |
05 xyrname PIC X(1000). |
47.00 |
05 request PIC X(1000). |
48.00 |
* Variables to load external HTML via QgetHtmlIFS |
49.00 |
05 IFSFile PIC X(1024). |
50.00 |
05 sectionDelimStr PIC X(20) VALUE '<as400>'. |
51.00 |
* Variable for QWrtSection subprocedure |
52.00 |
05 HtmlSects PIC X(1000). |
53.00 |
* Variables for QUpdHtmlVar subprocedure |
54.00 |
05 varnameout PIC X(30). |
55.00 |
05 varvalout PIC X(1000). |
56.00 |
* Miscellaneous variables |
57.00 |
01 MISC-DATA. |
58.00 |
05 LinesNbr PIC S9(05). |
59.00 |
05 wkf PIC X(01). |
60.00 |
05 openSW PIC X(01). |
61.00 |
05 edited-ctrday PIC ZZ9. |
62.00 |
* Status field |
63.00 |
05 status-ctrdvy PIC X(02). |
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 |
perform OpenFiles thru z-OpenFiles. |
70.00 |
perform GetCGIInput thru z-GetCGIInput. |
71.00 |
perform LoadHtml thru z-LoadHtml. |
72.00 |
perform SendHtml thru z-SendHtml. |
73.00 |
*---------------------------------- |
74.00 |
B-end-pgm. |
75.00 |
exit program and continue run unit. |
76.00 |
*================================================================= |
77.00 |
GetCGIInput. |
78.00 |
* Get input data from POST or GET |
79.00 |
call 'QZHBGETINPUT'. |
80.00 |
* Parse input string into program field 'xyrname': |
81.00 |
move 'xyrname' to varnamein. |
82.00 |
call 'QZHBGETVAR' using |
83.00 |
by content varnamein |
84.00 |
returning into xyrname. |
85.00 |
* Parse input string into program field 'request', cvt to uppercase |
86.00 |
move 'request' to varnamein. |
87.00 |
call 'QZHBGETVARUPPER' using |
88.00 |
by content varnamein |
89.00 |
returning into request. |
90.00 |
*---------------------------------- |
91.00 |
z-GetCGIInput. |
92.00 |
EXIT. |
93.00 |
*================================================================= |
94.00 |
LoadHtml. |
95.00 |
* Load html skeleton source member from IFS file |
96.00 |
move '/cgicbldev2/html/listctrifs.txt' to IFSFile. |
97.00 |
call 'QGETHTMLIFS' using |
98.00 |
IFSFile |
99.00 |
SectionDelimStr. |
100.00 |
*---------------------------------- |
101.00 |
z-LoadHtml. |
102.00 |
EXIT. |
103.00 |
*================================================================= |
104.00 |
SendHtml. |
105.00 |
*Send section /$top |
106.00 |
move 'top' to HtmlSects |
107.00 |
call 'QWRTSECTION' using HtmlSects. |
108.00 |
*Initial bootstrap |
109.00 |
if request = ' ' |
110.00 |
perform Case1 thru z-Case1 |
111.00 |
else |
112.00 |
perform Case2 thru z-Case2 |
113.00 |
end-if. |
114.00 |
*Send HTML buffer |
115.00 |
move '*fini' to HtmlSects |
116.00 |
call 'QWRTSECTION' using HtmlSects. |
117.00 |
*---------------------------------- |
118.00 |
z-SendHtml. |
119.00 |
EXIT. |
120.00 |
*================================================================= |
121.00 |
Case1. |
122.00 |
move 'case1' to HtmlSects |
123.00 |
call 'QWRTSECTION' using HtmlSects. |
124.00 |
*---------------------------------- |
125.00 |
z-Case1. |
126.00 |
EXIT. |
127.00 |
*================================================================= |
128.00 |
Case2. |
129.00 |
*Set output variable /%xyrname%/ |
130.00 |
move 'xyrname' to varnameout |
131.00 |
move xyrname to varvalout |
132.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
133.00 |
*Send section /$case2 |
134.00 |
move 'case2' to HtmlSects |
135.00 |
call 'QWRTSECTION' using HtmlSects. |
136.00 |
*Send countries table |
137.00 |
perform WriteRows thru z-WriteRows |
138.00 |
*Send section /$end |
139.00 |
move 'end' to HtmlSects |
140.00 |
call 'QWRTSECTION' using HtmlSects. |
141.00 |
*---------------------------------- |
142.00 |
z-Case2. |
143.00 |
EXIT. |
144.00 |
*================================================================= |
145.00 |
WriteRows. |
146.00 |
compute LinesNbr = 0. |
147.00 |
perform WriteRow thru z-WriteRow |
148.00 |
until status-ctrdvy not = '00'. 60 |
149.00 |
if LinesNbr >= 1 |
150.00 |
move 'tabend' to HtmlSects |
151.00 |
else |
152.00 |
move 'none' to HtmlSects |
153.00 |
end-if. |
154.00 |
call 'QWRTSECTION' using HtmlSects. |
155.00 |
*---------------------------------- |
156.00 |
z-WriteRows. |
157.00 |
EXIT. |
158.00 |
*================================================================= |
159.00 |
WriteRow. |
160.00 |
read ctrdvy next record |
161.00 |
at end |
162.00 |
move wkf to wkf. |
163.00 |
if status-ctrdvy = '00' |
164.00 |
compute LinesNbr = LinesNbr + 1 |
165.00 |
if LinesNbr = 1 |
166.00 |
move 'tabstr' to HtmlSects |
167.00 |
call 'QWRTSECTION' using HtmlSects |
168.00 |
end-if |
169.00 |
perform SetTabRow thru z-SetTabRow |
170.00 |
move 'tabrow' to HtmlSects |
171.00 |
call 'QWRTSECTION' using HtmlSects |
172.00 |
end-if. |
173.00 |
*---------------------------------- |
174.00 |
z-WriteRow. |
175.00 |
EXIT. |
176.00 |
*================================================================= |
177.00 |
SetTabRow. |
178.00 |
* Set HTML output variables |
179.00 |
* for section "tabrow" |
180.00 |
*================================== |
181.00 |
* Set output variable /%country%/ |
182.00 |
move 'country' to varnameout |
183.00 |
move ctrnam to varvalout |
184.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
185.00 |
* Set variable /%delvDays%/ |
186.00 |
* editing numeric filed "ctrday" (Signed 3,0) |
187.00 |
move 'delvdays' to varnameout |
188.00 |
move ctrday to edited-ctrday |
189.00 |
move edited-ctrday to varvalout |
190.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
191.00 |
*---------------------------------- |
192.00 |
z-SetTabRow. |
193.00 |
EXIT. |
194.00 |
*================================================================= |
195.00 |
OpenFiles. |
196.00 |
if openSW = ' ' |
197.00 |
move 'ovrdbf ctrdvy cgicbldev2/ctrdvy secure(*yes)' to cmd |
198.00 |
call 'QDOCMD' using cmd |
199.00 |
returning into rc |
200.00 |
open input ctrdvy |
201.00 |
move 'x' to openSW |
202.00 |
else |
203.00 |
move ' ' to ctrnam |
204.00 |
start ctrdvy key is >= externally-described-key |
205.00 |
end-if. |
206.00 |
*---------------------------------- |
207.00 |
Z-OpenFiles. |
208.00 |
EXIT. |
209.00 |
********* END OF PGM : LISTCTRIFS **************************************** |