R: Cobol file access using file descriptor

Hello. Here you may find a simple example of what you need. It's a generic 
program that compares two sequential files. 
Hope this helps.


        Domenico Finucci
> 


-----Messaggio originale-----
Da: Adrienne McConnon [mailto:Adrienne.McConnon@xxxxxxxxxxxx]
Inviato: giovedì 26 gennaio 2006 20.09
A: cobol400-l@xxxxxxxxxxxx
Oggetto: [COBOL400-L] Cobol file access using file descriptor


Hello!
 
Does anybody have any COBOL examples of file access using functions
(open read write close) or know where I can look to find examples/
 
Thanks,
 
Adrienne

  IDENTIFICATION DIVISION.
  PROGRAM-ID.    £PGMNAME£.
  AUTHOR.        DFINUCCI.
  DATE-WRITTEN.  24/11/1999.
 * ----------------------------------------------------------
 *    Confronto file
 *    Le variabili sono: £WHFILE£
 *                       £WHLIB£
 *                       £PGMNAME£
 *    Si deve fare attenzione alla definizione dei file  perch]
 *     non tutti sono a indici.
 * ----------------------------------------------------------
  ENVIRONMENT DIVISION.
  CONFIGURATION SECTION.
  SOURCE-COMPUTER. IBM-AS400.
  OBJECT-COMPUTER. IBM-AS400.
  SPECIAL-NAMES.
  INPUT-OUTPUT SECTION.
  FILE-CONTROL.
      SELECT FILE-A     ASSIGN DATABASE-A
                        ORGANIZATION INDEXED
                        RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
                        ACCESS       SEQUENTIAL
                        FILE STATUS FS-A .
 
      SELECT FILE-B     ASSIGN DATABASE-B
                        ORGANIZATION INDEXED
                        RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
                        ACCESS       SEQUENTIAL
                        FILE STATUS FS-B .
 
  DATA DIVISION.
  FILE SECTION.
  FD  FILE-A.
     COPY DDR-ALL-FORMATS  OF   £WHFILE£
          REPLACING == 05 == BY == 01 ==.
 *
  FD  FILE-B.
     COPY DDR-ALL-FORMATS  OF   £WHLIB£-£WHFILE£
          REPLACING == 05 == BY == 01 ==.
 *
  WORKING-STORAGE SECTION.
 ** File status
  77  FS-A               PIC XX VALUE 'ZZ'.
     88 FS-A-IOK        VALUE '00'.
     88 FS-A-EOF        VALUE '10'.
  77  FS-B               PIC XX VALUE 'ZZ'.
     88 FS-B-IOK        VALUE '00'.
     88 FS-B-EOF        VALUE '10'.
  77 W-LETTI-A          PIC 9(5).
  77 W-LETTI-B          PIC 9(5).
  77 W-ERRORI           PIC X VALUE 'N'.
  77 W-MESSAGGI         PIC X(80).
  77 W-RCODE            PIC X(10).
  77 W-PGMNAME          PIC X(10) value '£PGMNAME£'.
 ** ----------------------------------------------------
  PROCEDURE DIVISION.
  MAIN.
      PERFORM APRI-FA   THRU EX-APRI-FA
      PERFORM APRI-FB   THRU EX-APRI-FB
      PERFORM LEGGI-FA  THRU EX-LEGGI-FA
      PERFORM LEGGI-FB  THRU EX-LEGGI-FB
      INITIALIZE        W-ERRORI
      PERFORM ELABORA THRU EX-ELABORA
              UNTIL FS-A-EOF
      PERFORM CHIUDI-FA THRU EX-CHIUDI-FA
      PERFORM CHIUDI-FB THRU EX-CHIUDI-FB
      GOBACK.
  ELABORA.
      INITIALIZE W-ERRORI W-MESSAGGI
      MOVE W-PGMNAME   TO W-MESSAGGI
DOTAB0**** DOTAB
      IF £WHFLDI£ OF FILE-A NOT      EQUAL £CAMPO£ OF FILE-B
         MOVE "£WHFLDI£"           TO W-MESSAGGI(11:20)
         MOVE £WHFLDI£ OF FILE-A     TO   W-MESSAGGI (21:10)
         MOVE £WHFLDI£ OF FILE-B     TO   W-MESSAGGI (33:10)
         PERFORM  SCRIVI-MESSAGGIO THRU EX-SCRIVI-MESSAGGIO
      END-IF
DOEND0**** DOTABEND
DOTAB1**** DOTAB1
 **** CASO DI CAMPO DATA
      IF £WHFLDI£ OF FILE-A NOT      EQUAL £CAMPO£ OF FILE-B
         IF £WHFLDI£ OF FILE-A NOT EQUAL £CAMPO£ OF FILE-B
                                      + 19000000
         AND £WHFLDI£ OF FILE-A NOT EQUAL £CAMPO£ OF FILE-B
                                      + 1000000
            MOVE "£WHFLDI£"           TO W-MESSAGGI(11:20)
            MOVE £WHFLDI£ OF FILE-A     TO   W-MESSAGGI (21:10)
            MOVE £WHFLDI£ OF FILE-B     TO   W-MESSAGGI (33:10)
           PERFORM  SCRIVI-MESSAGGIO THRU EX-SCRIVI-MESSAGGIO
         END-IF
      END-IF
DOEND1**** DOTAB1END
      IF W-ERRORI NOT EQUAL SPACE
         MOVE ALL "*" TO W-MESSAGGI
         CALL "UWRITE01"  USING W-MESSAGGI W-RCODE
         MOVE ALL " " TO W-MESSAGGI
      END-IF
      PERFORM LEGGI-FA  THRU EX-LEGGI-FA
      PERFORM LEGGI-FB  THRU EX-LEGGI-FB.
  EX-ELABORA. EXIT.
  SCRIVI-MESSAGGIO.
         MOVE W-LETTI-A TO W-MESSAGGI (70:)
         CALL "UWRITE01"  USING W-MESSAGGI W-RCODE
         MOVE "S" TO W-ERRORI.
  EX-SCRIVI-MESSAGGIO. EXIT.
  APRI-FA.
      OPEN INPUT FILE-A
      IF NOT FS-A-IOK
         DISPLAY " ERRORE OPEN f-INPUT a " fs-a
      END-IF .
  EX-APRI-FA. EXIT.
  APRI-FB.
      OPEN INPUT FILE-B
      IF NOT FS-B-IOK
         DISPLAY " ERRORE OPEN f-INPUT B " fs-B
      END-IF .
  EX-APRI-FB. EXIT.
  LEGGI-FA.
      READ FILE-A   AT END CONTINUE
      IF NOT FS-A-IOK   AND NOT FS-A-EOF
         DISPLAY " ERRORE READ f-INPUT A " fs-A
      END-IF .
      ADD 1 TO W-LETTI-A.
  EX-LEGGI-FA. EXIT.
  LEGGI-FB.
      READ FILE-B  AT END CONTINUE
      IF NOT FS-B-IOK   AND NOT FS-B-EOF
         DISPLAY " ERRORE READ f-INPUT B " fs-B
      END-IF .
      ADD 1 TO W-LETTI-B.
  EX-LEGGI-FB. EXIT.
  CHIUDI-FA.
  EX-CHIUDI-FA. EXIT.
      CLOSE FILE-A
      IF NOT FS-A-IOK
         DISPLAY " ERRORE CLOSE  a " fs-a
      END-IF .
  CHIUDI-FB.
      CLOSE FILE-B
      IF NOT FS-B-IOK
         DISPLAY " ERRORE CLOSE  B " fs-B
      END-IF .
  EX-CHIUDI-FB. EXIT.