COBOL access raw byte-stream dataset

最新推荐文章于 2022-05-02 00:58:54 发布

原创最新推荐文章于 2022-05-02 00:58:54 发布 · 546 阅读

0 ·

CC 4.0 BY-SA版权

COBOL 专栏收录该内容

30 篇文章

订阅专栏

本文介绍了一个使用COBOL语言通过字节流文件例程读取二进制文件的示例程序。该程序展示了如何打开文件、获取文件长度，并逐条读取记录的长度和内容。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

This is a sample how COBOL access byte-stream file using Byte-stream File Routines

COBOL provide FD attribute to access well organized record files, however on modern operating system environment, file is treated as binary stream, it is accessed in one-by-one byte mode. Micro Focus COBOL provides a byte-stream file library to implement this function. For details please refer to Micro Focus document.

Description

This is a sample binary file (identified by environnment DD_INFILE).It contains a collection of records, each record have a 4-byte record size header, and data contents;as

   +--------------------+--------------------+--------------------+--------------------+
   |      Record 1      |      Record 2      |        ...         |      Record n      |
   +--------------------+--------------------+--------------------+--------------------+
   |  header  | data ...|  header  | data ...|        ...         |  header  | data ...|
   +----------+---------+----------+---------+--------------------+--------------------+
   |  4 bytes | n bytes |  4 bytes | n bytes |        ...         |  4 bytes | n bytes |
   +--------------------+--------------------+--------------------+--------------------+

The program will do:

open file
get file length
loop all records
- read record length
- read record content
close file

Sample Program

       IDENTIFICATION DIVISION.
       PROGRAM-ID. READFILE.
       WORKING-STORAGE SECTION.
*     * DEFINE CONSTANTS
       01  K-0                   PIC X(1) COMP-X value 0.
       01  K-1                   PIC X(1) COMP-X value 1.
       01  K-2                   PIC X(1) COMP-X value 2.
       01  K-128                 PIC X(1) COMP-X value 128.

       01  FILE-NAME             PIC X(1024).
       01  FILE-HANDLE           PIC X(4) COMP-5.
       01  FILE-LEN              PIC X(8) COMP-X.
       01  FILE-OFFSET           PIC X(8) COMP-X.

       01  FILE-REC-BUFF         PIC X(1024).
       01  FILE-REC-LEN          PIC X(4) COMP-X.

       01  D-NB-RECS            PIC 9(9) VALUE 0.
 
       PROCEDURE DIVISION.
       P-START.
*     *OPEN FILE
           ACCEPT FILE-NAME FROM ENVIRONMENT 'DD_INFILE'.
           CALL "CBL_OPEN_FILE"
             USING FILE-NAME
                   K-1      *> access-mode=Write only
                   0        *> deny-mode
                   0
                   FILE-HANDLE.
           IF RETURN-CODE not = 0
             DISPLAY "FILELD-0201: OPEN INPUT DATAV16 FAILED"
             DISPLAY "RETURN-CODE =" RETURN-CODE
             GO TO FIN-ERREUR
           END-IF.
      
*     *GET LENGTH OF INPUT FILE
           MOVE 0 TO FILE-LEN.
           CALL "CBL_READ_FILE"
             USING FILE-HANDLE
                   FILE-OFFSET   *> offset to read
                   FILE-REC-LEN  *> read bytes
                   K-128         *> To return file size in offset
                   FILE-REC-BUFF.
           IF RETURN-CODE not = 0
             DISPLAY "FILELD-0201: GET DATAV16 LENGTH FAILED: "
             DISPLAY "RETURN-CODE =" RETURN-CODE
             GO TO FIN-ERREUR
           END-IF.
           MOVE FILE-OFFSET TO FILE-LEN.
           MOVE 0 TO FILE-OFFSET.
      
*     *BEGIN LOOP READ FILE CONTENT
       READ-LOOP.
           IF FILE-OFFSET >= FILE-LEN
             GO TO FIN-REL
           END-IF.

*     *GET LENGTH OF RECORD
           MOVE 0 TO FILE-REC-LEN.
           CALL "CBL_READ_FILE"
             USING FILE-HANDLE
                   FILE-OFFSET
                   FILE-REC-LEN
                   K-0             *> Standard read
                   FILE-REC-LEN.
           IF RETURN-CODE not = 0
             DISPLAY "FILELD-0201: GET R-LENGTH FAILED: " FILE-NAME
             DISPLAY "RETURN-CODE =" RETURN-CODE
             GO TO FIN-ERREUR
           END-IF.
           ADD 4 TO FILE-OFFSET.

*     * GET CONTENT OF CONTENT
           MOVE SPACES TO FILE-REC-BUFF.
           CALL "CBL_READ_FILE"
             USING FILE-HANDLE
                   FILE-OFFSET
                   FILE-REC-LEN
                   K-0
                   FILE-REC-BUFF.
           IF RETURN-CODE not = 0
             DISPLAY "FILELD-0201: GET CONTENT FAILED: " FILE-NAME
             DISPLAY "RETURN-CODE =" RETURN-CODE
             GO TO FIN-ERREUR
           END-IF.
           ADD FILE-REC-LEN TO FILE-OFFSET.

           ADD 1 TO D-NB-RECS.

           GO TO READ-LOOP.
      
       FIN-REL.
           DISPLAY "RELOADING TERMINATED OK".
           PERFORM END-COMMON-DISPLAY.
      
           EXIT PROGRAM.
           STOP RUN.
      
       FIN-ERREUR.
           DISPLAY "RELOADING FAILED".
           PERFORM END-COMMON-DISPLAY.
      
           EXIT PROGRAM.
           STOP RUN RETURNING 1.
      
       END-COMMON-DISPLAY.
           DISPLAY "Nb rows reloaded: " D-NB-RECS.
           DISPLAY " ".
           DISPLAY "NUMERIC MOVED WHEN USING CHAR FORMAT: "
      
*     * CLOSE FILE
           CALL "CBL_CLOSE_FILE" USING FILE-HANDLE.