API tools faq
paste
Advertisement
Guest User

Yvan Janssens

a guest
Jul 21st, 2010
239
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 9.74 KB | None | 0 0
raw download clone embed print report
  1. *>
  2.  IDENTIFICATION DIVISION.
  3.  PROGRAM-ID.   CAddress.
  4.  ENVIRONMENT    DIVISION.
  5.  CONFIGURATION  SECTION.
  6.  INPUT-OUTPUT SECTION.
  7.  FILE-CONTROL.
  8.        SELECT TelephoneBookFile
  9.            ASSIGN TO "phonebook.db"
  10.            ORGANIZATION IS INDEXED
  11.            RECORD KEY IS user-record-key
  12.            ACCESS MODE IS DYNAMIC.
  13.  DATA DIVISION.
  14.  FILE SECTION.
  15.     FD TelephoneBookFile
  16.         LABEL RECORDS ARE STANDARD.
  17.     01 User-Record-File.
  18.         05  user-record-key        PIC X(35).
  19.         05  user-record-first-name PIC X(24).
  20.     05  user-record-last-name  PIC X(50).
  21.     05  user-record-address    PIC X(50).
  22.     05  user-record-city       PIC X(16).
  23.     05  user-record-zip        PIC X(8) .
  24.     05  user-record-country    PIC X(20).
  25.     05  user-record-telephone  PIC X(16).
  26.  
  27.  
  28.  WORKING-STORAGE SECTION.
  29.   77  menu-hoofd-invoer  PICTURE 9(1) VALUE 9.
  30.     88  menu-invoer-correct  VALUE 0 THRU 5.
  31.     88  menu-invoer-incorrect VALUE 6 THRU 9.
  32.     88  menu-invoer-afsluiten VALUE 0.
  33.     88  menu-invoer-record-toevoegen VALUE 1.
  34.     88  menu-invoer-nieuw-bestand VALUE 5.
  35.   77  Error-Msg  PICTURE X(30) VALUE "                              ".
  36.   77  Green-Msg  PICTURE X(30) VALUE "                              ".
  37.   77  file-status PICTURE X(3) VALUE " ".
  38.     88  file-status-eof VALUE "EOF".
  39.   01  User-Record.
  40.     05  user-first-name PIC X(24).
  41.     05  user-last-name  PIC X(50).
  42.     05  user-address    PIC X(50).
  43.     05  user-city       PIC X(16).
  44.     05  user-zip        PIC X(8) .
  45.     05  user-country    PIC X(20).
  46.     05  user-telephone  PIC X(16).
  47.   77  Yes-No-Correct-Field PICTURE X(1) VALUE " ".
  48.     88  yes-no-field-yes   VALUE "Y" "y".
  49.     88  yes-no-field-no    VALUE "N" "n".
  50.     88  yes-no-field-correct VALUE "C" "c".
  51.   77  Record-Count   PIC 9(5) VALUE 0.
  52.   77  Error-Screen-Msg PIC X(45) VALUE SPACES.
  53.   77  Navigate-Field PICTURE X(1) VALUE " ".
  54.     88 Navigate-Next       VALUE "N" "n".
  55.     88 Navigate-Prev       VALUE "P" "p".
  56.     88 Navigate-Exit       VALUE "X" "x".
  57.   77  Error-Continue-Flag PIC X(1) VALUE " ".
  58.     88 Error-Continue-OK   VALUE "C" "c".
  59.  SCREEN SECTION.
  60.     01  MainMenu.
  61.         05 BLANK SCREEN.
  62.         05 LINE 1  COLUMN 1  VALUE " CAddress - A COBOL Address Book".
  63.         05 LINE 2  COLUMN 1  VALUE " -------------------------------".
  64.         05 LINE 4  COLUMN 1  VALUE "   Make your choice: ".
  65.         05 LINE 5  COLUMN 1  VALUE "   ~~~~~~~~~~~~~~~~~ ".
  66.         05 LINE 7  COLUMN 1  VALUE "       1) Add record".
  67.         05 LINE 8  COLUMN 1  VALUE "       2) Delete record".
  68.         05 LINE 9  COLUMN 1  VALUE "       3) Look up record".
  69.         05 LINE 10 COLUMN 1  VALUE "       4) Show records".
  70.         05 LINE 11 COLUMN 1  VALUE "       5) Create new file".
  71.         05 LINE 13 COLUMN 1  VALUE "       0) Exit".
  72.         05 LINE 15 COLUMN 1  VALUE "             Choice? ".
  73.         05 LINE 15 COLUMN 25 PICTURE X(30) FROM Error-Msg FOREGROUND-COLOR 4.
  74.         05 LINE 24 COLUMN 1  VALUE " (c) YvanSoftware ".
  75.     01  InvoerMenu.
  76.         05 BLANK SCREEN.
  77.         05 LINE 1  COLUMN 1  VALUE " CAddress - A COBOL Address Book".
  78.         05 LINE 2  COLUMN 1  VALUE " -------------------------------".
  79.         05 LINE 4  COLUMN 1  VALUE "   Input Data".
  80.         05 LINE 5  COLUMN 1  VALUE "   ~~~~~~~~~~".
  81.         05 LINE 7  COLUMN 1  VALUE "   First name   :" FOREGROUND-COLOR 2.
  82.         05 LINE 8  COLUMN 1  VALUE "   Last name    :" FOREGROUND-COLOR 2.
  83.         05 LINE 9  COLUMN 1  VALUE "   Address      :" FOREGROUND-COLOR 2.
  84.         05 LINE 10 COLUMN 1  VALUE "   City         :" FOREGROUND-COLOR 2.
  85.         05 LINE 11 COLUMN 1  VALUE "   ZIP          :" FOREGROUND-COLOR 2.
  86.         05 LINE 12 COLUMN 1  VALUE "   Country      :" FOREGROUND-COLOR 2.
  87.         05 LINE 13 COLUMN 1  VALUE "   Telephone    :" FOREGROUND-COLOR 2.
  88.         05 LINE 15 COLUMN 1  VALUE "       Save? y(es)/n(o)/c(orrect) " FOREGROUND-COLOR 4.
  89.         05 LINE 24 COLUMN 1  VALUE " (c) YvanSoftware ".
  90.     01  UitvoerScherm.
  91.         05 BLANK SCREEN.
  92.         05 LINE 1  COLUMN 1  VALUE " CAddress - A COBOL Address Book".
  93.         05 LINE 2  COLUMN 1  VALUE " -------------------------------".
  94.         05 LINE 4  COLUMN 1  VALUE "   Find Data".
  95.         05 LINE 5  COLUMN 1  VALUE "   ~~~~~~~~~~".
  96.         05 LINE 7  COLUMN 1  VALUE "   First name   :" FOREGROUND-COLOR 2.
  97.         05 LINE 8  COLUMN 1  VALUE "   Last name    :" FOREGROUND-COLOR 2.
  98.         05 LINE 9  COLUMN 1  VALUE "   Address      :" FOREGROUND-COLOR 2.
  99.         05 LINE 10 COLUMN 1  VALUE "   City         :" FOREGROUND-COLOR 2.
  100.         05 LINE 11 COLUMN 1  VALUE "   ZIP          :" FOREGROUND-COLOR 2.
  101.         05 LINE 12 COLUMN 1  VALUE "   Country      :" FOREGROUND-COLOR 2.
  102.         05 LINE 13 COLUMN 1  VALUE "   Telephone    :" FOREGROUND-COLOR 2.
  103. * Col 45 Input
  104.         05 LINE 15 COLUMN 1  VALUE "         Navigate? n(ext)/p(revious)/x(exit) " FOREGROUND-COLOR 4.
  105.         05 LINE 24 COLUMN 1  VALUE " (c) YvanSoftware ".
  106.     01  FoutScherm.
  107.         05 BLANK SCREEN.
  108.         05 LINE 4  COLUMN 15 VALUE "====================(ERROR)======================" BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
  109.         05 LINE 5  COLUMN 15 VALUE "                                                 " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
  110.         05 LINE 6  COLUMN 15 VALUE "                                                 " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
  111.         05 LINE 7  COLUMN 15 VALUE "                                                 " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
  112.         05 LINE 8  COLUMN 15 VALUE "                                                 " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
  113.         05 LINE 10 COLUMN 15 VALUE "                INPUT C TO CONTINUE              " BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
  114.         05 LINE 6  COLUMN 18 PICTURE X(45) FROM Error-screen-msg BACKGROUND-COLOR 4 FOREGROUND-COLOR 7 BLINK.
  115.  PROCEDURE DIVISION.      
  116.   main.
  117.         PERFORM Show-MainMenu UNTIL menu-invoer-afsluiten.
  118.         STOP RUN.
  119.      .
  120.   Show-MainMenu.
  121.         DISPLAY MainMenu
  122.         ACCEPT menu-hoofd-invoer LINE 15 COLUMN 22.
  123.         IF menu-invoer-incorrect
  124.         THEN
  125.             MOVE " Incorrect input" TO Error-Msg
  126.             MOVE " " TO Green-Msg
  127.         END-IF.
  128.         IF menu-invoer-record-toevoegen
  129.         THEN
  130.             PERFORM Show-InvoerMenu
  131.         END-IF
  132.         IF menu-invoer-nieuw-bestand
  133.         THEN
  134.             PERFORM Show-NewFile
  135.         END-IF.
  136.      .
  137.   Show-InvoerMenu.
  138.     DISPLAY InvoerMenu.
  139.     ACCEPT user-first-name      LINE 7  COLUMN 18
  140.         WITH FOREGROUND-COLOR 4.
  141.     ACCEPT user-last-name       LINE 8  COLUMN 18
  142.         WITH FOREGROUND-COLOR 4.
  143.     ACCEPT user-address         LINE 9  COLUMN 18
  144.         WITH FOREGROUND-COLOR 4.
  145.     ACCEPT user-city            LINE 10 COLUMN 18
  146.         WITH FOREGROUND-COLOR 4.
  147.     ACCEPT user-zip             LINE 11 COLUMN 18
  148.         WITH FOREGROUND-COLOR 4.
  149.     ACCEPT user-country         LINE 12 COLUMN 18
  150.         WITH FOREGROUND-COLOR 4.
  151.     ACCEPT user-telephone       LINE 13 COLUMN 18
  152.         WITH FOREGROUND-COLOR 4.
  153.    
  154.     PERFORM AskForSave.
  155.   .
  156.   Show-NewFile.
  157.     DISPLAY InvoerMenu.
  158.     ACCEPT user-first-name      LINE 7  COLUMN 18
  159.         WITH FOREGROUND-COLOR 4.
  160.     ACCEPT user-last-name       LINE 8  COLUMN 18
  161.         WITH FOREGROUND-COLOR 4.
  162.     ACCEPT user-address         LINE 9  COLUMN 18
  163.         WITH FOREGROUND-COLOR 4.
  164.     ACCEPT user-city            LINE 10 COLUMN 18
  165.         WITH FOREGROUND-COLOR 4.
  166.     ACCEPT user-zip             LINE 11 COLUMN 18
  167.         WITH FOREGROUND-COLOR 4.
  168.     ACCEPT user-country         LINE 12 COLUMN 18
  169.         WITH FOREGROUND-COLOR 4.
  170.     ACCEPT user-telephone       LINE 13 COLUMN 18
  171.         WITH FOREGROUND-COLOR 4.
  172.    
  173.     PERFORM AskForSaveNew.
  174.    
  175.   AskForSave.  
  176.     ACCEPT Yes-No-Correct-Field LINE 15 COLUMN 35
  177.         WITH FOREGROUND-COLOR 2.
  178.    
  179.     IF Yes-No-Field-Correct
  180.     THEN
  181.         PERFORM Show-InvoerMenu
  182.     END-IF.
  183.    
  184.     IF Yes-No-Field-No
  185.     THEN
  186.         PERFORM Show-MainMenu
  187.     END-IF.
  188.    
  189.     IF Yes-No-Field-Yes
  190.     THEN
  191.         PERFORM Save-Record
  192.     END-IF.
  193.    
  194.     IF NOT Yes-No-Field-No AND NOT Yes-No-Field-Yes AND NOT Yes-No-Field-Correct
  195.     THEN
  196.         PERFORM AskForSave
  197.     END-IF.
  198.     .
  199.   Save-Record.
  200.     OPEN I-O TelephoneBookFile.
  201.     PERFORM AddRecordKey.
  202.     MOVE user-first-name TO user-record-first-name.
  203.     MOVE user-last-name  TO user-record-last-name .
  204.     MOVE user-address    TO user-record-address   .
  205.     MOVE user-city       TO user-record-city      .
  206.     MOVE user-zip        TO user-record-zip       .
  207.     MOVE user-country    TO user-record-country   .
  208.     MOVE user-telephone  TO user-record-telephone .
  209.     WRITE User-Record-File INVALID KEY PERFORM ExistsAlready.
  210.     CLOSE TelephoneBookFile
  211.     .
  212.   AskForSaveNew.   
  213.     ACCEPT Yes-No-Correct-Field LINE 15 COLUMN 35
  214.         WITH FOREGROUND-COLOR 2.
  215.    
  216.     IF Yes-No-Field-Correct
  217.     THEN
  218.         PERFORM Show-NewFile
  219.     END-IF.
  220.    
  221.     IF Yes-No-Field-No
  222.     THEN
  223.         PERFORM Show-MainMenu
  224.     END-IF.
  225.    
  226.     IF Yes-No-Field-Yes
  227.     THEN
  228.         PERFORM Save-Record-NewFile
  229.     END-IF.
  230.    
  231.     IF NOT Yes-No-Field-No AND NOT Yes-No-Field-Yes AND NOT Yes-No-Field-Correct
  232.     THEN
  233.         PERFORM AskForSave
  234.     END-IF.
  235.     .
  236.   Save-Record-NewFile.
  237.         OPEN OUTPUT TelephoneBookFile.
  238.         PERFORM AddRecordKey.
  239.  
  240.     MOVE user-first-name TO user-record-first-name.
  241.     MOVE user-last-name  TO user-record-last-name .
  242.     MOVE user-address    TO user-record-address   .
  243.     MOVE user-city       TO user-record-city      .
  244.     MOVE user-zip        TO user-record-zip       .
  245.     MOVE user-country    TO user-record-country   .
  246.     MOVE user-telephone  TO user-record-telephone .
  247.     WRITE User-Record-File.
  248.     CLOSE TelephoneBookFile.
  249.     .
  250.   AddRecordKey.
  251.     STRING user-first-name(1:5) user-last-name(1:5)
  252.            user-address(1:5) user-city(1:5)
  253.            user-zip(1:5) user-country(1:5)
  254.            user-telephone(1:5)
  255.         DELIMITED BY SIZE
  256.         INTO user-record-key
  257.     .
  258.   ExistsAlready.
  259.     MOVE "Record already exists" TO Error-Screen-Msg
  260.     PERFORM ErrorScreen
  261.       .
  262.   ErrorScreen.
  263.     DISPLAY FoutScherm
  264.     ACCEPT  Error-Continue-Flag LINE 24 COLUMN 80
  265.     IF NOT Error-Continue-OK
  266.     THEN
  267.         Perform ErrorScreen
  268.     END-IF.
  269.     .  
  270.  END PROGRAM CAddress.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!