Advertisement
RetroLiPS

Untitled

May 7th, 2020
3,428
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
COBOL 4.84 KB | None | 0 0
  1. 000100 identification division.
  2. 000200 program-id. relativefile.
  3. 000250 author. retromagazine.
  4. 000300 environment division.
  5. 000400 configuration section.
  6. 000500 source-computer. c64.
  7. 000600 object-computer. c64.
  8. 000601 input-output section.
  9. 000602 file-control.
  10. 000603     select reldata1 assign to disk-1541 drive-8
  11. 000604     organization is relative
  12. 000605     access mode is random
  13. 000606     relative key is rel-key
  14. 000620     file status is file-st.
  15. 001000 data division.
  16. 001001 file section.
  17. 001002 fd  reldata1
  18. 001003     label record is standard
  19. 001004     value of file-id is "@0:reldata1".
  20. 001010 01  data-record.
  21. 001011     02 rel-key pic 9(5).
  22. 001015     02 nominativo.
  23. 001016        04 nome pic x(15).
  24. 001017        04 cognome pic x(15).
  25. 001020     02 residenza.
  26. 001026        04 indirizzo pic x(20).
  27. 001027        04 cap pic 9(5).
  28. 001028        04 citta pic x(25).
  29. 001100 working-storage section.
  30. 001101 77  scelta pic x.
  31. 001102 77  clear-home value chr 147 pic x.
  32. 001103 77  return-codice value chr 13 pic x.
  33. 001104 77  rvs-on value chr 18 pic x.
  34. 001114 77  file-st pic xx.
  35. 001115 77  pausa pic x.
  36. 001116 77  num-record pic 9(5).
  37. 001200 procedure division.
  38. 001201 main.
  39. 001202     open i-o reldata1.
  40. 001203     if file-st not equal to "00"
  41. 001204        display "errore in apertura file"
  42. 001205        stop run.
  43. 001305 mostra-menu.
  44. 001310     display clear-home.
  45. 001320     display rvs-on "--> menu principale - file relative <--".
  46. 001330     display " " return-codice.
  47. 001335     display " " return-codice.
  48. 001340     display "i-inserimento nuovo record" return-codice.
  49. 001350     display "l-lettura sequenziale" return-codice.
  50. 001355     display "r-ricerca per account" return-codice.
  51. 001356     display "c-cancellazione account" return-codice.
  52. 001360     display "u-uscita" return-codice.
  53. 001370     accept scelta.
  54. 001380     if scelta equal to "u"
  55. 001385        close reldata1
  56. 001390        display rvs-on "-->programma terminato. arrivederci..."
  57. 001400        stop run.
  58. 001410     if scelta equal to "l"
  59. 001411        move 00001 to rel-key
  60. 001412        perform leggi-file thru end-leggi-file.
  61. 001420     if scelta equal to "i" perform scrivi-file thru end-scrivi-file.
  62. 001430     if scelta equal to "r"
  63. 001431        display " " return-codice
  64. 001432        display "rel-key (in formato 00000):" return-codice
  65. 001433        accept num-record
  66. 001434        move num-record to rel-key
  67. 001439        perform leggi-file thru end-leggi-file.
  68. 001440     if scelta equal to "c" perform cancella-record thru end-cancella-record.
  69. 001450     go to mostra-menu.
  70. 001500***********************
  71. 001700 leggi-file.
  72. 001701     display rvs-on "-- lettura dati --" return-codice.
  73. 001707 leggi-loop.
  74. 001710     read reldata1 invalid key go to end-lettura.
  75. 001711     if file-st not equal to "00"
  76. 001712        display "errore in apertura file"
  77. 001713        stop run.
  78. 001715     display "rel-key:   ".
  79. 001716     display rel-key return-codice.
  80. 001720     display "nome:      ".
  81. 001725     display nome return-codice.
  82. 001730     display "cognome:   ".
  83. 001735     display cognome return-codice.
  84. 001740     display "indirizzo: ".
  85. 001745     display indirizzo return-codice.
  86. 001750     display "           " cap " - " citta return-codice.
  87. 001900     display rvs-on "-->prossimo record -->x per terminare".
  88. 001905     accept pausa.
  89. 001910     if pausa not equal to "x"
  90. 001911        add 1 to rel-key
  91. 001915        go to leggi-loop.
  92. 002000 end-lettura.
  93. 002005     display rvs-on "-- lettura dati terminata--" return-codice.
  94. 002006     accept pausa.
  95. 002030     perform mostra-menu.
  96. 002035 end-leggi-file.
  97. 002040     exit.
  98. 002045***********************
  99. 002500 scrivi-file.
  100. 002501     display clear-home.
  101. 002502     display rvs-on "--> inserimento dati <--".
  102. 002503     display " " return-codice.
  103. 002510 accetta-dati.
  104. 002511     display rvs-on "rel-key (in formato 00000):" return-codice.
  105. 002512     accept rel-key.
  106. 002530     display rvs-on "nome (max 15 chr):" return-codice.
  107. 002540     accept nome.
  108. 002550     display rvs-on "cognome (max 15 chr):" return-codice.
  109. 002560     accept cognome.
  110. 002570     display rvs-on "indirizzo (max 20 chr):" return-codice.
  111. 002580     accept indirizzo.
  112. 002581     display rvs-on "cap (max 5 numeri):" return-codice.
  113. 002582     accept cap.
  114. 002584     display rvs-on "citta' (max 25 chr):" return-codice.
  115. 002585     accept citta.
  116. 002590     display rvs-on "i dati sono corretti? s/n" return-codice.
  117. 002600     accept scelta.
  118. 002605     if scelta equal "n"
  119. 002610         go to accetta-dati.
  120. 002620     write data-record
  121. 002621         invalid key display "chiave non valida!".
  122. 002630     if file-st not equal to "00"
  123. 002640        display "errore in scrittura file"
  124. 002650        stop run.
  125. 002700     perform mostra-menu.
  126. 002710 end-scrivi-file.
  127. 002715     exit.
  128. 002716********************************
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement