products/Sources/formale Sprachen/COBOL/verschiedene-Autoren/Zing-COBOL/  image not shown  

Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: Util.java   Sprache: JAVA

Original von: verschiedene©
 products/Sources/formale Sprachen/COBOL/verschiedene-Autoren/Zing-COBOL/sample COCOL code.html


<html><head><title>Sample Code</title>





<script src="sam-Dateien/common.js">
</script><link rel="stylesheet" href="sam-Dateien/zingcob.css" type="text/css"></head><body onload="setVariables();checkLocation();MessageOn()" alink="#00ffa5" background="sam-Dateien/t2sam.jpg" link="#dc0000" vlink="#272773">            <a href="http://www.404i.com/cobol/samprint.html">Print-friendly version</a>

<script language="Javascript">

function MessageOn() {

var MessText = '------------- 10. SAMPLE CODE -------------';
window.status = MessText;
}

</script>









<div id="object1" style="position: absolute; left: 90%; top: 0px; z-index: 2;">
<form>
<font face="Arial" size="1"><input value="SITE MENU" onclick="showRemote();" type="button"></font>
</form>
</div>

<hr size="1" width="70%">

<center>
<table bgcolor="#ecf7f4" border="0" cellpadding="10" width="450">
<tbody><tr><td>



<b><font face="Arial" size="4">
10. Sample COBOL code 
</font></b><font face="Arial,Helvetica"><font size="+1"></font></font>

<p><font face="Arial">
                
<a href="http://www.404i.com/cobol/cng/index.html">10.0 Complete program specification for suite of 3 linked programs</a>:<br>
                
 includes structure and flow charts, 
program description, test data, and full code listing.<br>
                
<a href="#ADD">10.1 Add line number program</a>
<br>                
<a href="#REF">10.2 Refresh line numbers program</a>
<br>                
<a href="#LEA">10.3 League table program</a>
<br>                
<a href="#CAL">10.4 Calculate prime numbers program</a>
<br>                
<a href="#CIN">10.5 Create INDEXED file program</a>
<br>                
<a href="#RIN">10.6 Read INDEXED file program</a><br><br><br>
<br>

</font></p><p><font face="Arial">The sample code here was written while learning COBOL so they aren't particularly well
structured. Also, they are not the usual type of COBOL program that you would normally come 
across. COBOL is more likely written for business applications such as payroll programs 
or stock control etc... Hopefully they might give an indication of how COBOL works.



</font></p><p><font face="Arial"><a name="ADD"> </a><br>
<b><font face="Arial">10.1 Add line numbers program</font></b>
</font></p><p><font face="Arial">This program is designed to add line numbers to COBOL code that has been 
typed into a text editor (e.g. Notepad) in the following format:<br>

</font></p><center>
<table border="1">
<tbody><tr><td>
<font face="Courier New">
<b><pre>   :
PROCEDURE DIVISION.

MAIN-PARAGRAPH.
      MOVE X TO Y
*the comment asterisk will be placed in position 7
/as will the page break solidus
      IF Y > Z THEN 
          ADD Z TO X
          MOVE X TO Z
      ELSE DISPLAY 'The hypen for continuing a string
-              'onto the next line also goes into position 7'
      END-IF
*all other text is placed from position 8 
*so you still need to indent where required
STOP RUN.

*lastly, there is a limit of about 
*70 characters per line (from position 8)
</pre>
</b>
</font>
</td></tr>
</tbody></table><font face="Arial"><br>
</font></center>
<font face="Arial">The text file containing COBOL code as above should be call named <b>input.txt</b>. Following execution, 
the program will produce a new file called <b>output.cob</b> although it will still be a simply text file, but 
can be compiled. The output.cob file for the above code would be:<br>
</font><center>
<table border="1">
<tbody><tr><td>
<font face="Courier New">
<b><pre>   :
000010 PROCEDURE DIVISION.
000020
000030 MAIN-PARAGRAPH.
000040     MOVE X TO Y
000050*the comment asterisk will be placed in position 7
000060/as will the page break solidus
000070     IF Y > Z THEN 
000080        ADD Z TO X
000090        MOVE X TO Z
000100     ELSE DISPLAY 'The hypen for continuing a string
000110-              'onto the next line also goes into position 7'
000120     END-IF
000130*all other text is placed from position 8 
000140*so you still need to indent where required
000150     STOP RUN.
000160
000170*lastly, there is a limit of about 
000180*70 characters per line (from position 8)
</pre>
</b>
</font>
</td></tr>
</tbody></table><font face="Arial"><br><br>
</font></center>

