home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch13 / CHAPT13X.COB < prev   
Encoding:
Text File  |  1998-09-15  |  5.2 KB  |  149 lines
  1. 000010 @OPTIONS MAIN
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt13x.
  4. 000031* Chapter 13 Exercise Solution
  5. 000041 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.SEQ"
  14. 000061         Organization Is 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         88 F2-Pressed     Value X"02".
  27. 000078         88 F3-Pressed     Value X"03".
  28. 000079     03  System-Use        Pic X.
  29. 000080 01  File-Error-Flag       Pic X Value Space.
  30. 000081     88  File-Error        Value "Y".
  31. 000082 01  Name-File-Status      Pic XX Value Spaces.
  32. 000083     88  Name-File-Success Value "00" "05".
  33. 000088     88  End-Of-File       Value "10".
  34. 000089 01  Error-Message         Pic X(50) Value Spaces.
  35. 000090 Screen Section.
  36. 000091 01  Name-Entry Blank Screen.
  37. 000092     03  Line 01 Column 01 Value " Enter Name: ".
  38. 000093     03  Line 01 Column 14 Pic X(30) Using Full-Name.
  39. 000094     03  Line 05 Column 01 Pic X(50) From Error-Message.
  40. 000095     03  Line 20 Column 01
  41. 000096         Value "Press F1 to Exit    Press F2 to Update".
  42. 000098     03  Line 20 Column 44 Value "Press F3 to Add to End".
  43. 000108 Procedure Division.
  44. 000159 Chapt13f-Start.
  45. 000160     Perform Open-File
  46. 000161     If Not File-Error
  47. 000162        Perform Process-File Until F1-Pressed Or
  48. 000163                                   File-Error Or
  49. 000164                                   End-Of-File
  50. 000165        Perform Close-File
  51. 000166     End-If
  52. 000167     Stop Run
  53. 000168     .
  54. 000177 Open-File.
  55. 000187     Open I-O Name-File
  56. 000197     If Not Name-File-Success
  57. 000207        Move Spaces To Error-Message
  58. 000217        String "Open Error " Name-File-Status
  59. 000227               Delimited By Size
  60. 000237               Into Error-Message
  61. 000247        Perform Display-And-Accept-Error
  62. 000257     End-If
  63. 000267     .
  64. 000268 Open-Extend.
  65. 000269     Open Extend Name-File
  66. 000270     If Not Name-File-Success
  67. 000272        Move Spaces To Error-Message
  68. 000273        String "Open Extend Error " Name-File-Status
  69. 000274               Delimited By Size
  70. 000275               Into Error-Message
  71. 000276        Perform Display-And-Accept-Error
  72. 000277     End-If
  73. 000278     .
  74. 000279
  75. 000280 Process-File.
  76. 000287     Move Spaces To Full-Name
  77. 000288     Perform Read-File
  78. 000289     If Not File-Error
  79. 000290        Display Name-Entry
  80. 000297        Accept Name-Entry
  81. 000298        Move Spaces To Error-Message
  82. 000299        If F2-Pressed And Not End-Of-File
  83. 000300           Perform Rewrite-Record
  84. 000301        End-If
  85. 000302        If F3-Pressed
  86. 000303           Perform Add-Record
  87. 000304        End-If
  88. 000305     End-If
  89. 000317     .
  90. 000327 Read-File.
  91. 000337     Read Name-File Into Full-Name
  92. 000338          At End Move "End Of File" To Error-Message
  93. 000339     End-Read
  94. 000340     If Name-File-Success Or End-Of-File
  95. 000341        Continue
  96. 000342     Else
  97. 000343        Move Spaces To Error-Message
  98. 000344        String "Read Error " Name-File-Status
  99. 000345           Delimited By Size Into Error-Message
  100. 000346        End-String
  101. 000347        Perform Display-And-Accept-Error
  102. 000348     End-If
  103. 000349     .
  104. 000355 Rewrite-Record.
  105. 000365     Rewrite Name-Record From Full-Name
  106. 000366     If Name-File-Success
  107. 000367        Move "Prior Record Updated" To Error-Message
  108. 000368     Else
  109. 000375        Move Spaces To Error-Message
  110. 000395        String "Rewrite Error " Name-File-Status
  111. 000405          Delimited By Size Into Error-Message
  112. 000415        End-String
  113. 000417     End-If
  114. 000418     .
  115. 000419 Write-Record.
  116. 000420     Write Name-Record From Full-Name
  117. 000421     If Name-File-Success
  118. 000422        Move "Prior Record Added" To Error-Message
  119. 000423     Else
  120. 000424        Move Spaces To Error-Message
  121. 000425        String "Write Error " Name-File-Status
  122. 000426          Delimited By Size Into Error-Message
  123. 000427        End-String
  124. 000428     End-If
  125. 000429     .
  126. 000430 Display-And-Accept-Error.
  127. 000431     Set File-Error To True
  128. 000437     Display Name-Entry
  129. 000447     Accept Name-Entry
  130. 000457     .
  131. 000458 Add-Record.
  132. 000459*close The File First.
  133. 000460     Perform Close-File
  134. 000461*open The File Extend.
  135. 000462     Perform Open-Extend
  136. 000463* Only Do The Following If The Open Worked!
  137. 000464     If Name-File-Success
  138. 000465*write The Record
  139. 000466        Perform Write-Record
  140. 000467*if Successful, Close The File, And Re-Open For Normal Reading.
  141. 000468        If Name-File-Success
  142. 000469           Close Name-File
  143. 000470           Perform Open-File
  144. 000471        End-If
  145. 000472     End-If
  146. 000473     .
  147. 000474 Close-File.
  148. 000477     Close Name-File
  149. 000487     .
  150.