Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Reading Sequential file with no CR/LF in records

Status
Not open for further replies.

TonyG

Programmer
Nov 6, 2000
79
US
Hello,

Environment is standalone PC using MF COBOL 3.0 and DOS 6.22. When i try to read a single record from a file that is defined with the following Select and FD, it opens the file ok, but when i try to read the record in it, it returns a FS=10.

I don't really know what the file/record size is except that a DOS DIR yields 58 and looking at the file in an editor shows the last character in the file at location 58 (a comma ",") with no CR/LF's.

I tried various combinations of RECORDING MODES, FIXED/VARIABLE LENGTH, SEQUENTIAL/LINE SEQUENTIAL. The closest i can come to getting to read a record is the current definition:

Thanks for any help with this problem.
Tony
 
Hi,

In the program hereafter, I read a DBase file and convert it into a sequential file.

It is a kind of binairy read, so it should work.

Good Luck! :)

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

I'll try it.

Tony
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top