<form name="form1">
<p></p><center><font face="Arial"><font face="Courier New">
<textarea rows="25" cols="69" wrap="NO" name="txt">000010 IDENTIFICATION DIVISION.                       
000020 PROGRAM-ID. LINE-NO-PROG.                        
000030 AUTHOR.     TIM R P BROWN.    
000040****************************************************
000050* Program to add line numbers to typed code        *    
000060* Allows for comment asterisk, solidus, or hyphen ,*     
000070* moving it into position 7.                       *  
000080*                                                  *  
000090****************************************************  
000100                              
000110 ENVIRONMENT DIVISION.              
000120 INPUT-OUTPUT SECTION.              
000130 FILE-CONTROL.                 
000140     SELECT IN-FILE ASSIGN TO 'INPUT.TXT'     
000150        ORGANIZATION IS LINE SEQUENTIAL.  
000160     SELECT OUT-FILE ASSIGN TO 'OUTPUT.COB'      
000170        ORGANIZATION IS LINE SEQUENTIAL. 
000180 
000185*****************************************************
000187                    
000190 DATA DIVISION.                     
000200 FILE SECTION.                   
000210             
000220 FD IN-FILE.                      
000230 01 LINE-CODE-IN.            
000240     03 CHAR-1       PIC X.     
000250     03 CODE-LINE    PIC X(110).       
000260                                
000270 FD OUT-FILE.                 
000280 01 LINE-CODE-OUT    PIC X(120).             
000290                                                 
000300                                            
000310 WORKING-STORAGE SECTION.                  
000320                                   
000330 01 EOF-FLAG     PIC X VALUE 'N'.        
000340     88 END-OF-FILE        VALUE 'Y'.   
000350                                        
000360 01 NUMBER-CODE.                               
000370     03 L-NUM-CODE    PIC 9(6) VALUE ZEROS.    
000380     03 B-SPACE   PIC X VALUE SPACE.          
000390     03 L-CODE    PIC X(100) VALUE SPACES.    
000400                            
000410 01 NUMBER-COMMENT.                 
000420     03 L-NUM-COM     PIC 9(6) VALUE ZEROS.     
000430     03 L-COMMENT     PIC X(100) VALUE SPACES.  
000440                       
000450 01 LINE-NUMBER      PIC 9(6) VALUE ZEROS.     
000460                     
000470                            
000480*****************************************************
000490                              
000500 PROCEDURE DIVISION.
000510                                              
000510 MAIN-PARA.                        
000520     OPEN INPUT IN-FILE                
000530          OUTPUT OUT-FILE
000535        
000540     PERFORM UNTIL END-OF-FILE              
000550       ADD 10 TO LINE-NUMBER                
000560       READ IN-FILE AT END    
000570         MOVE 'Y' TO EOF-FLAG              
000580       NOT AT END                   
000590         IF     (CHAR-1 = '*')             
000600                  OR (CHAR-1 = '/')             
000610                  OR (CHAR-1 = '-') THEN        
000620            MOVE LINE-CODE-IN TO L-COMMENT   
000630            MOVE LINE-NUMBER TO L-NUM-COM   
000640            WRITE LINE-CODE-OUT FROM NUMBER-COMMENT  
000660         ELSE                                  
000670            MOVE LINE-CODE-IN TO L-CODE                
000680            MOVE LINE-NUMBER TO L-NUM-CODE         
000690            WRITE LINE-CODE-OUT FROM NUMBER-CODE        
000720         END-IF                                     
000730       END-READ                                
000740       INITIALIZE NUMBER-CODE NUMBER-COMMENT   
000750     END-PERFORM                           
000760                                        
000770     CLOSE IN-FILE OUT-FILE             
000780     STOP RUN.                           
</textarea></font>
<input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">

</font></center>

<p><font face="Arial"><a name="REF"> </a><br>

<b><font face="Arial">10.2 Refresh line numbers program</font></b>
</font></p><p><font face="Arial">This program is designed to refresh COBOL code line numbers following editing that would 
result in uneven line number increases (or even no line number at all) where lines have been 
inserted or deleted.

</font></p><form name="form2">
<p></p><center><font face="Arial"><font face="Courier New">
<textarea rows="25" cols="70" wrap="yes" name="txt"> 00010 IDENTIFICATION DIVISION.       
 00020 PROGRAM-ID.    RENUMBER-PROG. 
 00030 AUTHOR.        TIMOTHY R P BROWN.  
 00040    
 00045******************************************************  
 00050* Program to refresh numbers to typed code           *       
 00060* Allows for comment all characters at position 7    *
 00065****************************************************** 
 00070                                       
 00080                  
 00090 ENVIRONMENT DIVISION.
 00100 INPUT-OUTPUT SECTION.     
 00110 FILE-CONTROL.                   
 00120        SELECT IN-FILE ASSIGN TO 'INPUT.COB'   
 00130        ORGANIZATION IS LINE SEQUENTIAL.     
 00140        SELECT OUT-FILE ASSIGN TO 'RENUM.COB'   
 00150        ORGANIZATION IS LINE SEQUENTIAL.   
 00160                
 00170 DATA DIVISION.     
 00180 FILE SECTION.    
 00190                         
 00200 FD IN-FILE.               
 00210 01 CODE-IN.
 00230        03 OLD-NUM  PIC 9(6).            
 00240        03 IN-CODE  PIC X(150).         
 00250                              
 00260 FD OUT-FILE.      
 00270 01 CODE-OUT        PIC X(91).    
 00280                        
 00290                         
 00300 WORKING-STORAGE SECTION.   
 00310                           
 00320 01 EOF-FLAG PIC X VALUE 'N'.  
 00330        88 END-OF-FILE  VALUE 'Y'.    
 00340                            
 00350              
 00360 01 W-RENUMBER-CODE.      
 00370        03 W-NUM   PIC 9(6) VALUE ZEROS.    
 00380    03 W-CODE      PIC X(85) VALUE SPACES.  
 00390                            
 00400 01 LINE-NUMBER    PIC 9(6) VALUE ZEROS.    
 00403
 00407*****************************************************
 00410                                      
 00420 PROCEDURE DIVISION.                  
 00430 MAIN-PARA.                   
 00440        OPEN INPUT IN-FILE    
 00450             OUTPUT OUT-FILE     
 00460                               
 00470        PERFORM UNTIL END-OF-FILE      
 00480           ADD 10 TO LINE-NUMBER           
 00490           READ IN-FILE 
 00495              AT END MOVE 'Y' TO EOF-FLAG 
 00500              NOT AT END             
 00510                MOVE IN-CODE TO W-CODE        
 00520                MOVE LINE-NUMBER TO W-NUM    
 00530                WRITE CODE-OUT FROM W-RENUMBER-CODE  
 00550           END-READ  
 00570        END-PERFORM    
 00580                       
 00590        CLOSE IN-FILE OUT-FILE            
 00600        STOP RUN.    
</textarea></font>
<input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">

</font></center>


