mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
159 lines
5.3 KiB
159 lines
5.3 KiB
000010 IDENTIFICATION DIVISION.
|
|
000020 PROGRAM-ID. RECOVR.
|
|
000030 SECURITY.
|
|
000040 THIS IS A SKELETON PROGRAM THAT DEMONSTRATES HOW
|
|
000050 TO COPY AN INDEXED FILE IN ORDER TO RECOVER ITS
|
|
000060 CONTENTS, REBUILD THE KEY TREE, OR COMPACT THE DATA.
|
|
000070
|
|
000080 REPLACE ALL OCCURRENCES OF THE STRING:
|
|
000090 "***ENTER data HERE***"
|
|
000100 WITH INFORMATION PERTINENT TO THE STRUCTURE OF YOUR
|
|
000110 DATA FILES.
|
|
000120 AUTHOR. MICROSOFT.
|
|
000130
|
|
000140 ENVIRONMENT DIVISION.
|
|
000150 INPUT-OUTPUT SECTION.
|
|
000160 FILE-CONTROL.
|
|
000170 SELECT INPUT-FILE
|
|
000180 ASSIGN TO DISK
|
|
000190 ORGANIZATION INDEXED
|
|
000200 ACCESS SEQUENTIAL
|
|
000210 RECORD KEY INPUT-KEY
|
|
000220 FILE STATUS INPUT-STATUS.
|
|
000230
|
|
000240 SELECT OUTPUT-FILE
|
|
000250 ASSIGN TO DISK
|
|
000260 ORGANIZATION INDEXED
|
|
000270 ACCESS SEQUENTIAL
|
|
000280 RECORD KEY OUTPUT-KEY
|
|
000290 FILE STATUS OUTPUT-STATUS.
|
|
000300
|
|
000310 DATA DIVISION.
|
|
000320 FILE SECTION.
|
|
000330 FD INPUT-FILE
|
|
000340 LABEL RECORD STANDARD
|
|
000350 VALUE OF FILE-ID INPUT-ID
|
|
000360 RECORD CONTAINS
|
|
000370*****ENTER RECORD LENGTH HERE*****
|
|
000380 CHARACTERS
|
|
000390 DATA RECORD INPUT-REC.
|
|
000400 01 INPUT-REC.
|
|
000410 05 INPUT-KEY PIC X.
|
|
000420 05 INPUT-DATA
|
|
000430*****ENTER PIC X(nnn) HERE. nnn + 1 SHOULD EQUAL RECORD LENGTH.***
|
|
000440 .
|
|
000450
|
|
000460 FD OUTPUT-FILE
|
|
000470 LABEL RECORD STANDARD
|
|
000480 VALUE OF FILE-ID OUTPUT-ID
|
|
000490 RECORD CONTAINS
|
|
000500*****ENTER RECORD LENGTH HERE*****
|
|
000520 CHARACTERS
|
|
000530 DATA RECORD OUTPUT-REC.
|
|
000540 01 OUTPUT-REC.
|
|
000550 05 OUTPUT-KEY PIC X.
|
|
000560 05 OUTPUT-DATA
|
|
000570*****ENTER PIC X(nnn) HERE. nnn + 1 SHOULD EQUAL RECORD LENGTH.***
|
|
000580 .
|
|
000590
|
|
000600 WORKING-STORAGE SECTION.
|
|
000610 01 FILE-STATUS-ITEMS.
|
|
000620 05 INPUT-STATUS PIC XX VALUE '00'.
|
|
000630 88 OK VALUE '00'.
|
|
000640 88 ATEND VALUE '10'.
|
|
000650 88 NOTFOUND VALUE '30'.
|
|
000660 88 DAMAGD VALUE '91'.
|
|
000670 05 OUTPUT-STATUS PIC XX VALUE '00'.
|
|
000680 88 OK VALUE '00'.
|
|
000690 88 INVSEQ VALUE '21'.
|
|
000700 88 DISKFULL VALUE '24'.
|
|
000710 88 DIRFULL VALUE '34'.
|
|
001000/
|
|
001010 PROCEDURE DIVISION.
|
|
001020 MAIN-LINE.
|
|
001030 PERFORM 1000-INITIALIZE.
|
|
001040
|
|
001050 IF OK OF INPUT-STATUS
|
|
001060 AND OK OF OUTPUT-STATUS,
|
|
001070 PERFORM 3000-PROCESS
|
|
001080 UNTIL NOT OK OF INPUT-STATUS
|
|
001090 OR NOT OK OF OUTPUT-STATUS
|
|
001100 ELSE
|
|
001110 NEXT SENTENCE.
|
|
001120
|
|
001130 PERFORM 8000-TERMINATE.
|
|
001140 STOP RUN.
|
|
001150
|
|
001160 1000-INITIALIZE.
|
|
001170 DISPLAY 'Enter file-id of the input file ---->'.
|
|
001180 ACCEPT INPUT-ID.
|
|
001190 DISPLAY 'Enter file-id of the output file ---->'.
|
|
001200 ACCEPT OUTPUT-ID.
|
|
001210 OPEN INPUT INPUT-FILE.
|
|
001220 IF DAMAGD OF INPUT-STATUS,
|
|
001230 PERFORM 9010-INPUT-ERROR
|
|
001240 MOVE '00' TO INPUT-STATUS
|
|
001250 ELSE
|
|
001260 NEXT SENTENCE.
|
|
001270
|
|
001280 IF OK OF INPUT-STATUS
|
|
001290 OPEN OUTPUT OUTPUT-FILE
|
|
001300 IF OK OF OUTPUT-STATUS,
|
|
001310 PERFORM 3500-READ-INPUT
|
|
001320 ELSE
|
|
001330 PERFORM 9020-OUTPUT-ERROR
|
|
001340 ELSE
|
|
001350 PERFORM 9010-INPUT-ERROR.
|
|
001360
|
|
001370 3000-PROCESS.
|
|
001380 PERFORM 3700-WRITE-OUTPUT.
|
|
001390 IF OK OF OUTPUT-STATUS,
|
|
001400 PERFORM 3500-READ-INPUT
|
|
001410 ELSE
|
|
001420 NEXT SENTENCE.
|
|
001430
|
|
001440 3500-READ-INPUT.
|
|
001450 READ INPUT-FILE NEXT RECORD.
|
|
001460 IF OK OF INPUT-STATUS,
|
|
001470 OR ATEND OF INPUT-STATUS,
|
|
001480 NEXT SENTENCE
|
|
001490 ELSE
|
|
001500 PERFORM 9010-INPUT-ERROR.
|
|
001510
|
|
001520 3700-WRITE-OUTPUT.
|
|
001530 WRITE OUTPUT-REC.
|
|
001540 IF OK OF OUTPUT-STATUS,
|
|
001550 NEXT SENTENCE
|
|
001560 ELSE
|
|
001570 PERFORM 9020-OUTPUT-ERROR.
|
|
001580
|
|
001590 8000-TERMINATE.
|
|
001600 CLOSE INPUT-FILE, OUTPUT-FILE.
|
|
001610 IF OK OF OUTPUT-STATUS,
|
|
001620 NEXT SENTENCE
|
|
001630 ELSE
|
|
001640 PERFORM 9020-OUTPUT-ERROR.
|
|
001650
|
|
001660 9010-INPUT-ERROR.
|
|
001670 IF ATEND OF INPUT-STATUS,
|
|
001680 DISPLAY 'Error: End of input.'
|
|
001690 ELSE IF NOTFOUND OF INPUT-STATUS,
|
|
001700 DISPLAY 'Error: File not found on open.'
|
|
001710 ELSE IF DAMAGD OF INPUT-STATUS,
|
|
001720 DISPLAY 'Warning: Input file damaged.'
|
|
001730 ELSE
|
|
001740 NEXT SENTENCE.
|
|
001750 DISPLAY 'Input file status = ', INPUT-STATUS.
|
|
001760
|
|
001770 9020-OUTPUT-ERROR.
|
|
001780 IF INVSEQ OF OUTPUT-STATUS,
|
|
001790 DISPLAY 'Error: Invalid sequence of input records.'
|
|
001800 ELSE IF DISKFULL OF OUTPUT-STATUS,
|
|
001810 DISPLAY 'Error: Disk full on write.'
|
|
001820 ELSE IF DIRFULL OF OUTPUT-STATUS,
|
|
001830 DISPLAY 'Error: Directory full on open.'
|
|
001840 ELSE
|
|
001850 NEXT SENTENCE.
|
|
001860 DISPLAY 'Output file status = ', OUTPUT-STATUS.
|
|
001870* END OF SOURCE *
|
|
|