Read Acucobol files from MF cobol program. Possible ?

[Cosmark]

I am looking for a tool that will allow me to read cobol files (incl.
indexed ones) created using Acucobol (Version 2.4.2) FROM code generated
and compiled in Micro Focus cobol (version 4.5). The file structure of the
Acucobol files is known.

Your help will be appreciated.

Thanks
Cosmark

 

[Crox]

Hi,

if you know the structure of the file, you can write your own access routine in MF. I did this once for DBase files. Here is an example of the routine that can read DBF files and make a sequential copy of it.

I hope this helps you.

Regards,

Crox

000100*$CALL
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. DBFCOPY2.
000400******************************************************************
000500* SEQUENTIEEL MAKEN V. DBF FILES      COPYRIGHT(C) R.G. WOUTERSON*
000800******************************************************************
000900 ENVIRONMENT DIVISION.
001000 CONFIGURATION SECTION.
001100 SOURCE-COMPUTER. IBM-PC.
001200 OBJECT-COMPUTER. IBM-PC.
001300 SPECIAL-NAMES.
001400      DECIMAL-POINT IS COMMA.
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700     SELECT DBFUIT ASSIGN TO DBASE-OUTPUT-FILE
001800             ORGANIZATION IS LINE SEQUENTIAL
001900             FILE STATUS FILE-STATUS-DBFUIT.
002000     SELECT DBFIN ASSIGN  TO LINE ADVANCING
002100             DBASE-INPUT-FILE
002200             FILE STATUS FILE-STATUS-DBFIN.
002300 DATA DIVISION.
002400 FILE SECTION.
002500
002600 FD DBFIN
002700     LABEL RECORD STANDARD.
002800 01  DBFIN-RECORD.
002900     03 DBFIN-TEKEN OCCURS 32767     PIC X.
003000
003100 FD DBFUIT
003200*    RECORDING MODE IS V
003300     RECORD VARYING FROM 1 TO 10000 CHARACTERS
003400     LABEL RECORD STANDARD.
003500 01  DBASE-REC.
003600     03  DBASE-REC-TEKEN OCCURS 1 TO 10000 DEPENDING ON
003700         DBFIN-LENGTH-RECORD         PIC X.
003800
003900 WORKING-STORAGE SECTION.
004000 01  ADRES-SET-LINK USAGE POINTER.
004100 01  DBFIN-LABEL-REC.
004200     03  DBFIN-FIRST-BYTE             PIC X.
004300     03  DBFIN-DATE-LAST-UPDATE.
004400         05  DBFIN-JJ-LAST-UPDATE     PIC X.
004500         05  DBFIN-MM-LAST-UPDATE     PIC X.
004600         05  DBFIN-DD-LAST-UPDATE     PIC X.
004700     03  DBFIN-NUMBER-OF-RECORDS      PIC S9(9) COMP-5.
004800     03  DBFIN-LENGTH-HEADER          PIC S9(4) COMP-5.
004900     03  DBFIN-LENGTH-RECORD-ALF      PIC XX VALUE HIGH-VALUE.
005000     03  DBFIN-LENGTH-RECORD REDEFINES DBFIN-LENGTH-RECORD-ALF
005100                                      PIC S9(4) COMP-5.
005200     03  DBFIN-RESERVED-1             PIC XX.
005300     03  DBFIN-FLAG-INCOMPLETE-TRANS  PIC X.
005400     03  DBFIN-ENCRYPTION-FLAG        PIC X.
005500     03  DBFIN-LOCAL-AREA-INFO        PIC X(12).
005600     03  DBFIN-INDICATOR-MDX-FILE     PIC X.
005700     03  DBFIN-RESERVED-2             PIC X(3).
005800
005900 01  HULPVELDEN.
006000     03  QS-LEES-DBASE  VALUE 1      PIC S9(4)  COMP-5.
006100     03  FILE-STATUS-DBFIN           PIC XX.
006200     03  FILE-STATUS-DBFIN-VORIG     PIC XX VALUE ZERO.
006300     03  FILE-STATUS-DBFUIT          PIC XX.
006400     03  LENGTH-MINUS-RECDBFIN-ALF   PIC XX VALUE HIGH-VALUE.
006500     03  LENGTH-MINUS-RECDBFIN REDEFINES LENGTH-MINUS-RECDBFIN-ALF
006600                                     PIC S9(4)  COMP-5.
006700     03  AANTAL-GEHELE-BLOKKEN       PIC S9(4)  COMP-5.
006800     03  AANTAL-DBASE-BYTES          PIC S9(9)  COMP-5.
006900     03  RESTANT-LAATSTE-BLOK        PIC S9(4)  COMP-5.
007000     03  DBFIN-LENGTH-RESTANT-ALF    PIC XX VALUE HIGH-VALUE.
007100     03  DBFIN-LENGTH-RESTANT REDEFINES DBFIN-LENGTH-RESTANT-ALF
007200                                     PIC S9(4)  COMP-5.
007300     03  DBFIN-INPUT-LOKATIE         PIC S9(4)  COMP-5.
007400     03  DBASE-OUTPUT-FILE           PIC X(83) VALUE SPACE.
007500     03  DBASE-INPUT-FILE            PIC X(83) VALUE SPACE.
007600
007700 LINKAGE SECTION.
007800 01  POINTR-OUTP-FULL-LENGTH.
007900     03  FILLER OCCURS 1 TO 10000 DEPENDING ON
008000         DBFIN-LENGTH-RECORD         PIC X.
008100
008200 01  POINTR-FIRST-PART-REC.
008300     03  FILLER OCCURS 1 TO 10000 DEPENDING ON
008400         DBFIN-LENGTH-RESTANT        PIC X.
008500
008600 01  POINTR-SCND-PART-REC.
008700     03  FILLER OCCURS 1 TO 10000 DEPENDING ON
008800         LENGTH-MINUS-RECDBFIN       PIC X.
008900
009000 PROCEDURE DIVISION.
009100
009200 MAIN SECTION.
009300 0001.
009400     DISPLAY 'INPUT FILE ?'.
009500     MOVE SPACE TO DBASE-INPUT-FILE.
009600     ACCEPT DBASE-INPUT-FILE FROM CONSOLE.
009700     OPEN INPUT DBFIN.
009800     IF FILE-STATUS-DBFIN NOT = ZERO THEN
009900          DISPLAY '*  FOUTIEF OPGEGEVEN, DOE ''T NOG EENS  *'
010000          EXHIBIT NAMED FILE-STATUS-DBFIN
010100          EXHIBIT NAMED DBASE-INPUT-FILE
010200          GO TO 0001.
010300     READ DBFIN INTO DBFIN-LABEL-REC
010400          AT END DISPLAY '*** LEEG BESTAND ***'
010500          STOP RUN.
010600     IF FILE-STATUS-DBFIN NOT = ZERO
010700         DISPLAY '*** DBASE FILE IS NIET LEESBAAR ***'
010800         EXHIBIT NAMED FILE-STATUS-DBFIN
010900         EXHIBIT NAMED DBASE-INPUT-FILE
011000         DISPLAY '*** EINDE PROGRAMMA    ***'
011100         STOP RUN.
011200 0002.
011300     DISPLAY 'OUTPUT FILE ?'.
011400     MOVE SPACE TO DBASE-OUTPUT-FILE.
011500     ACCEPT DBASE-OUTPUT-FILE FROM CONSOLE.
011600     OPEN OUTPUT DBFUIT.
011700     IF FILE-STATUS-DBFUIT NOT = ZERO THEN
011800          DISPLAY '*  FOUTIEF OPGEGEVEN, DOE ''T NOG EENS  *'
011900          GO TO 0002.
012000 0003.
012100     COMPUTE AANTAL-DBASE-BYTES =  DBFIN-LENGTH-HEADER
012200       + DBFIN-NUMBER-OF-RECORDS * DBFIN-LENGTH-RECORD.
012300     DIVIDE AANTAL-DBASE-BYTES BY 32767
012400          GIVING    AANTAL-GEHELE-BLOKKEN
012500          REMAINDER RESTANT-LAATSTE-BLOK.
012600     MOVE DBFIN-LENGTH-HEADER     TO DBFIN-INPUT-LOKATIE.
012700     ADD +1 TO                       DBFIN-INPUT-LOKATIE.
012800     SET ADRES-SET-LINK TO
012900                ADDRESS OF DBFIN-TEKEN(DBFIN-INPUT-LOKATIE).
013000     SET ADDRESS OF POINTR-OUTP-FULL-LENGTH TO ADRES-SET-LINK.
013100     MOVE POINTR-OUTP-FULL-LENGTH TO DBASE-REC.
013200****                                                   WRITE DBASE-RECORD
013300     WRITE DBASE-REC.
013400     SUBTRACT 1                   FROM DBFIN-NUMBER-OF-RECORDS.
013500     ADD DBFIN-LENGTH-RECORD      TO   DBFIN-INPUT-LOKATIE.
013600 BUFFER-ITR.
013700     IF DBFIN-NUMBER-OF-RECORDS < 1
013800         GO TO BUFFER-END.
013900 RECORD-ITR.
014000     IF 32767 - DBFIN-INPUT-LOKATIE < DBFIN-LENGTH-RECORD
014100         OR DBFIN-NUMBER-OF-RECORDS < 1
014200         GO TO RECORD-END.
014300     SET ADRES-SET-LINK TO
014400                ADDRESS OF DBFIN-TEKEN(DBFIN-INPUT-LOKATIE).
014500     SET ADDRESS OF POINTR-OUTP-FULL-LENGTH TO ADRES-SET-LINK.
014600     MOVE POINTR-OUTP-FULL-LENGTH TO DBASE-REC.
014700     SET ADRES-SET-LINK TO
014800                ADDRESS OF DBFIN-TEKEN(DBFIN-INPUT-LOKATIE).
014900     SET ADDRESS OF POINTR-OUTP-FULL-LENGTH TO ADRES-SET-LINK.
015000     MOVE POINTR-OUTP-FULL-LENGTH TO DBASE-REC.
015100     SUBTRACT 1                   FROM DBFIN-NUMBER-OF-RECORDS.
015200     WRITE DBASE-REC.
015300     ADD DBFIN-LENGTH-RECORD      TO   DBFIN-INPUT-LOKATIE.
015400     GO TO RECORD-ITR.
015500 RECORD-END.
015600     IF DBFIN-NUMBER-OF-RECORDS < 1
015700         GO TO BUFFER-END.
015800**** GEDEELTELIJK RECORD IN HET OUDE BLOK ****
015900     COMPUTE DBFIN-LENGTH-RESTANT  = 32768 - DBFIN-INPUT-LOKATIE.
016000     COMPUTE LENGTH-MINUS-RECDBFIN = DBFIN-LENGTH-RECORD -
016100                                     DBFIN-LENGTH-RESTANT.
016200     SET ADRES-SET-LINK TO
016300                ADDRESS OF DBFIN-TEKEN(DBFIN-INPUT-LOKATIE).
016400     SET ADDRESS OF POINTR-FIRST-PART-REC  TO ADRES-SET-LINK.
016500     MOVE POINTR-FIRST-PART-REC   TO DBASE-REC.
016600     ADD +1             TO DBFIN-LENGTH-RESTANT.
016700     SET ADRES-SET-LINK TO
016800                ADDRESS OF DBFIN-TEKEN(DBFIN-INPUT-LOKATIE).
016900     SET ADDRESS OF POINTR-SCND-PART-REC  TO ADRES-SET-LINK.
017000     READ DBFIN INTO POINTR-SCND-PART-REC.
017100     IF FILE-STATUS-DBFIN NOT = ZERO AND
017200        FILE-STATUS-DBFIN-VORIG NOT = ZERO
017300         GO TO BUFFER-END
017400     ELSE
017500        MOVE FILE-STATUS-DBFIN TO
017600             FILE-STATUS-DBFIN-VORIG
017700     END-IF.
017800     SUBTRACT 1                   FROM DBFIN-NUMBER-OF-RECORDS.
017900     WRITE DBASE-REC.
018000     MOVE LENGTH-MINUS-RECDBFIN TO DBFIN-INPUT-LOKATIE.
018100     ADD 1 TO                      DBFIN-INPUT-LOKATIE.
018200     GO TO BUFFER-ITR.
018300 BUFFER-END.
018400     CLOSE DBFIN.
018500****                                                   WRITE DBASE-RECORD
018600     STOP RUN.