<p><font face="Arial"><a name="LEA"> </a><br>
<b><font face="Arial">10.3 League table program</font></b>
</font></p><p><font face="Arial">This program is designed to update a football league table and print out a table 
when any scores have been added. The diplay prompts the user to input the score from 
a game. The points for each team involved are updated, as are the goals for, against and 
difference. The program will search the data file and update the relevant team record. 
When score input is complete, the program then sorts the data into a temporary file before 
printing out an updated league table. An OUTPUT PROCEDURE could have been used 
instead of producing a temporary sorted file.
</font></p><p><font face="Arial"> This program would probably benefit from using an indexed file for the team records rather 
than searching the sequentail file, as done here. 
</font></p><p><font face="Arial"> This code is written for the 1999-2000 season of the English FA Premiership. 
The team data is stored on a sequential file in alphabetical order. If you wish to download 
a copy of this data file (with mostly fictional scores etc..) <a href="http://www.404i.com/cobol/dlfiles/footprog.zip">
click here</a> and a better program description <a href="http://www.404i.com/cobol/dlfiles/foot-prog-desc.html">click here</a>. 
</font></p><p></p><center><font face="Arial"><font face="Courier New">

</font></font><form name="form3">
<textarea rows="25" cols="70" wrap="no" name="txt">000010 IDENTIFICATION DIVISION.                            
000020 PROGRAM-ID. TABLE-PROG.                             
000030 AUTHOR.     TIMOTHY R P BROWN.
000035                        
000037*****************************************************      
000040* Program to update a football league table         *
000045* and output a new updated table                    *
000046* Based on English Premiership season 1999-2000     *
000047*****************************************************
000048             
000050 ENVIRONMENT DIVISION.                                       
000060 INPUT-OUTPUT SECTION.                                       
000070 FILE-CONTROL.                                               
000080     SELECT TEAM-REC-IN ASSIGN TO "INPUT.REC"                
000090        ORGANIZATION IS SEQUENTIAL.                
000100     SELECT WORK-FILE ASSIGN TO SORTWK01.
000105* for MicroFocus compiler 
000107* replace SORTWK01 with 'WORKFILE.DAT' 
000110     SELECT SORT-OUT ASSIGN TO "SORTED.REC"                  
000120        ORGANIZATION IS SEQUENTIAL.                    
000130     SELECT PRINT-FILE ASSIGN TO PRINTER.             
000140                                                             
000150                                                             
000160 DATA DIVISION.                                              
000170 FILE SECTION.                                               
000180 FD TEAM-REC-IN.                                             
000190 01 TEAM-REC.                                                
000200     03  TEAM-CODE   PIC XXX.                                
000210     03  TEAM-NAME   PIC X(20).                              
000220     03  PLAYED      PIC 99.                           
000230     03  GOALS-FOR   PIC 99.                                 
000240     03  GOALS-AGST  PIC 99.                                 
000250     03  G-WON       PIC 99.                            
000260     03  G-LOST      PIC 99.                       
000270     03  G-DRAWN     PIC 99.                          
000280     03  GOAL-DIFF   PIC S99 SIGN LEADING SEPARATE.          
000290     03  POINTS      PIC 99.                           
000300                                                             
000310 SD WORK-FILE.                                               
000320 01 WORK-REC.                                                
000330     03  TEAM-CODE-KEY PIC XXX.                              
000340     03                PIC X(22).                            
000350     03  GF-KEY        PIC 99.                               
000360     03                PIC X(8).                             
000370     03  GD-KEY        PIC S99  SIGN LEADING SEPARATE.       
000380     03  POINTS-KEY    PIC 99.                               
000390                                                             
000400                                                             
000410 FD PRINT-FILE.                                              
000420 01 TEXT-OUT     PIC X(60).                                  
000430                                                             
000440 FD SORT-OUT.                                                
000450 01 TEAM-REC-OUT.                                            
000460     03  STEAM-CODE  PIC XXX.                                
000470     03  STEAM-NAME  PIC X(20).                              
000480     03  SPLAYED     PIC 99.                   
000490     03  SGOALS-FOR  PIC 99.                                 
000500     03  SGOALS-AGST PIC 99.                                 
000510     03  SG-WON      PIC 99.                   
000520     03  SG-LOST     PIC 99.                  
000530     03  SG-DRAWN    PIC 99.                                 
000540     03  SGOAL-DIFF  PIC S999.                               
000550     03  SPOINTS     PIC 99.               
000560                                                             
000570                                                             
000580                                                             
000590                                                             
000600 WORKING-STORAGE SECTION.                                    
000610                                                             
000620 01 M              PIC 99.             
000630 01 REAL-GOAL-DIFF PIC S999.                                 
000640                                                             
000650 01 W-DATE.                                                  
000660     03  W-YEAR    PIC 99.                      
000670     03  W-MON     PIC 99.                      
000680     03  W-DAY     PIC 99.                       
000690                                                             
000700                                                             
000710 01 SCORE.                                                   
000720     03 W-H-SCR    PIC 9.                       
000730     03            PIC X VALUE "-".             
000740     03 W-A-SCR    PIC 9.                         
000750                                                             
000760 01 P-TITLE.                                                 
000770     03            PIC X(5) VALUE SPACES.         
000780     03 TAB-TITLE  PIC X(34)                               
000790         VALUE "The English FA Premier League".              
000800                                                             
000810     03 P-DATE.                                              
000820         05 P-DAY  PIC XX.                                 
000830         05        PIC X VALUE "/".               
000840         05 P-MON  PIC XX.                                 
000850         05        PIC X VALUE "/".                
000860         05 P-YEAR PIC XX.                                 
000870                                                      
000880 01 P-UNDERLINE    PIC X(45) VALUE ALL "-".            
000890 01 P-GAP          PIC X VALUE SPACE.                      
000900                                                             
000910 01 P-HEADER.                                                
000920     03          PIC X(6) VALUE SPACES.         
000930     03 TAB-TEAM PIC X(4) VALUE "TEAM".                      
000940     03          PIC X(11) VALUE SPACES.        
000950     03 PLY      PIC X(5) VALUE "Playd".                     
000960     03          PIC X VALUE SPACE.                 
000970     03 WO       PIC XXX VALUE "Won".                        
000980     03          PIC X VALUE SPACE.               
000990     03 DR       PIC XXXX VALUE "Drwn".                      
001000     03          PIC X VALUE SPACE.               
001010     03 LO       PIC XXXX VALUE "Lost".                      
001020     03          PIC X VALUE SPACE.             
001030     03 GF       PIC XXX VALUE "For".                        
001040     03          PIC X VALUE SPACE.                
001050     03 GA       PIC X(5) VALUE "Agnst".                     
001060     03          PIC X VALUE SPACE.                 
001070     03 GD       PIC XX VALUE "GD".                          
001080     03          PIC X VALUE SPACE.              
001090     03 PTS      PIC XXX VALUE "PTS".                        
001100                                                             
001110 01 W-TEXT-OUT.                                              
001120     03  P-TAB-POS   PIC 99.                                 
001130     03              PIC X VALUE SPACE.            
001140     03  P-TEAM      PIC X(20).            
001150     03  P-PLAYED    PIC 99.                                 
001160     03              PIC XXX VALUE SPACES.        
001170     03  P-G-WON     PIC Z9.                       
001180     03              PIC XX VALUE SPACES.           
001190     03  P-G-DRAWN   PIC Z9.                                 
001200     03              PIC XXX VALUE SPACES.    
001210     03  P-G-LOST    PIC Z9.                                 
001220     03              PIC XXX VALUE SPACES.     
001230     03  P-GOALS-FOR PIC 99.                                 
001240     03              PIC XX VALUE SPACES.         
001250     03  P-GOALS-AGST  PIC 99.                               
001260     03              PIC XX VALUE SPACES.         
001270     03  P-GOAL-DIFF PIC ZZ9.                                
001280     03              PIC XX VALUE SPACES.       
001290     03  P-POINTS    PIC Z9.                                 
001300                                                             
001310                                                             
001320 01 SCORE-TAB.                                               
001330     03 TAB-SCORE    PIC 9 OCCURS 2.                         
001340 01 T-POINTS-TAB.                                            
001350     03 T-POINTS     PIC 99 OCCURS 20.             
001360 01 POINTS-TAB.                                              
001370     03  TAB-POINTS  PIC 9 OCCURS 2.                         
001380 01 T-G-FOR-TAB.                                             
001390     03 T-G-FOR      PIC 99 OCCURS 20.          
001400 01 T-G-AGST-TAB.                                            
001410     03 T-G-AGST     PIC 99 OCCURS 20.         
001420 01 T-G-DIFF-TAB.                                            
001430     03 T-G-DIFF     PIC 99 OCCURS 20.             
001440 01 TAB-TEAM-NAME.                                           
001450     03  TEAM        PIC XXX OCCURS 2.            
001460                                                             
001470                                                             
001480 01 V-TEAM-FLAG      PIC X.                                  
001490     88  V-TEAM      VALUE "Y".                              
001500 01 V-SCORE-FLAG     PIC X.                                  
001510     88  V-SCORE     VALUE "Y".                              
001520 01 SORT-ONLY-FLAG   PIC X.                                  
001530     88 SORT-ONLY    VALUE "Y".                              
001540                                                             
001550                                                             
001560 01 ENDING-KEY       PIC X VALUE SPACE.                      
001570 01 SWITCH           PIC 9.                         
001580 01 EOF-FLAG         PIC X VALUE "N".            
001590 01 COUNTER          PIC 99.                     
001600 01 W-GOAL-DIFF      PIC 99.                                 
001610 01 LAST-SCORE       PIC X.                                  
001620 01 N                PIC 99.                    
001630                                                             
001640*****************************************************
001650                                                             
001660 PROCEDURE DIVISION.                                         
001670                                                             
001680 MAIN-PARAGRAPH.                                             
001690                                                             
001700     PERFORM DISPLAY-INSTRUCTIONS         
001710     PERFORM INPUT-DATA                                      
001720     PERFORM SORT-TABLE                                      
001730     PERFORM PRINT-TABLE                                     
001740     DISPLAY " Type Q or X to exit program."                 
001750     ACCEPT ENDING-KEY                                       
001760     STOP RUN.                                               
001770*******************************************************************
001780 DISPLAY-INSTRUCTIONS. 
001790     DISPLAY " Instructions"                               
001800     DISPLAY " "                                             
001810     DISPLAY " Following prompts, enter the first "          
001820     DISPLAY "3 letters of the team in lower case. "         
001830     DISPLAY " Then enter the score (home team score first)." 
001840     DISPLAY " To perform SORT ONLY function, type 'xxx' "   
001850     DISPLAY "at both team prompts. ".                       
001860*******************************************************************
001870 INPUT-DATA.                                                 
001880     MOVE "n" TO LAST-SCORE                                  
001890     MOVE "N" TO SORT-ONLY-FLAG                              
001900     PERFORM UNTIL LAST-SCORE = "y" OR "Y"                   
001910        MOVE "N" TO V-SCORE-FLAG                     
001920        MOVE "N" TO V-TEAM-FLAG                  
001930        PERFORM UNTIL V-TEAM                                
001940            DISPLAY "INPUT HOME TEAM >"                      
001950            ACCEPT TEAM (1)                                  
001960            DISPLAY "INPUT AWAY TEAM >"                      
001970            ACCEPT TEAM (2)                                  
001980            PERFORM VAL-TEAM                                 
001990         END-PERFORM                                         
002000         IF TEAM (1) = "XXX" OR "xxx" THEN                   
002010             MOVE "Y" TO LAST-SCORE                          
002020             PERFORM SORT-TABLE                              
002030         ELSE                                                
002040         PERFORM UNTIL V-SCORE or SORT-ONLY                  
002050            DISPLAY "INPUT RESULT AS 'X-Y'"                  
002060            ACCEPT SCORE                                     
002070            MOVE W-H-SCR TO TAB-SCORE (1)                    
002080            MOVE W-A-SCR TO TAB-SCORE (2)                    
002090            PERFORM VAL-SCORE                                
002100         END-PERFORM                                         
002110         DISPLAY "LAST RESULT? Y/N"                          
002120         ACCEPT LAST-SCORE                                   
002130         PERFORM CALC-POINTS                                 
002140         PERFORM UPDATE-RECORD                               
002150         END-IF                                              
002160     END-PERFORM.                                            
002170*******************************************************************
002180 VAL-TEAM.                                                   
002190     PERFORM VARYING COUNTER FROM 1 BY 1                     
002200                 UNTIL COUNTER > 2              
002210                                                             
002220        EVALUATE TRUE                          
002230           WHEN TEAM (COUNTER) = "ars" or "ast" or "bra" or  
002240                     "che" or "cov" or "der" or              
002250                     "eve" or "lee" or "lei" or              
002260                     "liv" or "man" or "mid" or              
002270                     "new" or "she" or "sou" or              
002280                     "sun" or "tot" or "wat" or              
002290                     "wes" or "wim"                          
002300               MOVE "Y" TO V-TEAM-FLAG                 
002310           WHEN OTHER MOVE "N" TO V-TEAM-FLAG        
002320        END-EVALUATE     
002340     END-PERFORM                                             
002350     IF NOT V-TEAM THEN DISPLAY                              
002360             "INVALID TEAM CODE ENTERED-"                    
002370             "RE-ENTER BOTH TEAM CODES AGAIN."               
002380     END-IF.                                                 
002390*******************************************************************
002400 VAL-SCORE.                                                  
002410     IF ( W-H-SCR > 9 ) OR ( W-A-SCR > 9 )                   
002420         THEN PERFORM BIG-SCORE                              
002430     END-IF                                                  
002440     IF ( W-H-SCR NOT NUMERIC) OR ( W-H-SCR NOT NUMERIC)     
002450         THEN MOVE "N" TO V-SCORE-FLAG                       
002460     ELSE MOVE "Y" TO V-SCORE-FLAG                           
002470     END-IF                                                  
002480     IF NOT V-SCORE THEN                                     
002490        DISPLAY "INVALID SCORE ENTRY. PLEASE RE-ENTER SCORE."
002500     END-IF.                                                 
002510*******************************************************************
002520 BIG-SCORE.   
002525* Putting a STOP RUN in this paragraph is probably
002527* very bad programming practise. Better logic could be used!
002530     DISPLAY "A team has scored more than 10 goals. "        
002540     DISPLAY "This program will terminate now. "             
002550     DISPLAY "Following this, the record in Input.rec "      
002560     DISPLAY "will have to be ammended manually"
002580     DISPLAY " Following this perform SORT ONLY procedure."  
002600     ACCEPT ENDING-KEY                                      
002610     STOP RUN.                                               
002620                                                             
002630*******************************************************************
002640 CALC-POINTS.                                                
002650     IF TAB-SCORE (1) > TAB-SCORE (2) THEN                   
002660         MOVE 3 TO TAB-POINTS (1)                            
002670     ELSE                                                    
002680         IF TAB-SCORE (2) > TAB-SCORE (1) THEN               
002690             ADD 3 TO TAB-POINTS (2)                         
002700         ELSE                                                
002710             MOVE 1 TO TAB-POINTS (1)                        
002720             MOVE 1 TO TAB-POINTS (2)                        
002730         END-IF                                              
002740     END-IF.                                                 
002750                                                             
002760*******************************************************************
002770 UPDATE-RECORD.                
002790     MOVE 1 TO N                                             
002800     MOVE 1 TO M                                             
002810     OPEN I-O TEAM-REC-IN                                    
002820     PERFORM UNTIL M > 20                                    
002830     READ TEAM-REC-IN                                        
002840     AT END                                                  
002850         DISPLAY TEAM (1) " has details ammended"            
002860     NOT AT END                                              
002870     IF TEAM (1) = TEAM-CODE THEN                            
002880         PERFORM ADJUST-DATA                                 
002890                                                             
002900     END-IF                                                  
002910     ADD 1 TO M                                              
002920     END-READ                                                
002930     END-PERFORM                                             
002940                                                             
002950     CLOSE TEAM-REC-IN                                       
002955
002970     MOVE 2 TO N                                             
002980     MOVE 1 TO M 
002980                                            
002990     OPEN I-O TEAM-REC-IN                                    
003000     PERFORM UNTIL M > 20                                    
003010        READ TEAM-REC-IN                                
003020           AT END                                  
003030               DISPLAY TEAM (2) " has details ammended"
003040           NOT AT END                                   
003050             IF TEAM (2) = TEAM-CODE THEN             
003060                PERFORM ADJUST-DATA       
003080             END-IF                                  
003090             ADD 1 TO M                             
003100        END-READ                        
003110     END-PERFORM                                             
003120     CLOSE TEAM-REC-IN                                       
003130     DISPLAY "Table has been updated".                       
003140*******************************************************************
003150 ADJUST-DATA.                                                
003160     IF N = 1 THEN MOVE 2 TO SWITCH                          
003170     ELSE MOVE 1 TO SWITCH                                   
003180     END-IF                                                  
003190         ADD TAB-SCORE (N) TO GOALS-FOR                      
003200         ADD TAB-SCORE (SWITCH) TO GOALS-AGST                
003210         SUBTRACT GOALS-AGST FROM GOALS-FOR GIVING GOAL-DIFF 
003220         ADD TAB-POINTS (N) TO POINTS                        
003230         ADD 1 TO PLAYED                                     
003240         EVALUATE TAB-POINTS (N)                             
003250             WHEN 3 ADD 1 TO G-WON                           
003260             WHEN ZERO ADD 1 TO G-LOST                       
003270             WHEN 1 ADD 1 TO G-DRAWN                         
003280         END-EVALUATE                                        
003290         REWRITE TEAM-REC.                                   
003300*******************************************************************
003310 SORT-TABLE.                                                 
003320     SORT WORK-FILE                                          
003330         ON DESCENDING KEY POINTS-KEY GD-KEY GF-KEY          
003340         USING TEAM-REC-IN                                   
003350         GIVING SORT-OUT.                                    
003360                                                             
003370*******************************************************************
003380 PRINT-TABLE.                                                
003390     ACCEPT W-DATE FROM DATE                                 
003400     MOVE W-DAY TO P-DAY                                     
003410     MOVE W-MON TO P-MON                                     
003420     MOVE W-YEAR TO P-YEAR                                   
003430                                                             
003440     OPEN INPUT SORT-OUT                                     
003450          OUTPUT PRINT-FILE                                  
003460                                                             
003470     WRITE TEXT-OUT FROM P-TITLE AFTER 1 LINE                
003480     WRITE TEXT-OUT FROM P-UNDERLINE AFTER 1 LINE            
003490     WRITE TEXT-OUT FROM P-GAP AFTER 1 LINE                  
003500     WRITE TEXT-OUT FROM P-HEADER AFTER 1 LINE               
003510     MOVE 1 TO N                                             
003520     PERFORM UNTIL N > 20                                    
003530        READ SORT-OUT                               
003540           AT END MOVE "Y" TO EOF-FLAG                
003550           NOT AT END                                  
003560              MOVE N TO P-TAB-POS                       
003570              MOVE STEAM-NAME TO P-TEAM                
003580              MOVE SPLAYED TO P-PLAYED                   
003590              MOVE SG-WON TO P-G-WON                    
003600              MOVE SG-LOST TO P-G-LOST        
003610              MOVE SG-DRAWN TO P-G-DRAWN              
003620              MOVE SGOALS-FOR TO P-GOALS-FOR             
003630              MOVE SGOALS-AGST TO P-GOALS-AGST     
003650              MOVE SGOAL-DIFF TO P-GOAL-DIFF             
003660              MOVE SPOINTS TO P-POINTS           
003670                                     
003680              WRITE TEXT-OUT FROM W-TEXT-OUT              
003700        END-READ                                
003710        ADD 1 TO N                              
003720     END-PERFORM                                             
003730     CLOSE SORT-OUT PRINT-FILE                               
003740     DISPLAY "Table is now written to the printer".    
003750*******************************************************************     
</textarea>

