First of all, here’s the full source code:
http://pastebin.com/5teGNrPC
*>
IDENTIFICATION DIVISION.
PROGRAM-ID. CAddress.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TelephoneBookFile
ASSIGN TO "phonebook.db"
ORGANIZATION IS INDEXED
RECORD KEY IS user-record-key
ACCESS MODE IS DYNAMIC.
DATA DIVISION.
FILE SECTION.
FD TelephoneBookFile
LABEL RECORDS ARE STANDARD.
01 User-Record-File.
05 user-record-key PIC X(35).
05 user-record-first-name PIC X(24).
05 user-record-last-name PIC X(50).
05 user-record-address PIC X(50).
05 user-record-city PIC X(16).
05 user-record-zip PIC X(8) .
05 user-record-country PIC X(20).
05 user-record-telephone PIC X(16).
WORKING-STORAGE SECTION.
77 menu-hoofd-invoer PICTURE 9(1) VALUE 9.
88 menu-invoer-correct VALUE 0 THRU 5.
88 menu-invoer-incorrect VALUE 6 THRU 9.
88 menu-invoer-afsluiten VALUE 0.
88 menu-invoer-record-toevoegen VALUE 1.
88 menu-invoer-nieuw-bestand VALUE 5.
77 Error-Msg PICTURE X(30) VALUE " ".
77 Green-Msg PICTURE X(30) VALUE " ".
77 file-status PICTURE X(3) VALUE " ".
88 file-status-eof VALUE "EOF".
01 User-Record.
05 user-first-name PIC X(24).
05 user-last-name PIC X(50).
05 user-address PIC X(50).
05 user-city PIC X(16).
05 user-zip PIC X(8) .
05 user-country PIC X(20).
05 user-telephone PIC X(16).
77 Yes-No-Correct-Field PICTURE X(1) VALUE " ".
88 yes-no-field-yes VALUE "Y" "y".
88 yes-no-field-no VALUE "N" "n".
88 yes-no-field-correct VALUE "C" "c".
77 Record-Count PIC 9(5) VALUE 0.
77 Error-Screen-Msg PIC X(45) VALUE SPACES.
77 Navigate-Field PICTURE X(1) VALUE " ".
88 Navigate-Next VALUE "N" "n".
88 Navigate-Prev VALUE "P" "p".
88 Navigate-Exit VALUE "X" "x".
77 Error-Continue-Flag PIC X(1) VALUE " ".
88 Error-Continue-OK VALUE "C" "c".
SCREEN SECTION.
01 MainMenu.
05 BLANK SCREEN.
05 LINE 1 COLUMN 1 VALUE " CAddress - A COBOL Address Book".
05 LINE 2 COLUMN 1 VALUE " -------------------------------".
05 LINE 4 COLUMN 1 VALUE " Make your choice: ".
05 LINE 5 COLUMN 1 VALUE " ~~~~~~~~~~~~~~~~~ ".
05 LINE 7 COLUMN 1 VALUE " 1) Add record".
05 LINE 8 COLUMN 1 VALUE " 2) Delete record".
05 LINE 9 COLUMN 1 VALUE " 3) Look up record".
05 LINE 10 COLUMN 1 VALUE " 4) Show records".
05 LINE 11 COLUMN 1 VALUE " 5) Create new file".
05 LINE 13 COLUMN 1 VALUE " 0) Exit".
05 LINE 15 COLUMN 1 VALUE " Choice? ".
05 LINE 15 COLUMN 25 PICTURE X(30) FROM Error-Msg FOREGROUND-COLOR 4.
05 LINE 24 COLUMN 1 VALUE " (c) YvanSoftware ".
01 InvoerMenu.
05 BLANK SCREEN.
05 LINE 1 COLUMN 1 VALUE " CAddress - A COBOL Address Book".
05 LINE 2 COLUMN 1 VALUE " -------------------------------".
05 LINE 4 COLUMN 1 VALUE " Input Data".
05 LINE 5 COLUMN 1 VALUE " ~~~~~~~~~~".
05 LINE 7 COLUMN 1 VALUE " First name :" FOREGROUND-COLOR 2.
05 LINE 8 COLUMN 1 VALUE " Last name :" FOREGROUND-COLOR 2.
05 LINE 9 COLUMN 1 VALUE " Address :" FOREGROUND-COLOR 2.
05 LINE 10 COLUMN 1 VALUE " City :" FOREGROUND-COLOR 2.
05 LINE 11 COLUMN 1 VALUE " ZIP :" FOREGROUND-COLOR 2.
05 LINE 12 COLUMN 1 VALUE " Country :" FOREGROUND-COLOR 2.
05 LINE 13 COLUMN 1 VALUE " Telephone :" FOREGROUND-COLOR 2.
05 LINE 15 COLUMN 1 VALUE " Save? y(es)/n(o)/c(orrect) " FOREGROUND-COLOR 4.
05 LINE 24 COLUMN 1 VALUE " (c) YvanSoftware ".
01 UitvoerScherm.
05 BLANK SCREEN.
05 LINE 1 COLUMN 1 VALUE " CAddress - A COBOL Address Book".
05 LINE 2 COLUMN 1 VALUE " -------------------------------".
05 LINE 4 COLUMN 1 VALUE " Find Data".
05 LINE 5 COLUMN 1 VALUE " ~~~~~~~~~~".
05 LINE 7 COLUMN 1 VALUE " First name :" FOREGROUND-COLOR 2.
05 LINE 8 COLUMN 1 VALUE " Last name :" FOREGROUND-COLOR 2.
05 LINE 9 COLUMN 1 VALUE " Address :" FOREGROUND-COLOR 2.
05 LINE 10 COLUMN 1 VALUE " City :" FOREGROUND-COLOR 2.
05 LINE 11 COLUMN 1 VALUE " ZIP :" FOREGROUND-COLOR 2.
05 LINE 12 COLUMN 1 VALUE " Country :" FOREGROUND-COLOR 2.
05 LINE 13 COLUMN 1 VALUE " Telephone :" FOREGROUND-COLOR 2.
* Col 45 Input
05 LINE 15 COLUMN 1 VALUE " Navigate? n(ext)/p(revious)/x(exit) " FOREGROUND-COLOR 4.
05 LINE 24 COLUMN 1 VALUE " (c) YvanSoftware ".
01 FoutScherm.
05 BLANK SCREEN.
05 LINE 4 COLUMN 15 VALUE "====================(ERROR)======================" BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
05 LINE 5 COLUMN 15 VALUE " " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
05 LINE 6 COLUMN 15 VALUE " " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
05 LINE 7 COLUMN 15 VALUE " " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
05 LINE 8 COLUMN 15 VALUE " " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
05 LINE 10 COLUMN 15 VALUE " INPUT C TO CONTINUE " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
05 LINE 6 COLUMN 18 PICTURE X(45) FROM Error-screen-msg BACKGROUND-COLOR 4 FOREGROUND-COLOR 7 BLINK.
PROCEDURE DIVISION.
main.
PERFORM Show-MainMenu UNTIL menu-invoer-afsluiten.
STOP RUN.
.
Show-MainMenu.
DISPLAY MainMenu
ACCEPT menu-hoofd-invoer LINE 15 COLUMN 22.
IF menu-invoer-incorrect
THEN
MOVE " Incorrect input" TO Error-Msg
MOVE " " TO Green-Msg
END-IF.
IF menu-invoer-record-toevoegen
THEN
PERFORM Show-InvoerMenu
END-IF
IF menu-invoer-nieuw-bestand
THEN
PERFORM Show-NewFile
END-IF.
.
Show-InvoerMenu.
DISPLAY InvoerMenu.
ACCEPT user-first-name LINE 7 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-last-name LINE 8 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-address LINE 9 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-city LINE 10 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-zip LINE 11 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-country LINE 12 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-telephone LINE 13 COLUMN 18
WITH FOREGROUND-COLOR 4.
PERFORM AskForSave.
.
Show-NewFile.
DISPLAY InvoerMenu.
ACCEPT user-first-name LINE 7 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-last-name LINE 8 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-address LINE 9 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-city LINE 10 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-zip LINE 11 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-country LINE 12 COLUMN 18
WITH FOREGROUND-COLOR 4.
ACCEPT user-telephone LINE 13 COLUMN 18
WITH FOREGROUND-COLOR 4.
PERFORM AskForSaveNew.
AskForSave.
ACCEPT Yes-No-Correct-Field LINE 15 COLUMN 35
WITH FOREGROUND-COLOR 2.
IF Yes-No-Field-Correct
THEN
PERFORM Show-InvoerMenu
END-IF.
IF Yes-No-Field-No
THEN
PERFORM Show-MainMenu
END-IF.
IF Yes-No-Field-Yes
THEN
PERFORM Save-Record
END-IF.
IF NOT Yes-No-Field-No AND NOT Yes-No-Field-Yes AND NOT Yes-No-Field-Correct
THEN
PERFORM AskForSave
END-IF.
.
Save-Record.
OPEN I-O TelephoneBookFile.
PERFORM AddRecordKey.
MOVE user-first-name TO user-record-first-name.
MOVE user-last-name TO user-record-last-name .
MOVE user-address TO user-record-address .
MOVE user-city TO user-record-city .
MOVE user-zip TO user-record-zip .
MOVE user-country TO user-record-country .
MOVE user-telephone TO user-record-telephone .
WRITE User-Record-File INVALID KEY PERFORM ExistsAlready.
CLOSE TelephoneBookFile
.
AskForSaveNew.
ACCEPT Yes-No-Correct-Field LINE 15 COLUMN 35
WITH FOREGROUND-COLOR 2.
IF Yes-No-Field-Correct
THEN
PERFORM Show-NewFile
END-IF.
IF Yes-No-Field-No
THEN
PERFORM Show-MainMenu
END-IF.
IF Yes-No-Field-Yes
THEN
PERFORM Save-Record-NewFile
END-IF.
IF NOT Yes-No-Field-No AND NOT Yes-No-Field-Yes AND NOT Yes-No-Field-Correct
THEN
PERFORM AskForSave
END-IF.
.
Save-Record-NewFile.
OPEN OUTPUT TelephoneBookFile.
PERFORM AddRecordKey.
MOVE user-first-name TO user-record-first-name.
MOVE user-last-name TO user-record-last-name .
MOVE user-address TO user-record-address .
MOVE user-city TO user-record-city .
MOVE user-zip TO user-record-zip .
MOVE user-country TO user-record-country .
MOVE user-telephone TO user-record-telephone .
WRITE User-Record-File.
CLOSE TelephoneBookFile.
.
AddRecordKey.
STRING user-first-name(1:5) user-last-name(1:5)
user-address(1:5) user-city(1:5)
user-zip(1:5) user-country(1:5)
user-telephone(1:5)
DELIMITED BY SIZE
INTO user-record-key
.
ExistsAlready.
MOVE "Record already exists" TO Error-Screen-Msg
PERFORM ErrorScreen
.
ErrorScreen.
DISPLAY FoutScherm
ACCEPT Error-Continue-Flag LINE 24 COLUMN 80
IF NOT Error-Continue-OK
THEN
Perform ErrorScreen
END-IF.
.
END PROGRAM CAddress.
I’m getting a weird COBOL Error, and I couldn’t find what it means.
It says Open Error (see the following screenshot).
It doesn’t occur if I first use “new file”, and add a record after that.
Here’s the application binary and some log files it produced.
Many thanks,
Yvan
PS: It’s Fujitsu NetCobol dialect.
I would like to have a bit more information on the file I/O problem you are
having. If I understand correctly, you can do the following without problem:
Then if you start the program again and immediately
the program bombs with a “weird error”.
Is it possible for you to read
and display the record you wrote in the initial run? I am wondering if the prior
write was successful, which in turn brings into question the integrity of the file.
I would suggest exploring the
OPTIONALkeyword forSELECTandadding a
FILE STATUSclause too. The file status should be checkedafter each I/O operation (OPEN, CLOSE, WRITE, READ etc.). The value contained
in the variable associated with
FILE STATUSwill take you a long waytoward sorting out the problem. The following table
describes
FILE STATUSvalues.You might also want to review this tutorial on
processing indexed files in COBOL.
I may not have figured out what your file I/O problem is but I do see
something else that is bound to cause trouble later on!
You have used the following construct:
The last
PERFORM Some-Paragraphis within the scope ofthe paragraph itself. COBOL compilers may not flag this as an error but the
behaviour is undefined. COBOL PERFORM does not conform
to the CALL/RETURN semantics that you may be familiar with from
other languages. What you have coded here is commonly known as
as ‘Logic Bomb’. A detailed description of what I am referring to can
be found here.