home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / BASIC00.ZIP / DATAFILE.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  11.8 KB  |  334 lines
  1. 100 '   DATAFILE        This program will allow the user to create, append,
  2. 110 '                   edit, or display information from a random-access
  3. 120 '                   data file called MBRLIST. It shows a few of the
  4. 130 '                   fundamental techniques of data file programming.
  5. 140 '             NOTE: BASIC must be loaded as follows to run this program:
  6. 150 '                   BASIC/S:256
  7. 160 '             NOTE: Data entry tests have not been included. The program
  8. 170 '                   will run fine without them, but the user should be
  9. 180 '                   very careful when entering data. Better yet, insert
  10. 190 '                   the tests in the program.
  11. 200 '
  12. 210 '   Models and techniques in coding have been taken from "Data File Pro-
  13. 220 '   gramming in Basic" by LeRoy Finkel and Jerald Brown, John Wiley & Sons,
  14. 230 '   Inc., 1981.
  15. 240 '
  16. 250 '   For limited help call Bob Noble in Philadelphia (215) 329-4205.
  17. 260 '
  18. 270 '   Variables/Fields Used (22)
  19. 280 '     N$ = NF$ = Name. . . . . . . . . . . . . . . . . . . . . . (20)
  20. 290 '     S$ = SF$ = Street address. . . . . . . . . . . . . . . . . (30)
  21. 300 '     C$ = CF$ = City. . . . . . . . . . . . . . . . . . . . . . (15)
  22. 310 '     ST$ = STF$ = State . . . . . . . . . . . . . . . . . . . . .(2)
  23. 320 '     Z$ = ZF$ = Zip code. . . . . . . . . . . . . . . . . . . . .(5)
  24. 330 '     P$ = PF$ = Phone number. . . . . . . . . . . . . . . . . . (14)
  25. 340 '     MJ$ = MJF$ = Month joined. . . . . . . . . . . . . . . . . .(3)
  26. 350 '     YJ$ = YJF$ = Year joined . . . . . . . . . . . . . . . . . .(4)
  27. 360 '     Q1 = Q1F$ = MKS$(Q1) = Number of times dues paid . . . . . .(2)
  28. 370 '     D(1) = DF$(1) = Dues paid. . . . . . . . . . . . . . . . . .(4)
  29. 380 '     D(2) = DF$(2) = Dues paid. . . . . . . . . . . . . . . . . .(4)
  30. 390 '     D(3) = DF$(3) = Dues paid. . . . . . . . . . . . . . . . . .(4)
  31. 400 '     DA$(1) = DAF$(1) = Date dues paid. . . . . . . . . . . . . .(8)
  32. 410 '     DA$(2) = DAF$(2) = Date dues paid. . . . . . . . . . . . . .(8)
  33. 420 '     DA$(3) = DAF$(3) = Date dues paid. . . . . . . . . . . . . .(8)
  34. 430 '     Q2 = Q2F$ = MKS$(Q2) = Number of times other donations made (2)
  35. 440 '     OD(1) = ODF$(1) = Other donations. . . . . . . . . . . . . .(4)
  36. 450 '     OD(2) = ODF$(2) = Other donations. . . . . . . . . . . . . .(4)
  37. 460 '     OD(3) = ODF$(3) = Other donations. . . . . . . . . . . . . .(4)
  38. 470 '     DOD$(1) = FDOD$(1) = Date donations made . . . . . . . . . .(8)
  39. 480 '     DOD$(2) = FDOD$(2) = Date donations made . . . . . . . . . .(8)
  40. 490 '     DOD$(3) = FDOD$(3) = Date donations made . . . . . . . . . .(8)
  41. 500 '
  42. 510 '           TOTAL = 169 bytes
  43. 520 '
  44. 530 '   Files Used = MBRLIST
  45. 540 '
  46. 550 '   Initialize
  47. 560 KEY OFF: OPEN "R", 1, "MBRLIST", 256
  48. 570 FIELD 1,20ASNF$,30ASSF$,15ASCF$,2ASSTF$,5ASZF$,14ASPF$,3ASMJF$,4ASYJF$,2ASQ1F$,4ASDF$(1),4ASDF$(2),4ASDF$(3),8ASDAF$(1),8ASDAF$(2),8ASDAF$(3),2ASQ2F$,4ASODF$(1),4ASODF$(2),4ASODF$(3),8ASFDOD$(1),8ASFDOD$(2),8ASFDOD$(3)
  49. 580 I% = 0
  50. 590 '
  51. 600 '   Menu of operations
  52. 610 '
  53. 620 CLS: PRINT "DATAFILE * * * File Open: MBRLIST": PRINT
  54. 630 PRINT "    1. Add New Record(s)"
  55. 640 PRINT "    2. Edit Record(s)"
  56. 650 PRINT "    3. Display Record(s)"
  57. 660 PRINT "    4. Task Completed - Return to BASIC"
  58. 670 PRINT: INPUT "ENTER SELECTION (1-4):", Q
  59. 680 IF Q = 4 THEN CLS: KEY ON: CLOSE 1: END
  60. 690 ON Q GOTO 730, 1110, 1550
  61. 700 '
  62. 710 '  Routine to Add a New Record
  63. 720 '
  64. 730 CLS: I% = LOF(1) \ 256 + 1:     ' Data Entry
  65. 740 '
  66. 750 PRINT "M B R L I S T"
  67. 760 PRINT "Record No.:"; LOF(1) \ 256 + 1
  68. 770 PRINT: LINE INPUT "Name (last name first)(20): ", N$
  69. 780 LINE INPUT "Street Address (30): ", S$
  70. 790 LINE INPUT "City (15): ", C$
  71. 800  LINE INPUT "State (2): ", ST$
  72. 810 LINE INPUT "Zip Code (5): ", Z$
  73. 820 LINE INPUT "Phone (14): ", P$
  74. 830 LINE INPUT "Month Joined (3): ", MJ$
  75. 840 LINE INPUT "Year Joined (4): ", YJ$
  76. 850 INPUT "Number of times dues paid (0-10): ", Q1$
  77. 860 IF Q1$ = "0" THEN 910
  78. 870 FOR X = 1 TO VAL(Q1$)
  79. 880   INPUT "Amount dues paid (6): ", D$(X)
  80. 890   LINE INPUT "Date dues paid (8): ", DA$(X)
  81. 900 NEXT X
  82. 910 INPUT "Number of times other donations made (0-20): ", Q2$
  83. 920 IF Q2$ = "0" THEN 1040
  84. 930 FOR X = 1 TO VAL(Q2$)
  85. 940   INPUT "Amount other donations (7): ", OD$(X)
  86. 950   LINE INPUT "Date donations made (8): ", DOD$(X)
  87. 960 NEXT X
  88. 970 '
  89. 980 GOSUB 2240:        ' Transfer variables to buffer
  90. 990 '
  91. 1000 PUT 1, I%:         ' Copy buffer to file
  92. 1010 '
  93. 1020 '   Query user to enter another record
  94. 1030 '
  95. 1040 CLS: LINE INPUT "Do you want to enter another record? "; Q$
  96. 1050 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 730
  97. 1060 '
  98. 1070 CLOSE 1: GOTO 560: '    Return to main menu
  99. 1080 '
  100. 1090 '  Routine to Edit a Record
  101. 1100 '
  102. 1110 CLS: LINE INPUT "Name of member for record edit: "; NN$
  103. 1120 '
  104. 1130 FOR X = 1 TO LOF(1) \ 256: ' Search file for name
  105. 1140   I% = X
  106. 1150   GET 1, I%
  107. 1160   IF INSTR(NF$,NN$) <> 0 THEN 1260
  108. 1170 NEXT X
  109. 1180 '
  110. 1190 '   Print error message and query user for another record edit
  111. 1200 '
  112. 1210 PRINT: PRINT NN$; " not found in file."
  113. 1220 LINE INPUT "Do you want to enter a name again for record edit? ", Q$
  114. 1230 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 1110
  115. 1240 IF LEFT$(Q$,1) = "N" OR LEFT$(Q$,1) = "n" THEN CLOSE 1: GOTO 560
  116. 1250 '
  117. 1260 GOSUB 1960:        ' Display record
  118. 1270 '
  119. 1280 '  Display edit menu beneath record
  120. 1290 '
  121. 1300 PRINT "*****************************************************************"
  122. 1310 PRINT "Select field to edit (ENTER `0' IF NO CHANGE):"
  123. 1320 PRINT "   1. Name             4. State            7. When joined"
  124. 1330 PRINT "   2. Street address   5. Zip code         8. Dues"
  125. 1340 PRINT "   3. City             6. Phone            9. Other donations"
  126. 1350 INPUT "Enter selection (0-10): ", K
  127. 1360 IF K = 0 THEN CLS: GOTO 1440
  128. 1370 ON K GOSUB 2170, 2460, 2530, 2600, 2670, 2740, 2810, 2900, 3120
  129. 1380 '
  130. 1390 '   Query user for more editing of same record
  131. 1400 '
  132. 1410 PRINT: LINE INPUT "Do you want to edit another field in this record? ", Q$
  133. 1420 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 1260
  134. 1430 '
  135. 1440 PUT 1, I%:         ' Replace original record with edited version
  136. 1450 '
  137. 1460 '   Query user to edit another record
  138. 1470 '
  139. 1480 PRINT: LINE INPUT "Do you want to edit another record? ", Q$
  140. 1490 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 1110
  141. 1500 '
  142. 1510 CLOSE 1: GOTO 560:         ' Close and return to main menu
  143. 1520 '
  144. 1530 '   Routine to display records
  145. 1540 '
  146. 1550 CLS: LOCATE 10,20: PRINT "1. Display a specific record."
  147. 1560 LOCATE 12,20: PRINT "2. Display file, one record at a time."
  148. 1570 LOCATE 15,20:COLOR 0,7:PRINT "SELECT METHOD OF DISPLAY (1 OR 2):":COLOR 7
  149. 1580 LOCATE 15,55: INPUT Q
  150. 1590 ON Q GOTO 1630, 1820
  151. 1600 '
  152. 1610 '   Routine to display a specific record
  153. 1620 '
  154. 1630 CLS: LINE INPUT "Enter member's name: ", NN$
  155. 1640 '
  156. 1650 FOR X = 1 TO LOF(1) \ 256
  157. 1660   I% = X
  158. 1670   GET 1, I%
  159. 1680   IF INSTR(NF$,NN$) <> 0 THEN 1710
  160. 1690 NEXT X
  161. 1700 '
  162. 1710 GOSUB 1960:        ' Display record
  163. 1720 '
  164. 1730 '   Query user to display another record
  165. 1740 '
  166. 1750 PRINT: PRINT: LINE INPUT "Do you want to see another record? ", Q$
  167. 1760 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 1630
  168. 1770 '
  169. 1780 CLOSE 1: GOTO 560:   ' Close and return to menu
  170. 1790 '
  171. 1800 '   Routine to display records one at a time
  172. 1810 '
  173. 1820 FOR G = 1 TO LOF(1) \ 256
  174. 1830   I% = G
  175. 1840   GET 1, I%
  176. 1850   GOSUB 1960
  177. 1860   PRINT: PRINT: LINE INPUT "PRESS <ENTER> TO SEE NEXT RECORD.", Q$
  178. 1870 NEXT G
  179. 1880 '
  180. 1890 CLS: PRINT "END OF FILE"
  181. 1900 PRINT: LINE INPUT "Press <ENTER> to continue.", Q$
  182. 1910 '
  183. 1920 CLOSE 1: GOTO 560:         ' Close and return to main menu
  184. 1930 '
  185. 1940 '   Subroutine to display record
  186. 1950 '
  187. 1960 CLS: PRINT "M B R L I S T"
  188. 1970 PRINT "Record No.: "; I%
  189. 1980 PRINT "*****************************************************************"
  190. 1990 PRINT NF$: LOCATE 4,40: PRINT PF$
  191. 2000 PRINT SF$
  192. 2010 PRINT CF$; ", "; STF$; " "; ZF$
  193. 2020 PRINT: PRINT "Joined: "; MJF$; " "; YJF$
  194. 2030 PRINT "Dues Paid"
  195. 2040 FOR X = 1 TO CVI(Q1F$)
  196. 2050   PRINT USING "$$###.##"; CVS(DF$(X)),
  197. 2060   PRINT " *** "; DAF$(X)
  198. 2070 NEXT X
  199. 2080 PRINT "Other Donations"
  200. 2090 FOR X = 1 TO CVI(Q2F$)
  201. 2100   PRINT USING "$$####.##"; CVS(ODF$(X)),
  202. 2110   PRINT " *** "; FDOD$(X)
  203. 2120 NEXT X
  204. 2130 RETURN
  205. 2140 '
  206. 2150 '   Subroutine to change name
  207. 2160 '
  208. 2170 CLS: PRINT "Old Name: "; NF$
  209. 2180 PRINT: LINE INPUT "Enter New Name: ", N$
  210. 2190 LSET NF$ = N$
  211. 2200 RETURN
  212. 2210 '
  213. 2220 '  Subroutine to transfer variables to buffer
  214. 2230 '
  215. 2240 LSET NF$ = N$
  216. 2250 LSET SF$ = S$
  217. 2260 LSET CF$ = C$
  218. 2270 LSET STF$ = ST$
  219. 2280 LSET ZF$ = Z$
  220. 2290 LSET PF$ = P$
  221. 2300 LSET MJF$ = MJ$
  222. 2310 LSET YJF$ = YJ$
  223. 2320 LSET Q1F$ = MKI$(VAL(Q1$))
  224. 2330 FOR X = 1 TO 3
  225. 2340   RSET DF$(X) = MKS$(VAL(D$(X)))
  226. 2350   LSET DAF$(X) = DA$(X)
  227. 2360 NEXT X
  228. 2370 LSET Q2F$ = MKI$(VAL(Q2$))
  229. 2380 FOR X = 1 TO 3
  230. 2390   RSET ODF$(X) = MKS$(VAL(OD$(X)))
  231. 2400   LSET FDOD$(X) = DOD$(X)
  232. 2410 NEXT X
  233. 2420 RETURN
  234. 2430 '
  235. 2440 '   Subroutine to change street address
  236. 2450 '
  237. 2460 CLS: PRINT "Old Street Address: "; SF$
  238. 2470 PRINT: LINE INPUT "Enter New Street Address: ", S$
  239. 2480 LSET SF$ = S$
  240. 2490 RETURN
  241. 2500 '
  242. 2510 '   Subroutine to change city
  243. 2520 '
  244. 2530 CLS: PRINT "Old City: "; CF$
  245. 2540 PRINT: LINE INPUT "Enter New City: ", C$
  246. 2550 LSET CF$ = C$
  247. 2560 RETURN
  248. 2570 '
  249. 2580 '   Subroutine to change state
  250. 2590 '
  251. 2600 CLS: PRINT "Old State: "; STF$
  252. 2610 PRINT: LINE INPUT "Enter New State: ", ST$
  253. 2620 LSET STF$ = ST$
  254. 2630 RETURN
  255. 2640 '
  256. 2650 '   Subroutine to change zip code
  257. 2660 '
  258. 2670 CLS: PRINT "Old Zip Code: "; ZF$
  259. 2680 PRINT: LINE INPUT "Enter New Zip Code: ", Z$
  260. 2690 LSET ZF$ = Z$
  261. 2700 RETURN
  262. 2710 '
  263. 2720 '   Subroutine to change phone
  264. 2730 '
  265. 2740 CLS: PRINT "Old Phone: "; PF$
  266. 2750 PRINT: LINE INPUT "Enter New Phone: ", P$
  267. 2760 LSET PF$ = P$
  268. 2770 RETURN
  269. 2780 '
  270. 2790 '   Subroutine to change `when joined'
  271. 2800 '
  272. 2810 CLS: PRINT "Old `When Joined': "; MJF$; " "; YJF$
  273. 2820 PRINT: LINE INPUT "Enter New Month Joined: ", MJ$
  274. 2830 LINE INPUT "Enter New Year Joined: ", YJ$
  275. 2840 LSET MJF$ = MJ$
  276. 2850 LSET YJF$ = YJ$
  277. 2860 RETURN
  278. 2870 '
  279. 2880 '   Subroutine to change dues
  280. 2890 '
  281. 2900 CLS: PRINT "Old Dues Paid"
  282. 2910 FOR X = 1 TO CVI(Q1F$)
  283. 2920   PRINT "   ";
  284. 2930   PRINT USING "$$##.##"; CVS(DF$(X)),
  285. 2940   PRINT " *** ";DAF$(X)
  286. 2950 NEXT X
  287. 2960 PRINT: PRINT "`Old' Number of Times Dues Paid: "; CVI(Q1F$)
  288. 2970 LINE INPUT "Enter New Number of Times Dues Paid: ", Q1$
  289. 2980 FOR X = 1 TO VAL(Q1$)
  290. 2990   PRINT: LINE INPUT "Enter New Dues Paid: ", D$(X)
  291. 3000   LINE INPUT "Enter Date New Dues Paid: ", DA$(X)
  292. 3010 NEXT X
  293. 3020 LSET Q1F$ = MKI$(VAL(Q1$))
  294. 3030 FOR X = 1 TO VAL(Q1$)
  295. 3040   RSET DF$(X) = MKS$(VAL(D$(X)))
  296. 3050   LSET DAF$(X) = DA$(X)
  297. 3060 NEXT X
  298. 3070 IF VAL(Q1$) < CVI(Q1F$) THEN GOSUB 3330
  299. 3080 RETURN
  300. 3090 '
  301. 3100 '   Subroutine to change other donations
  302. 3110 '
  303. 3120 CLS: PRINT "Old Other Donations Made"
  304. 3130 FOR X = 1 TO CVI(Q2F$)
  305. 3140   PRINT "   ";
  306. 3150   PRINT USING "$$##.##"; CVS(ODF$(X)),
  307. 3160   PRINT " *** "; FDOD$(X)
  308. 3170 NEXT X
  309. 3180 PRINT: PRINT "Old Number of Times Other Donations Made: "; CVI(Q2F$)
  310. 3190 LINE INPUT "Enter New Number of Times Other Donations Made: ", Q2$
  311. 3200 FOR X = 1 TO VAL(Q2$)
  312. 3210   PRINT: LINE INPUT "Enter New Dues Paid: ", OD$(X)
  313. 3220   LINE INPUT "Enter Date New Dues Paid: ", DOD$(X)
  314. 3230 NEXT X
  315. 3240 LSET Q2F$ = MKI$(VAL(Q2$))
  316. 3250 FOR X = 1 TO VAL(Q2$)
  317. 3260   RSET ODF$(X) = MKS$(VAL(OD$(X)))
  318. 3270   LSET FDOD$(X) = DOD$(X)
  319. 3280 NEXT X
  320. 3290 RETURN
  321. 3300 '
  322. 3310 '   Sub-subroutine to delete extra `old' dues from edited record
  323. 3320 '
  324. 3330 FOR X = VAL(Q1$) + 1 TO 3
  325. 3340   D$(X) = ""
  326. 3350   LSET DF$(X) = MKS$(VAL(D$(X)))
  327. 3360   DA$(X) = ""
  328. 3370   LSET DAF$(X) = DA$(X)
  329. 3380 NEXT X
  330. 3390 RETURN
  331. D$(X) = ""
  332. 3350   LSET DF$(X) = MKS$(VAL(D$(X)))
  333. 3360   DA$(X) = ""
  334. 3370   LSET DAF$(X) = DA$(