<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">

</font></form></center>

<p><font face="Arial"><a name="CAL"> </a><br>
<b><font face="Arial">10.4 Calculate prime numbers program</font></b>
</font></p><p><font face="Arial">This is a little program that calulates prime numbers. You are prompted to enter 
a number (up to 1999) and the program will produce a file, 'PRIME-NO.TXT,
which contains a table of all prime numbers up to the value entered.</font></p>

<p></p><center><font face="Arial"><font face="Courier New">

</font></font><form name="form4">
<textarea rows="25" cols="70" wrap="no" name="txt">000010 IDENTIFICATION DIVISION.  
000020 PROGRAM-ID.    PRIME-NO-PROG.          
000030 AUTHOR.        TIMOTHY R P BROWN.   
000040   
000050******************************************           
000060* PROGRAM TO CALCULATE PRIME NUMBERS     *           
000070******************************************           
000080 
000090 ENVIRONMENT DIVISION.     
000100 INPUT-OUTPUT SECTION.     
000110 FILE-CONTROL.
000120 
000130       SELECT OUT-FILE ASSIGN TO 'PRIME-NO.TXT'      
000140           ORGANIZATION IS LINE SEQUENTIAL.          
000150********************************************   
000160 DATA DIVISION.            
000170 FILE SECTION.
000180 
000190 FD OUT-FILE. 
000200 01 NO-OUT      PIC X(80). 
000210********************************************
000220 WORKING-STORAGE SECTION.  
000230 
000240 01 EVEN-FLAG PIC X.       
000250      88 NUM-EVEN VALUE 'Y'.            
000260 01 PRIME-FLAG PIC X .     
000270      88 IS-PRIME VALUE 'Y'.            
000280 
000290 01 TOP-VALUE  PIC 9(7) VALUE ZERO.     
000300 
000310 01 COUNTERS. 
000320       03 Y-COUNT PIC 9(6) OCCURS 1000. 
000330 
000340 01 CALC-NO       PIC 9(6) VALUE ZERO.    
000350 
000360 01 SUBS.     
000370      03 X-SUB    PIC 9(6) VALUE 3.    
000380 01 PRINT-SUBS.            
000390      03 P-COUNT-X  PIC 9(6) VALUE 1.   
000400 
000410 01 A       PIC 9(6) VALUE ZERO.        
000420 01 B       PIC 9(6) VALUE ZERO.        
000430 01 C       PIC 9(6) VALUE ZERO.        
000440 01 D       PIC 9(6) VALUE ZERO.        
000450 01 Z       PIC 9(6) VALUE ZERO.
000460 01 PRIME-NO-COUNT PIC 9(6) VALUE 2.  
000465
000470 01 PRINT-LINE.            
000480      03 P-NUM1  PIC Z(5)9 VALUE ZERO.  
000490      03 P-NUM2  PIC Z(5)9 VALUE ZERO.  
000500      03 P-NUM3  PIC Z(5)9 VALUE ZERO.  
000510      03 P-NUM4  PIC Z(5)9 VALUE ZERO.  
000520      03 P-NUM5  PIC Z(5)9 VALUE ZERO.  
000530 
000540 01 EXIT-KEY PIC X VALUE SPACE.           
000545     
000550*******************************************************    
000560 PROCEDURE DIVISION.       
000570 MAIN-PARA.   
000580      OPEN OUTPUT OUT-FILE 
000590      DISPLAY 'ENTER VALUE TO WHICH PRIME NUMBERS '  
000600      DISPLAY 'ARE TO BE CALCULATED BETWEEN 1 AND 999,999'
000602      MOVE 1 TO Y-COUNT (1)
000605      MOVE 2 TO Y-COUNT (2)     
000610 
000620*ENTER VALUE  
000630      PERFORM UNTIL TOP-VALUE > 0       
000640      ACCEPT TOP-VALUE     
000650      END-PERFORM          
000660 
000670*ZEROISE TABLE
000680      MOVE ZEROS TO COUNTERS            
000690 
000700*DETERMINE PRIME NUMBERS AND PLACE IN TABLE          
000710 
000720      PERFORM VARYING CALC-NO FROM 3 BY 1            
000730    UNTIL CALC-NO > TOP-VALUE           
000740         DISPLAY  CALC-NO         
000750         MOVE 1 TO C       
000760         MOVE 'N' TO PRIME-FLAG         
000770 
000780*IS NUMBER EVEN (BUT NOT 2)?  
000790 
000800         DIVIDE CALC-NO BY 2 GIVING A REMAINDER Z     
000830         IF Z = 0 THEN MOVE 'Y' TO EVEN-FLAG         
000840         ELSE MOVE 'N' TO EVEN-FLAG     
000850         END-IF            
000860           
000865**********************************************************
000870*DIVIDE EACH ODD NUMBER BY NUMBERS UP TO HALF THE CALC-NO        
000880*LOOP EXITED WHEN A NUMBER DIVIDES IT WITH NO REMAINDER           
000890*OR WHEN ALL NUMBERS CHECKED
000895**********************************************************
000900         IF NOT NUM-EVEN THEN           
000910            PERFORM VARYING D FROM 3 BY 1            
000920    UNTIL (C = 0) OR (D > ((CALC-NO + 1) / 2))       
000930  DIVIDE CALC-NO BY D GIVING A REMAINDER C           
000940            END-PERFORM    
000950         END-IF            
000960 
000970         IF C = 0 THEN MOVE 'N' TO PRIME-FLAG        
000980         ELSE MOVE 'Y' TO PRIME-FLAG    
000990         END-IF            
001000 
001010*WHEN PRIME NUMBER DEFINED, MOVE IT INTO TABLE       
001020         IF IS-PRIME THEN  
001030            MOVE CALC-NO TO Y-COUNT (X-SUB)          
001040            ADD 1 TO X-SUB PRIME-NO-COUNT      
001050         END-IF            
001060      END-PERFORM          
001070 
001080*STORE THE FINAL VALUE OF X-SUB BEFORE RE-USING IT    
001090      MOVE X-SUB TO P-COUNT-X           
001100      MOVE ZERO TO X-SUB   
001110***************************************************           
001120*WRITE TABLE  
001130      PERFORM VARYING X-SUB FROM 1 BY 5 
001140            UNTIL X-SUB > P-COUNT-X     
001150         MOVE Y-COUNT (X-SUB) TO P-NUM1 
001160         MOVE Y-COUNT (X-SUB + 1) TO P-NUM2          
001170         MOVE Y-COUNT (X-SUB + 2) TO P-NUM3          
001180         MOVE Y-COUNT (X-SUB + 3) TO P-NUM4          
001190         MOVE Y-COUNT (X-SUB + 4) TO P-NUM5          
001200         WRITE NO-OUT FROM PRINT-LINE AFTER 2 LINE 
001230      END-PERFORM          
001240 
001250      DISPLAY 'CALCULATIONS COMPLETE - ' PRIME-NO-COUNT           
001260            ' PRIME NUMBERS CALCULATED' 
001270      CLOSE OUT-FILE       
001280      STOP RUN.
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">

