กก
The Source
Code of An Example COBOL Program
This simple program
illustrates the basic concepts of PEWeb and PEDirect
and the Field-by-Field methodology. The program
retrieves 2 numbers and adds them together, and
displays the results. Then prompts the user if
another try is wanted. Main points to focus on are:
- Initial screen
paint
- Refreshing screen
content
- On-the-fly
processing of data sent by the browser or
PEDirect
- Use of a GUI
Message-box
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CPixieAdd.
000030 AUTHOR Rich Chilausky.
000040* Example program using ACCEPT, DISPLAY and ADD
to
000050* get two numbers from the user and add them
together
000060* and then do it again until told to stop.
000070*
000071 ENVIRONMENT DIVISION.
000073 CONFIGURATION SECTION.
000074 SPECIAL-NAMES.
000075 CONSOLE IS CONS.
000076
000085 DATA DIVISION.
000100
000101 WORKING-STORAGE SECTION.
000102 01 String1 PIC X(100) VALUE
"<tx>ireplace|doc1=<div
id=""doc1""
class=""doc1""
<style=""background-color:yellow"">
,".
000103 01 String2 PIC X(100) VALUE
"<h1>Hello World of
PixieLink</h1><br><strong>Add Two
Positive Numbers</strong><br /> <br
/> ,".
000104 01 String3 PIC X(100) VALUE "First Number
<input id=fx1 class=field2
style=""left:120px;width:80px;top:100px""
,".
000105 01 String4 PIC X(100) VALUE
"onChange=""JSCRIPT:EProcess(this);""><br
/> <br /> ,".
000106 01 String5 PIC X(100) VALUE "Second
Number<input id=fx2 class=field2
style=""left:120px;width:80px;top:130px""
,".
000107 01 String6 PIC X(100) VALUE
"onChange=""JSCRIPT:EProcess(this);"">
<br /> <br />,".
000108 01 String7 PIC X(100) VALUE
"<strong><em>Sum</em></strong><input
id=fx3 class=field2 ,".
000109 01 String8 PIC X(100) VALUE
"style=""left:110px;width:90px;top:160px"">^focus|fx1</tx>,".
000110 01 Buffer PIC X(600).
000113 01 RXBuf PIC X(14) VALUE SPACES.
000114 01 PositionPointers.
000115 02 pos PIC 9(3) VALUE ZERO.
000116 02 pos1 PIC 9(3) VALUE ZERO.
000117 02 pos2 PIC 9(3) VALUE ZERO.
000119 01 RXRecord.
000120 02 fidrx PIC X(4) VALUE SPACE.
000121 02 numrx PIC 9(10) VALUE ZERO.
000122 01 RXRecord2.
000123 02 aidrx PIC X(4) VALUE SPACE.
000124 02 yesno PIC X(4) VALUE SPACE.
000128 01 ANSWERAGAIN.
000129 02 valstr PIC X(14) VALUE
"<tx>focus|fx3=".
000130 02 answer PIC ZZZZZZZZZZ9
000131 VALUE ZERO.
000132 02 againstr PIC X(27) VALUE
"^msgbox|Again?\vbYesNo</tx>".
000133 01 FOCUS1 PIC X(18) VALUE
"<tx>focus|fx1</tx>".
000134 01 FOCUS2 PIC X(18) VALUE
"<tx>focus|fx2</tx>".
000135 01 CLEARTX PIC X(41) VALUE
"<tx>value|fx3=^value|fx2=^focus|fx1=</tx>".
000136 01 EXITPGM PIC X(13) VALUE
"<tx>exit</tx>".
000137 01 Num1 PIC 9(10) VALUE ZERO.
000138 01 Num2 PIC 9(10) VALUE ZERO.
000141 01 ConditionTRUE PIC 9.
000142 88 thisistrue VALUE 1.
000143*
000150 PROCEDURE DIVISION.
000151*
000152* Setup
000153*
000154 STRING String1 DELIMITED BY ","
000155 String2 DELIMITED BY ","
000156 String3 DELIMITED BY ","
000157 String4 DELIMITED BY ","
000158 String5 DELIMITED BY ","
000159 String6 DELIMITED BY ","
000160 String7 DELIMITED BY ","
000161 String8 DELIMITED BY "," INTO
Buffer.
000162 MOVE 0 TO ConditionTRUE.
000165*
000166* Begin Processing
000167*
000168 DISPLAY Buffer.
000169 PERFORM WITH TEST AFTER UNTIL thisistrue
000173 ACCEPT RXBuf FROM CONS
000174 PERFORM RXBufTORXRecord
000175 MOVE numrx TO Num1
000180 DISPLAY FOCUS2
000181 ACCEPT RXBuf FROM CONS
000190 PERFORM RXBufTORXRecord
000193 MOVE numrx TO Num2
000200 ADD Num1 TO Num2 GIVING answer
000210 DISPLAY ANSWERAGAIN
000211 ACCEPT RXBuf FROM CONS
000213 PERFORM RXBufTORXRecord2
000215 IF yesno IS EQUAL TO "<no>"
THEN
000216 MOVE 1 TO ConditionTRUE
000218 DISPLAY EXITPGM
000219 ELSE
000220 DISPLAY CLEARTX
000221 END-IF
000223 END-PERFORM.
000224 STOP RUN.
000226*
000227*
000230* Parse CobolLink string from RXBuf
000231* - into RXRecord
000240*
000250*
000320 RXBufTORXRecord.
000330 PERFORM VARYING pos1 FROM 1 BY 1 UNTIL pos1
> 4
000340 MOVE RXBuf(pos1:1) TO fidrx(pos1:1)
000350 END-PERFORM.
000360 MOVE ZERO TO numrx.
000361 MOVE 14 TO pos.
000362 PERFORM VARYING pos1 FROM 14 BY -1 UNTIL
RXBuf(pos1:1) IS NOT EQUAL TO SPACE
000363 SUBTRACT 1 FROM pos GIVING pos
000364 END-PERFORM
000365 MOVE 10 TO pos2.
000370 PERFORM
000371 VARYING pos1 FROM pos BY -1 UNTIL pos1 < 5
000390 MOVE RXBuf(pos1:1) TO numrx(pos2:1)
000391 * Should never reach condition pos2 < 1
000392 IF pos2 IS LESS THAN 1
000393 DISPLAY "<tx>msgbox|Number exceed
variable size. Digits over 10
truncated.\vbOK</tx>"
000394 EXIT PERFORM
000395 END-IF
000396 SUBTRACT 1 FROM pos2 GIVING pos2
000400 END-PERFORM.
000401*
000402* - into RXRecord2
000403*
000411 RXBufTORXRecord2.
000420 PERFORM VARYING pos1 FROM 1 BY 1 UNTIL pos1
> 4
000430 MOVE RXBuf(pos1:1) TO aidrx(pos1:1)
000440 END-PERFORM.
000460 MOVE SPACES TO yesno.
000470 PERFORM VARYING pos1 FROM 5 BY 1 UNTIL pos1
> 8
000471 SUBTRACT 4 FROM pos1 GIVING pos2
000472 MOVE RXBuf(pos1:1) TO yesno(pos2:1)
000480 END-PERFORM.
