1.00 |
********START OF PGM : RANDOMSTRG **************************************** |
2.00 |
*================================================================ |
3.00 |
* |
4.00 |
* After compiling this module, create the program as follow: |
5.00 |
* |
6.00 |
* CRTPGM PGM(CGICBLDEV2/RANDOMSTRG) MODULE(CGICBLDEV2/RANDOMSTRG) |
7.00 |
* BNDDIR(CGICBLDEV2/CGICBLDEV2) |
8.00 |
* ACTGRP(RANDOMSTRG) AUT(*USE) |
9.00 |
* |
10.00 |
*================================================================ |
11.00 |
PROCESS NOXREF APOST |
12.00 |
ID DIVISION. |
13.00 |
PROGRAM-ID. RANDOMSTRG. |
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 |
05 returnString PIC X(1000). |
34.00 |
05 stringLenC PIC X(2). |
35.00 |
05 stringLenDS redefines stringLenC. |
36.00 |
10 StringLenC1 PIC X(1). |
37.00 |
10 StringLenC2 PIC X(1). |
38.00 |
* Variables to load external HTML |
39.00 |
05 fn PIC X(10) VALUE 'HTMLEXAMPL'. |
40.00 |
05 lib PIC X(10) VALUE 'CGICBLDEV2'. |
41.00 |
05 mbr PIC X(10) VALUE 'RANDOMSTRG'. |
42.00 |
* Variable for QWrtSection procedure |
43.00 |
05 HtmlSects PIC X(1000). |
44.00 |
* Variables for QUpdHtmlVar procedure |
45.00 |
05 varnameout PIC X(30). |
46.00 |
05 varvalout PIC X(1000). |
47.00 |
* Variables for QChkNbr procedure |
48.00 |
05 isNumeric PIC S9(9) comp-4. |
49.00 |
05 char32 PIC X(32). |
50.00 |
* Variables for QRandomString procedure |
51.00 |
05 randomString PIC X(1024). |
52.00 |
05 stringLen PIC S9(9) comp-4. |
53.00 |
05 firstchar PIC X(1000). |
54.00 |
05 remainChar PIC X(1000). |
55.00 |
*================================================================= |
56.00 |
* M A I N - L I N E |
57.00 |
*================================================================= |
58.00 |
PROCEDURE DIVISION. |
59.00 |
A-start-pgm. |
60.00 |
* Load the external HTML |
61.00 |
call 'QGETHTML' using fn lib mbr. |
62.00 |
* Start response |
63.00 |
move 'top' to HtmlSects |
64.00 |
call 'QWRTSECTION' using HtmlSects. |
65.00 |
* Retrieve input variables |
66.00 |
call 'QZHBGETINPUT'. |
67.00 |
move 'request' to varnamein. |
68.00 |
call 'QZHBGETVARUPPER' using |
69.00 |
by content varnamein |
70.00 |
returning into returnString. |
71.00 |
move returnString to request. |
72.00 |
move 'stringLenC' to varnamein. |
73.00 |
call 'QZHBGETVARUPPER' using |
74.00 |
by content varnamein |
75.00 |
returning into returnString. |
76.00 |
move returnString to stringLenC. |
77.00 |
move 'firstChar' to varnamein. |
78.00 |
call 'QZHBGETVAR' using |
79.00 |
by content varnamein |
80.00 |
returning into firstChar. |
81.00 |
move 'remainChar' to varnamein. |
82.00 |
call 'QZHBGETVAR' using |
83.00 |
by content varnamein |
84.00 |
returning into remainChar. |
85.00 |
* Perform |
86.00 |
if request = ' ' |
87.00 |
perform Case1 thru z-Case1 |
88.00 |
else |
89.00 |
perform Case2 thru z-Case2 |
90.00 |
end-if. |
91.00 |
* Complete the response HTML and send the output buffer |
92.00 |
move 'end *fini' to HtmlSects |
93.00 |
call 'QWRTSECTION' using HtmlSects. |
94.00 |
*---------------------------------- |
95.00 |
B-end-pgm. |
96.00 |
exit program and continue run unit. |
97.00 |
*================================================================= |
98.00 |
Case1. |
99.00 |
*Let the user enter input |
100.00 |
* Set output variables |
101.00 |
Move 'stringLenC' to varnameout |
102.00 |
move stringLenC to varvalout |
103.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
104.00 |
Move 'sltfchar1' to varnameout |
105.00 |
if firstChar = '*upperLetter' |
106.00 |
move 'selected' to varvalout |
107.00 |
else |
108.00 |
move ' ' to varvalout |
109.00 |
end-if. |
110.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
111.00 |
Move 'sltfchar2' to varnameout |
112.00 |
if firstChar = '*lowerLetter' |
113.00 |
move 'selected' to varvalout |
114.00 |
else |
115.00 |
move ' ' to varvalout |
116.00 |
end-if. |
117.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
118.00 |
Move 'sltfchar3' to varnameout |
119.00 |
if firstChar = '*mixedLetter' |
120.00 |
move 'selected' to varvalout |
121.00 |
else |
122.00 |
move ' ' to varvalout |
123.00 |
end-if. |
124.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
125.00 |
Move 'sltfchar4' to varnameout |
126.00 |
if firstChar = '*upperDigit' |
127.00 |
move 'selected' to varvalout |
128.00 |
else |
129.00 |
move ' ' to varvalout |
130.00 |
end-if. |
131.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
132.00 |
Move 'sltfchar5' to varnameout |
133.00 |
if firstChar = '*lowerDigit' |
134.00 |
move 'selected' to varvalout |
135.00 |
else |
136.00 |
move ' ' to varvalout |
137.00 |
end-if. |
138.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
139.00 |
Move 'sltfchar6' to varnameout |
140.00 |
if firstChar = '*mixedDigit' |
141.00 |
move 'selected' to varvalout |
142.00 |
else |
143.00 |
move ' ' to varvalout |
144.00 |
end-if. |
145.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
146.00 |
Move 'sltfchar7' to varnameout |
147.00 |
if firstChar = '*digit' |
148.00 |
move 'selected' to varvalout |
149.00 |
else |
150.00 |
move ' ' to varvalout |
151.00 |
end-if. |
152.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
153.00 |
Move 'sltrchar1' to varnameout |
154.00 |
if remainChar = '*upperLetter' |
155.00 |
move 'selected' to varvalout |
156.00 |
else |
157.00 |
move ' ' to varvalout |
158.00 |
end-if. |
159.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
160.00 |
Move 'sltrchar2' to varnameout |
161.00 |
if remainChar = '*lowerLetter' |
162.00 |
move 'selected' to varvalout |
163.00 |
else |
164.00 |
move ' ' to varvalout |
165.00 |
end-if. |
166.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
167.00 |
Move 'sltrchar3' to varnameout |
168.00 |
if remainChar = '*mixedLetter' |
169.00 |
move 'selected' to varvalout |
170.00 |
else |
171.00 |
move ' ' to varvalout |
172.00 |
end-if. |
173.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
174.00 |
Move 'sltrchar4' to varnameout |
175.00 |
if remainChar = '*upperDigit' |
176.00 |
move 'selected' to varvalout |
177.00 |
else |
178.00 |
move ' ' to varvalout |
179.00 |
end-if. |
180.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
181.00 |
Move 'sltrchar5' to varnameout |
182.00 |
if remainChar = '*lowerDigit' |
183.00 |
move 'selected' to varvalout |
184.00 |
else |
185.00 |
move ' ' to varvalout |
186.00 |
end-if. |
187.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
188.00 |
Move 'sltrchar6' to varnameout |
189.00 |
if remainChar = '*mixedDigit' |
190.00 |
move 'selected' to varvalout |
191.00 |
else |
192.00 |
move ' ' to varvalout |
193.00 |
end-if. |
194.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
195.00 |
Move 'sltrchar7' to varnameout |
196.00 |
if remainChar = '*digit' |
197.00 |
move 'selected' to varvalout |
198.00 |
else |
199.00 |
move ' ' to varvalout |
200.00 |
end-if. |
201.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
202.00 |
* write sections |
203.00 |
move 'case1' to HtmlSects |
204.00 |
call 'QWRTSECTION' using HtmlSects. |
205.00 |
*---------------------------------- |
206.00 |
z-Case1. |
207.00 |
EXIT. |
208.00 |
*================================================================= |
209.00 |
Case2. |
210.00 |
* Check for numeric value in input variable stringLenC |
211.00 |
if stringLenC='0' |
212.00 |
move '01' to stringLenC |
213.00 |
end-if. |
214.00 |
if stringLenC2=' ' |
215.00 |
move stringLenC1 to stringLenC2 |
216.00 |
move '0' to stringLenC1 |
217.00 |
end-if. |
218.00 |
move stringLenC to char32 |
219.00 |
call 'QCHKNBR' using char32 |
220.00 |
returning isNumeric. |
221.00 |
if isNumeric not = 0 |
222.00 |
move 'stringLenC' to varnameout |
223.00 |
if stringLenC not = ' ' |
224.00 |
move stringLenC to varvalout |
225.00 |
else |
226.00 |
move ' ' to varvalout |
227.00 |
end-if |
228.00 |
call 'QUPDHTMLVAR' using varnameout varvalout |
229.00 |
move 'badlen' to HtmlSects |
230.00 |
call 'QWRTSECTION' using HtmlSects |
231.00 |
perform case1 thru z-Case1 |
232.00 |
go to z-Case2 |
233.00 |
end-if. |
234.00 |
* Convert to numeric |
235.00 |
move StringLenC to StringLen |
236.00 |
* Retrieve random string |
237.00 |
call 'QRANDOMSTRING' using |
238.00 |
stringLen |
239.00 |
firstChar |
240.00 |
remainChar |
241.00 |
returning randomString. |
242.00 |
* Provide for further input |
243.00 |
perform case1 thru z-Case1 |
244.00 |
* Report the generated random string |
245.00 |
move 'randomString' to varnameout |
246.00 |
move randomString to varvalout |
247.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
248.00 |
move 'case2' to HtmlSects |
249.00 |
call 'QWRTSECTION' using HtmlSects. |
250.00 |
*---------------------------------- |
251.00 |
z-Case2. |
252.00 |
EXIT. |
253.00 |
********* END OF PGM : RANDOMSTRG **************************************** |