</font></form></center>

<p><font face="Arial"><a name="CIN"> </a><br>
<b><font face="Arial">10.5 Create INDEXED file program</font></b>
</font></p><p><font face="Arial"><b></b>
</font></p><p><font face="Arial">This program takes a line sequential record file and converts it to an indexed file. 
The records must contain a unique key field that is in strict ascending order. The input 
file (from a text editor) should be called 'LINESEQFILE.TXT'. The program output will be 'INDEXEDFILE.DAT'. 
You can change these in the ENVIRONMENT DIVISION if you want.
</font></p><p></p><center><font face="Arial"><font face="Courier New">

</font></font><form name="form5">
<textarea rows="25" cols="70" wrap="yes" name="txt">000010 IDENTIFICATION DIVISION.                                       
000020 PROGRAM-ID.    CREATE-INDEX-PROG.                              
000030 AUTHOR.        TIMOTHY R P BROWN.    
000040
000045*****************************************************   
000050* Program to convert a sorted (ascending)           * 
000060* line sequential file ('LINESEQFILE.TXT') to       *    
000070* an indexed file (output 'INDEXEDFILE.DAT').       * 
000075*****************************************************   
000080                                                                
000090 ENVIRONMENT DIVISION.                                          
000100 INPUT-OUTPUT SECTION.                                          
000110 FILE-CONTROL.                                                  
000120                                                                
000130        SELECT OUT-FILE ASSIGN TO 'INDEXEDFILE.DAT'             
000140           ORGANIZATION IS INDEXED                         
000150           ACCESS MODE IS SEQUENTIAL                       
000160           RECORD KEY IS INDEX-KEY.                         
000170        SELECT IN-FILE ASSIGN TO 'LINESEQFILE.TXT'         
000180           ORGANIZATION IS LINE SEQUENTIAL.              
000190                                                                
000200 DATA DIVISION.                                                 
000210 FILE SECTION.                                                  
000220                                                                
000230 FD OUT-FILE.                                                   
000240 01 MAKE-OUT.                                                   
000250        03 INDEX-KEY   PIC X(6).                                
000260        03             PIC X(120).                              
000270                                                                
000280 FD IN-FILE.                                                    
000290 01 IN-REC             PIC X(126).                              
000300                                                                
000310                                                                
000320 WORKING-STORAGE SECTION.                
000340                                                                
000350 01 EOF-FLAG PIC X VALUE 'N'.                                   
000360     88 END-OF-FILE VALUE 'Y'.                                  
000370                             
000375*****************************************************
000377                                   
000380 PROCEDURE DIVISION.                                            
000390 MAIN-PARA.                                                     
000400       OPEN INPUT IN-FILE                                      
000410            OUTPUT OUT-FILE                              
000420                                                         
000430       PERFORM UNTIL END-OF-FILE                         
000440         READ IN-FILE                                    
000450            AT END MOVE 'Y' TO EOF-FLAG                  
000460            NOT AT END                                  
000470               MOVE IN-REC TO MAKE-OUT                 
000480               WRITE MAKE-OUT                           
000490         END-READ                                    
000500       END-PERFORM                                             
000510                                                     
000520       CLOSE OUT-FILE IN-FILE                                  
000530       STOP RUN.                                               
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">

