home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch13 / CHAPT13D.COB < prev    next >
Encoding:
Text File  |  1998-09-15  |  3.1 KB  |  90 lines
  1. 000010 @OPTIONS MAIN
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt13d.
  4. 000031* Read Example
  5. 000043 Environment Division.
  6. 000050 Configuration Section.
  7. 000051 Special-Names.
  8. 000052       Crt Status Is Keyboard-Status.
  9. 000054 Source-Computer.  IBM-PC.
  10. 000055 Object-Computer.  IBM-PC.
  11. 000056 Input-Output  Section.
  12. 000059 File-Control.
  13. 000060     Select Optional Name-File Assign To "NAMES.TXT"
  14. 000061         Organization Is Line Sequential
  15. 000062         File Status  Is Name-File-Status.
  16. 000065 Data Division.
  17. 000066 File Section.
  18. 000067 Fd  Name-File.
  19. 000068 01  Name-Record           Pic X(30).
  20. 000070 Working-Storage Section.
  21. 000071 01  Full-Name             Pic X(30) Value Spaces.
  22. 000073 01  Keyboard-Status.
  23. 000074     03  Accept-Status     Pic 9.
  24. 000075     03  Function-Key      Pic X.
  25. 000076         88 F1-Pressed     Value X"01".
  26. 000077     03  System-Use        Pic X.
  27. 000078 01  File-Error-Flag       Pic X Value Space.
  28. 000079     88  File-Error        Value "Y".
  29. 000080 01  Name-File-Status      Pic XX Value Spaces.
  30. 000081     88  Name-File-Success Value "00" "05".
  31. 000088     88  End-Of-File       Value "10".
  32. 000089 01  Error-Message         Pic X(50) Value Spaces.
  33. 000090 Screen Section.
  34. 000091 01  Name-Entry Blank Screen.
  35. 000092     03  Line 01 Column 01 Value "       Name: ".
  36. 000093     03  Line 01 Column 14 Pic X(30) Using Full-Name.
  37. 000094     03  Line 05 Column 01 Pic X(50) From Error-Message.
  38. 000095     03  Line 20 Column 01 Value "Press F1 to Exit".
  39. 000098 Procedure Division.
  40. 000159 Chapt13d-Start.
  41. 000160     Perform Open-File
  42. 000161     If Not File-Error
  43. 000162        Perform Process-File Until F1-Pressed Or
  44. 000163                                   File-Error Or
  45. 000164                                   End-Of-File
  46. 000165        Perform Close-File
  47. 000166     End-If
  48. 000167     Stop Run
  49. 000168     .
  50. 000177 Open-File.
  51. 000187     Open Input Name-File
  52. 000197     If Not Name-File-Success
  53. 000207        Move Spaces To Error-Message
  54. 000217        String "Open Error " Name-File-Status
  55. 000227               Delimited By Size
  56. 000237               Into Error-Message
  57. 000247        Perform Display-And-Accept-Error
  58. 000257     End-If
  59. 000267     .
  60. 000277 Process-File.
  61. 000287     Move Spaces To Full-Name
  62. 000288     Perform Read-File
  63. 000289     If Not File-Error
  64. 000290        Display Name-Entry
  65. 000297        Accept Name-Entry
  66. 000298     End-If
  67. 000299     Move Spaces To Error-Message
  68. 000317     .
  69. 000327 Read-File.
  70. 000337     Read Name-File Into Full-Name
  71. 000338          At End Move "End Of File" To Error-Message
  72. 000339     End-Read
  73. 000340     If Name-File-Success Or End-Of-File
  74. 000341        Continue
  75. 000342     Else
  76. 000343        Move Spaces To Error-Message
  77. 000344        String "Read Error " Name-File-Status
  78. 000345           Delimited By Size Into Error-Message
  79. 000346        End-String
  80. 000347        Perform Display-And-Accept-Error
  81. 000348     End-If
  82. 000349     .
  83. 000417 Display-And-Accept-Error.
  84. 000427     Set File-Error To True
  85. 000437     Display Name-Entry
  86. 000447     Accept Name-Entry
  87. 000457     .
  88. 000467 Close-File.
  89. 000477     Close Name-File
  90. 000487     .
  91.