151 lines
4.0 KiB
COBOL
151 lines
4.0 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. TEST19b.
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
|
|
* SELECT TEST-FILE-OUT ASSIGN TO WS-FILENAME-OUT
|
|
* SELECT TEST-FILE-OUT ASSIGN TO DISK WS-FILENAME-OUT
|
|
* SELECT TEST-FILE-OUT ASSIGN TO DISK "test.out.txt"
|
|
* SELECT TEST-FILE-OUT ASSIGN TO DISK
|
|
SELECT TEST-FILE-OUT ASSIGN TO EXTERNAL WS-FILENAME-OUT
|
|
* SELECT TEST-FILE-OUT ASSIGN TO EXTERNAL "FILENAMEOUT"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS W01-FILE-STATUS.
|
|
|
|
SELECT TEST-FILE-IN ASSIGN TO WS-FILENAME-IN
|
|
* SELECT TEST-FILE-IN ASSIGN TO DISK WS-FILENAME-IN
|
|
* SELECT TEST-FILE-IN ASSIGN TO DISK "test.in.txt"
|
|
* SELECT TEST-FILE-IN ASSIGN TO DISK
|
|
* Use MF compatability features
|
|
* SELECT TEST-FILE-IN ASSIGN TO EXTERNAL "DATA/test.in.txt"
|
|
* SELECT TEST-FILE-IN ASSIGN TO EXTERNAL "zz/test.in.txt"
|
|
ORGANIZATION IS LINE SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS W01-FILE-STATUS.
|
|
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
|
|
FD TEST-FILE-OUT
|
|
LABEL RECORDS ARE STANDARD.
|
|
* LABEL RECORDS ARE STANDARD
|
|
* VALUE OF FILE-ID IS WS-FILENAME-OUT.
|
|
* VALUE OF FILE-ID IS "test.out.txt".
|
|
01 TEST-RECORD-OUT.
|
|
05 FILLER PIC X(48).
|
|
|
|
FD TEST-FILE-IN
|
|
LABEL RECORDS ARE STANDARD.
|
|
* LABEL RECORDS ARE STANDARD
|
|
* VALUE OF FILE-ID IS WS-FILENAME-IN.
|
|
* VALUE OF FILE-ID IS "test.in.txt".
|
|
01 TEST-RECORD-IN.
|
|
05 FILLER PIC X(31).
|
|
|
|
WORKING-STORAGE SECTION.
|
|
|
|
01 WS-FILENAME-OUT PIC X(35) VALUE "test.out.txt".
|
|
01 WS-FILENAME-IN PIC X(35) VALUE "test.in.txt".
|
|
|
|
01 TEST-RECORD-OUT-WS.
|
|
05 WS-NUMBER-OUT PIC 9(5) VALUE 1.
|
|
05 WS-DATA-OUT PIC X(43) VALUE SPACES.
|
|
|
|
01 TEST-RECORD-IN-WS.
|
|
05 WS-DATA-IN PIC X(31).
|
|
|
|
01 WS-RCODE PIC Z(4)9 VALUE ZERO.
|
|
01 EOF-SW PIC X(1) VALUE 'N'.
|
|
01 WS-REC-COUNTER-IN PIC 9(5) VALUE 0.
|
|
01 W01-FILE-STATUS PIC XX.
|
|
01 CMDLINE-PARMS PIC X(50).
|
|
01 CMDLINE-ARGVS.
|
|
05 CMDLINE-ARGV OCCURS 2 TIMES PIC X(35).
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
A-000.
|
|
|
|
ACCEPT CMDLINE-PARMS FROM COMMAND-LINE.
|
|
* DISPLAY "CMDLINE-PARMS =" CMDLINE-PARMS ";".
|
|
|
|
IF RETURN-CODE NOT EQUAL 0
|
|
THEN
|
|
DISPLAY "COMMAND LINE truncation ERROR has occured "
|
|
MOVE RETURN-CODE TO WS-RCODE
|
|
DISPLAY "WS-RCODE=" WS-RCODE
|
|
STOP RUN
|
|
END-IF.
|
|
|
|
MOVE SPACES TO CMDLINE-ARGVS.
|
|
UNSTRING CMDLINE-PARMS DELIMITED BY ' ' INTO
|
|
CMDLINE-ARGV (1)
|
|
CMDLINE-ARGV (2).
|
|
IF CMDLINE-ARGV (2) NOT EQUAL SPACES
|
|
THEN
|
|
MOVE CMDLINE-ARGV (2) TO WS-FILENAME-OUT
|
|
END-IF.
|
|
|
|
OPEN OUTPUT TEST-FILE-OUT.
|
|
IF W01-FILE-STATUS NOT = "00"
|
|
DISPLAY "Error on Opening Test-File-Out=" W01-FILE-STATUS
|
|
STOP RUN.
|
|
OPEN INPUT TEST-FILE-IN.
|
|
IF W01-FILE-STATUS NOT = "00"
|
|
DISPLAY "Error on Opening Test-File-In=" W01-FILE-STATUS
|
|
STOP RUN.
|
|
|
|
* READ TEST-FILE-IN INTO WS-DATA-IN
|
|
* AT END MOVE 'Y' TO EOF-SW.
|
|
PERFORM A-200.
|
|
PERFORM A-100 UNTIL EOF-SW = 'Y'.
|
|
|
|
CLOSE TEST-FILE-OUT.
|
|
CLOSE TEST-FILE-IN.
|
|
|
|
MOVE WS-REC-COUNTER-IN TO WS-RCODE.
|
|
DISPLAY "WS-REC-COUNTER-IN=" WS-RCODE.
|
|
|
|
MOVE RETURN-CODE TO WS-RCODE.
|
|
DISPLAY "WS-RCODE=" WS-RCODE.
|
|
|
|
STOP RUN.
|
|
|
|
A-100.
|
|
|
|
DISPLAY "ENTER A-100".
|
|
|
|
MOVE WS-DATA-IN TO WS-DATA-OUT.
|
|
WRITE TEST-RECORD-OUT FROM TEST-RECORD-OUT-WS.
|
|
IF W01-FILE-STATUS NOT = "00"
|
|
DISPLAY "Error on Writing Test-File-Out=" W01-FILE-STATUS
|
|
STOP RUN.
|
|
|
|
ADD 1 TO WS-NUMBER-OUT.
|
|
|
|
* READ TEST-FILE-IN INTO WS-DATA-IN
|
|
* AT END MOVE 'Y' TO EOF-SW.
|
|
PERFORM A-200.
|
|
|
|
DISPLAY "EXIT A-100".
|
|
|
|
A-200.
|
|
|
|
DISPLAY "ENTER A-200".
|
|
|
|
READ TEST-FILE-IN INTO WS-DATA-IN
|
|
AT END MOVE 'Y' TO EOF-SW.
|
|
IF EOF-SW = 'N' AND W01-FILE-STATUS NOT = "00"
|
|
DISPLAY "Error on Reading Test-File-In=" W01-FILE-STATUS
|
|
STOP RUN.
|
|
|
|
IF EOF-SW = 'N'
|
|
ADD 1 TO WS-REC-COUNTER-IN.
|
|
|
|
DISPLAY "EXIT A-200".
|