</font></form></center>

<p>
<font face="Arial"><a name="RIN"> </a><br>
<b><font face="Arial">10.6 Read INDEXED file program</font></b>
</font></p><p><font face="Arial"><b></b>
</font></p><p>
<font face="Arial">This program allows you to view the contents of an indexed file by generating a 
line sequential file of the original indexed file. If you tried to open an indexed file 
with a text editor you would just see gibberish. The input file for this program is 
'INDEXEDFILE.DAT' giving an output text file called READFILE.TXT. Again, you can change these 
in the ENVIRONMENT DIVISION if you wish.
</font></p><p></p><center><font face="Arial"><font face="Courier New">

</font></font><form name="form6">
<textarea rows="25" cols="70" wrap="yes" name="txt">000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID.    INDEXED-TO-READ-PROG.
000030 AUTHOR.        TIMOTHY R P BROWN.
000040 
000045*****************************************************
000050* Program to convert indexed file 'INDEXEDFILE.DAT' *
000060* to line sequential (output called 'READFILE.TXT') *
000070* for viewing with text editor.                     *
000075*****************************************************
000080 
000090 ENVIRONMENT DIVISION.
000100 INPUT-OUTPUT SECTION.   
000110 FILE-CONTROL.
000120      
000130        SELECT IN-FILE ASSIGN TO 'INDEXEDFILE.DAT' 
000140           ORGANIZATION IS INDEXED
000150           ACCESS MODE IS DYNAMIC
000160           RECORD KEY IS S-KEY-NO.
000170        SELECT OUT-FILE ASSIGN TO 'READFILE.TXT' 
000180           ORGANIZATION IS LINE SEQUENTIAL.
000190    
000200 DATA DIVISION.
000210 FILE SECTION.     
000220  
000230 FD IN-FILE.
000240 01 IN-REC.
000250     03 S-KEY-NO        PIC X(6).
000260     03                 PIC X(43).
000270 
000280 FD OUT-FILE.
000290 01 OUT-REC             PIC X(49).
000300 
000310 
000320 WORKING-STORAGE SECTION.
000340 
000350 01 EOF-FLAG PIC X VALUE 'N'.
000360     88 END-OF-FILE VALUE 'Y'.    
000370 
000373*****************************************************
000377 
000380 PROCEDURE DIVISION.     
000390 MAIN-PARA.               
000400        OPEN INPUT IN-FILE         
000410             OUTPUT OUT-FILE
000420 
000430        PERFORM UNTIL END-OF-FILE
000440           READ IN-FILE NEXT
000450             AT END MOVE 'Y' TO EOF-FLAG
000460             NOT AT END
000470                WRITE OUT-REC FROM IN-REC
000480           END-READ 
000490        END-PERFORM            
000500  
000510        CLOSE IN-FILE OUT-FILE
000520        STOP RUN.
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">

