This is sample usage of EXTFH handler to access a file.
Access an Index File
- READ-KEY
- READ-RBA
IDENTIFICATION DIVISION. PROGRAM-ID. READIDXF16. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. $set fcdreg SELECT MW-ENTREE ASSIGN TO "DATA.IDX.F16" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS S-ID FILE STATUS IS IO-STATUS. DATA DIVISION. FILE SECTION. FD MW-ENTREE LABEL RECORD STANDARD DATA RECORD DATAF16-REC. 01 DATAF16-REC. 03 S-ID PIC X(02). 03 S-NAME PIC X(04). 03 S-VALUE PIC X(10). WORKING-STORAGE SECTION. COPY EXTFHOPS. 01 IO-STATUS PIC XX. LINKAGE SECTION. 01 FCD. COPY "XFHFCD.CPY". PROCEDURE DIVISION. SET ADDRESS OF FCD TO ADDRESS OF FH--FCD OF MW-ENTREE. MOVE Cobol-Type TO Action-Type. OPEN INPUT MW-ENTREE. IF IO-STATUS NOT = "00" DISPLAY "OPEN INPUT FAILED" DISPLAY "IO-STATUS =" IO-STATUS GO TO FIN-REL END-IF. DISPLAY "------------READ SEQUENTIAL------------". READ-SEQUENTIAL. MOVE SPACES TO DATAF16-REC. READ MW-ENTREE NEXT AT END GO TO READ-KEY END-READ. PERFORM DISPLAY-RECORD THRU E-DISPLAY-RECORD. GO TO READ-SEQUENTIAL. READ-KEY. MOVE "33" TO S-ID DISPLAY "------------READ KEY(" S-ID ")------------". MOVE Read-Random TO Cobol-Op CALL "EXTFH" USING Action-Code FCD. MOVE FCD-File-Status TO IO-STATUS. IF IO-STATUS NOT = "00" DISPLAY "READ FAILED" DISPLAY "IO-STATUS =" IO-STATUS GO TO FIN-REL END-IF. PERFORM DISPLAY-RECORD THRU E-DISPLAY-RECORD. READ-RBA. MOVE 34 TO FCD-Reladdr-Offset. DISPLAY "------------READ RBA(" FCD-Reladdr-Offset ")------------". MOVE Read-Direct TO Cobol-Op CALL "EXTFH" USING Action-Code FCD. MOVE FCD-File-Status TO IO-STATUS. IF IO-STATUS NOT = "00" DISPLAY "READ FAILED" DISPLAY "IO-STATUS =" IO-STATUS GO TO FIN-REL END-IF. PERFORM DISPLAY-RECORD THRU E-DISPLAY-RECORD. FIN-REL. CLOSE MW-ENTREE. EXIT PROGRAM. STOP RUN. DISPLAY-RECORD. DISPLAY "RECORD" ": S-ID=" S-ID ", S-NAME=" S-NAME ", S-VALUE=" S-VALUE ", RBA=" FCD-Reladdr-Offset. E-DISPLAY-RECORD. EXIT.
Access a Sequential File
- OPEN FILE
- CLOSE FILE
- READ RECORD
- WRITE RECORD
- REWRITE RECORD
IDENTIFICATION DIVISION. PROGRAM-ID. EXTFHDEM. DATA DIVISION. WORKING-STORAGE SECTION. 01 External-File-Handler PIC x(08) VALUE 'EXTFH'. copy EXTFHOPS. 01 FCD-Area. copy XFHFCD.CPY. 01 File-Name PIC x(64). 01 File-Name-Len PIC 9(04) comp-x. *-----Record Area-----* 01 Record-Area. 03 S-ID PIC X(02). 03 S-NAME PIC X(04). 03 S-VALUE PIC X(08). *-----Local Variable----* 01 RBA PIC 9(9). PROCEDURE DIVISION. 0000-Main. move 'DATA.SEQ.V14' to File-Name. move 12 to File-Name-Len. move Low-Values to FCD-Area. move Low-Values to Action-Code. move File-Name-Len to FCD-Name-Length. set FCD-Filename-Address to address of File-Name. set FCD-Record-Address to address of Record-Area. move 1 to FCD-Version. move 1 to FCD-Organization. * 0 - Line sequential * 1 - Sequential * 2 - Indexed * 3 - Relative move 0 to FCD-Access-Mode. * 0 Sequential access mode * 4 Random access mode * 8 Dynamic access mode move 1 to FCD-Recording-Mode. * 0 Fixed * 1 Variable move 128 to FCD-Open-Mode. * 0 Open for input * 1 Open for output * 2 Open for input and output * 3 EXTEND * 128 File is closed move 14 to FCD-Max-Rec-Length. move 1 to FCD-Min-Rec-Length. display "----Open File I/O----". perform 1000-Open-File-I-O. perform 2000-Read-Record. perform 3000-Rewrite-Record. perform 2000-Read-Record. perform 5000-Close-File. display "----Open File Extend----". perform 1000-Open-File-Extend. perform 4000-Write-Record. perform 5000-Close-File. display "----Open File I/O RBA----". perform 1000-Open-File-I-O. perform 2000-Read-Record-RBA. perform 5000-Close-File. stop run. *--------------------------------* 1100-Call-Extfh. *--------------------------------* call External-File-Handler using Action-Code FCD-Area. if FCD-File-Status not = '00' if FCD-Status-Key-1 = '9' display "File Error, status: 9/" FCD-Binary else display "File Error, status: " FCD-File-Status end-if goback end-if. *--------------------------------* 1000-Open-File-I-O. *--------------------------------* move Cobol-Type to Action-Type. move Open-I-O to Cobol-Op. perform 1100-Call-Extfh. *--------------------------------* 1000-Open-File-Extend. *--------------------------------* move Cobol-Type to Action-Type. move Open-Extend to Cobol-Op. perform 1100-Call-Extfh. *--------------------------------* 2000-Read-Record. *--------------------------------* initialize Record-Area. move Cobol-Type to Action-Type. move Read-Seq to Cobol-Op. perform 1100-Call-Extfh. display 'Read:LEN=' FCD-Current-Rec-Len ",S-ID=" S-ID ",S-NAME=" S-NAME ",S-VALUE=" S-VALUE ",RBA=" FCD-Reladdr-Offset. *--------------------------------* 2000-Read-Record-RBA. *--------------------------------* initialize Record-Area. * move 0 to RBA. move RBA to FCD-Reladdr-Offset. move 64 to FCD-Config-Flags. * Bit 7 - WRITETHRU * Bit 6 - Use Relative Byte Address * Bit 5 - Update current record pointer * Bit 4 - Use offset 13 for relative byte address, * instead of offset 72 * Bits 3-2 - Reserved * Bit 1 - Check COBFSTATCONV * Bit 0 - Set if IGNORELOCK required DISPLAY "READ FROM RBA=" FCD-Reladdr-Offset. move Cobol-Type to Action-Type. move Read-Random to Cobol-Op. perform 1100-Call-Extfh. display 'Read:LEN=' FCD-Current-Rec-Len ",S-ID=" S-ID ",S-NAME=" S-NAME ",S-VALUE=" S-VALUE ",RBA=" FCD-Reladdr-Offset. *--------------------------------* 3000-Rewrite-Record. *--------------------------------* move "55" to S-ID. move "XXXX" to S-NAME. move "xxxxxxxx" to S-VALUE. move 14 to FCD-Current-Rec-Len. move Cobol-Type to Action-Type. move Rewrite-Record to Cobol-Op. perform 1100-Call-Extfh. *--------------------------------* 4000-write-Record. *--------------------------------* move "44" to S-ID. move "DDDD" to S-NAME. move "dddddddddd" to S-VALUE. move 14 to FCD-Current-Rec-Len. move Cobol-Type to Action-Type. move Write-Record to Cobol-Op. perform 1100-Call-Extfh. display "Write Record Return RBA=" FCD-Reladdr-Offset. move FCD-Reladdr-Offset to RBA. *--------------------------------* 5000-Close-File. *--------------------------------* move Cobol-Type to Action-Type. move Close-File to Cobol-Op. perform 1100-Call-Extfh. *--------------------------------*