</font></form></center>


<font face="Arial"><br><br>

<!-- forward and reverse buttons -->
</font><p></p><center>
<font face="Arial"><a href="http://www.404i.com/cobol/linx.html"><img src="sam-Dateien/backward.gif" border="0"></a>
<a href="http://www.404i.com/cobol/feedback.html"><img src="sam-Dateien/forward.gif" border="0"></a>
</font><p></p></center>
<!-- end buttons -->


</form></form></td></tr>
</tbody></table></center>

<hr>
<center>
<table border="3" cellpadding="1" cellspacing="0">

<tbody><tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/getstart.html">1. Getting started</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/fil.html">7. File handling</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/basics.html">2. COBOL basics</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/bug.html">8. Debugging COBOL</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/4div.html">3. The Four Divisions</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/linx.html">9. Useful links</a></font></td></tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/data1.html">4. Defining Data Part 1</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/sam.html">10. Sample Code</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/data2.html">5. Defining Data Part 2</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/feedback.html">11. Feedback</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/comlog1.html">6. Commands and logic</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/qref.html">12. Quick reference</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/awards.html">   Awards</a></font></td>
<td><font face="Arial" size="2"><a href="http://www.404i.com/cobol/start.html"><b>   HOME</b></a></font></td>
</tr>
</tbody></table>
</center>
<font face="Arial"><h6 align="right">Copyright Timothy R P Brown 2002</h6></font>
</body></html>

¤ Dauer der Verarbeitung: 0.69 Sekunden  (vorverarbeitet)  ¤



Download des
Quellennavigators
Download des
sprechenden Kalenders

Eigene Datei ansehen




Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.


Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.


Bot Zugriff