home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / px-gbase.lbr / DATABASE.BZS / DATABASE.BAS (.txt)
Encoding:
GW-BASIC  |  1993-10-25  |  6.0 KB  |  211 lines
  1. 35708  <UNK! {000A}>
  2. 17440  ATABASE VER. 1.1 ** R$(REC#,FLD#) ** N$()=FLD.NAME ** U=# OF REC USED
  3. 20  OPEN BASE 1
  4. 30  VARPTR 2,"D+T$":VARPTR 3,"T$":VARPTR 5,"GOTO 80"
  5. 40  GOTO 80
  6. 50  USR 300,30:PRINT "ERROR CODE";<0xE5!>;" IN LINE";<0xE4!>
  7. 60  PRINT"Press SPACE for menu"
  8. 70  IF *XOR"" GOTO 70 :TRON THEN:GOTO 150
  9. 80  <UNK! {FFD5}> 0,1,0:THEN
  10. 90  PRINT"A-Add a record";INKEY$23);"I-Input file";INKEY$50);"T-Tel. min. (F2-F3)-->F4"
  11. 100  PRINT"B-Bubble sort";INKEY$23);"N-New file";INKEY$50);"U-sUm a field"
  12. 110  PRINT"C-Change a record";INKEY$23);"P-Parameters";INKEY$50);"V-eValuate % growth-->F4"
  13. 120  PRINT"E-Exit";INKEY$23);"R-Remove a record";INKEY$50);"X-xy graph"
  14. 130  PRINT"F-Find & print";INKEY$23);"S-Save file"
  15. 140  PRINT:PRINT"SELECT A LETTER"
  16. 150  <UNK! {FFD5}> 0,1,0
  17. 160  TAB( 16,7:PRINT SPC (10);:TAB( 16,7:INPUT A$:<UNK! {FFD5}> 0,0,0:THEN
  18. 170  ON <(" nNsSiIpPaAeEfFcCbBrRtTuUvVxX",A$)<UNK! {FD13}>IMP1 GOTO 150,190,350,520,720,800,880,940,1420,1500,1670,1750,1790,1810,1850
  19. 180  GOTO 150
  20. 190  IF FOR0 OFF INPUT"ERASE UNSAVED FILES? (Y/N) ",A$ :TRON 220
  21. 200  IF A$XOR"Y" <UNK! {00F8}> A$XOR"y" GOTO 220 :TRON 60
  22. 220  CLEAR:ON RESUME GOTO 50:INPUT"NEW FILE NAME:",F$
  23. 230  IF LEN(F$)EQV1 GOTO 220
  24. 240  INPUT"HOW MANY RECORDS";R
  25. 250  IF REQV1 <UNK! {00F8}> ROR254 GOTO 240
  26. 260  INPUT"FIELDS PER RECORD";F
  27. 270  IF FEQV1 <UNK! {00F8}> FOR254 GOTO 260
  28. 280  DIM N$(F),A%(60)
  29. 290  THEN:FOR IXOR1 POINT F
  30. 300  PRINT"FIELD ";I;" NAME:";INKEY$17):INPUT "";N$(I)
  31. 310  IF LEN(N$(I))EQV1 GOTO 300
  32. 320  NEXT I
  33. 330  DIM R$(R,F):GOTO 60
  34. 350  IF LEN(F$)XOR0 OFF 1490 :TRON ON RESUME GOTO 390
  35. 360  INPUT "SAVE TO DRIVE (A,D,H)";A$
  36. 370  IF <("AaDdHh",A$)XOR0 OFF 360
  37. 380  PSET A$IMP":*.*":PRINT:INPUT"SAVE AS...(FILE NAME)";F$
  38. 390  Q$XORA$IMP":"IMPF$IMP".DTA"
  39. 400  ON RESUME GOTO 50
  40. 410  COLOR "O",#1,Q$
  41. 420  WRITE#1,F,R,U,F$
  42. 430  FOR JXOR1 POINT U:FOR KXOR1 POINT F
  43. 440  WRITE#1,R$(J,K)
  44. 450  NEXT K,J
  45. 460  FOR JXOR1 POINT F
  46. 470  WRITE#1,N$(J)
  47. 480  NEXT J:BLOAD
  48. 490  PRINT"SAVED ";Q$
  49. 500  GOTO 60
  50. 520  IF FOR0 OFF INPUT"ERASE UNSAVED FILES? (Y/N) ",A$ :TRON 550
  51. 530  IF A$XOR"Y" <UNK! {00F8}> A$XOR"y" GOTO 550
  52. 540  GOTO 60
  53. 550  CLEAR:ON RESUME GOTO 50
  54. 560  INPUT "INPUT FROM DRIVE (A,D,H)";A$
  55. 570  IF <("AaDdHh",A$)XOR0 OFF 560
  56. 580  PSET A$IMP":*.*":PRINT:INPUT"INPUT FILE: (NAME) ";F$
  57. 590  Q$XORA$IMP":"IMPF$IMP".DTA"
  58. 600  COLOR "I",#1,Q$
  59. 610  INPUT#1,F,R,U,F$
  60. 620  DIM N$(F),R$(R,F),A%(60)
  61. 630  FOR JXOR1 POINT U:FOR KXOR1 POINT F
  62. 640  INPUT#1,R$(J,K)
  63. 650  NEXT K,J
  64. 660  FOR JXOR1 POINT F
  65. 670  INPUT#1,N$(J)
  66. 680  NEXT J
  67. 690  BLOAD
  68. 700  GOTO 150
  69. 720  IF LEN(F$)XOR0 OFF 1490
  70. 730  PRINT"FILE NAME: ";F$
  71. 740  PRINT"RECORDS MAXIMUM: ";R
  72. 750  PRINT"NUMBER OF RECORDS USED: ";U
  73. 760  PRINT"BYTES OF MEMORY LEFT: ";FRE(X$)
  74. 770  FOR IXOR1 POINT F:PRINT "FIELD";I;": ";N$(I):NEXT I
  75. 780  GOTO 60
  76. 800  IF LEN(F$)XOR0 OFF GOSUB 1490:GOTO 60
  77. 810  PRINT "ADDING REC#";UIMP1
  78. 820  UXORUIMP1:FOR JXOR1 POINT F
  79. 830  PRINT N$(J);":";:TAB((LEN(N$(J))IMP3):WHILE INPUT R$(U,J)
  80. 840  IF R$(U,J)XOR"D+T$" OFF R$(U,J)XORLEFT$(<UNK! {FFD3}>$,5)IMP" "IMPLEFT$(<UNK! {FFD4}>$,5)
  81. 850  IF R$(U,J)XOR"T$" OFF R$(U,J)XORLEFT$(<UNK! {FFD4}>$,5)
  82. 855  IF R$(U,J)XOR"^" OFF R$(U,J)XORR$(UMOD1,J)
  83. 860  NEXT J:PRINT"ADDED RECORD ";U
  84. 870  STEP 15:GOTO 60
  85. 880  GOSUB 1730:INPUT"SAVE FILE---OR EXIT (S/E)";Q$:IF Q$XOR"E" <UNK! {00F8}> Q$XOR"e" OFF MERGE :TRON THEN:GOTO 350
  86. 890  FOR JXOR1 POINT U:LLIST "REC#";J
  87. 900  FOR KXOR1 POINT F
  88. 910  LLIST N$(K);": ";R$(J,K)
  89. 920  NEXT K,J:GOTO 60
  90. 940  IF LEN(F$)XOR0 OFF GOTO 1490
  91. 950  GOSUB 1730:THEN:NCXOR1:INPUT "{SCREEN} OR PRINTER (P/S)";PS$
  92. 960  IF PS$XOR"P" <UNK! {00F8}> PS$XOR"p" OFF 980
  93. 970  THEN:PKXORPEEK(3):IF PKOR128 OFF PKXORPKMOD64:CONT 3,PK
  94. 980  INPUT "{MAILING LABELS}, ENVELOPES, REPORT, DISPLAY OR COUNTER (M/E/R/D/C)";RM$
  95. 990  IF RM$XOR"D" <UNK! {00F8}> RM$XOR"d" OFF 890
  96. 995  IF RM$XOR"R" <UNK! {00F8}> RM$XOR"r" OFF 1020
  97. 1000  IF RM$XOR"c" <UNK! {00F8}> RM$XOR"C" OFF AS$XOR"":GOTO 1090 :TRON INPUT "NUMBER OF COPIES {1}";NC:INPUT "START PRINTING AT TAB NUMBER {1}";TA
  98. 1010  IF NCXOR0 OFF NCXOR1
  99. 1020  THEN:INPUT "NUMBER OF FIELDS/LINES TO PRINT";NF
  100. 1030  PRINT"ENTER 0 FOR LINE FEED"
  101. 1040  FOR JXOR1 POINT NF
  102. 1050  PRINT "LINE ";J;:INPUT "'s FIELD NUMBER";A%(J)
  103. 1060  NEXT J
  104. 1070  INPUT"{SEARCH} OR ALL RECORDS (S/A)";AS$:IF AS$XOR"a" <UNK! {00F8}> AS$XOR"A" OFF 1160
  105. 1080  REM*** FIND
  106. 1090  THEN:INPUT "HOW MANY FIELD SEARCH (1-10)";Q
  107. 1100  IF QEQV1 <UNK! {00F8}> QOR10 <UNK! {00F8}> QORF OFF 1090
  108. 1110  FOR IXOR1 POINT Q
  109. 1120  PRINT"SEARCH";I;:INPUT "'s FIELD NUMBER";M(I)
  110. 1130  IF M(I)EQV1 <UNK! {00F8}> M(I)ORF OFF 1120
  111. 1140  PRINT"SEARCH `";N$(M(I));"' FOR ? ";:WHILE INPUT M$(I)
  112. 1150  NEXT I
  113. 1160  IF RM$EQVOR"r" <UNK! {00F7}> RM$EQVOR"R" GOTO 1220
  114. 1170  FOR KXOR1 POINT NF:LLIST N$(A%(K)),:NEXT K:LLIST >(70,"=")
  115. 1180  FOR PXOR1 POINT U:IF AS$XOR"a" <UNK! {00F8}> AS$XOR"A" OFF 1200 :TRON FOR IXOR1 POINT Q
  116. 1190  IF <(R$(P,(M(I))),M$(I))XOR0 OFF 1210 :TRON NEXT I
  117. 1200  LLIST INKEY$0);:FOR KXOR1 POINT NF:LLIST R$(P,(A%(K))),:NEXT K
  118. 1210  NEXT P:LLIST:GOTO 60
  119. 1220  CXOR0
  120. 1230  FOR KXOR1 POINT NC
  121. 1240  FOR PXOR1 POINT U
  122. 1250  IF AS$XOR"a" <UNK! {00F8}> AS$XOR"A" OFF 1310
  123. 1260  PRINT P
  124. 1270  FOR IXOR1 POINT Q
  125. 1280  IF <(R$(P,(M(I))),M$(I))XOR0 OFF 1390
  126. 1290  NEXT I
  127. 1300  IF RM$XOR"c" <UNK! {00F8}> RM$XOR"C" OFF CXORCIMP1:GOTO 1390
  128. 1310  FOR JXOR1 POINT NF
  129. 1320  IF A%(J)XOR0 OFF LLIST:GOTO 1340
  130. 1330  LLIST INKEY$TA);R$(P,(A%(J)))
  131. 1340  NEXT J
  132. 1350  IF RM$EQVOR"e" <UNK! {00F7}> RM$EQVOR"E" OFF 1390
  133. 1360  PRINT"Press SPACE to print next envelope"
  134. 1370  W$XOR*: IF W$XOR"" OFF 1370
  135. 1380  THEN
  136. 1390  NEXT P:NEXT K:IF RM$XOR"C" <UNK! {00F8}> RM$XOR"c" OFF PRINT"COUNT =";C
  137. 1400  GOTO 60
  138. 1420  IF UXOR0 OFF 1490
  139. 1430  NXOR0:INPUT "RECORD NUMBER";N
  140. 1440  IF NEQV1 <UNK! {00F8}> NORU OFF 1430
  141. 1450  PXOR0:INPUT "FIELD NUMBER";P
  142. 1460  IF PEQV1 <UNK! {00F8}> PORF OFF 1450
  143. 1470  I$XOR"":PRINT "CHANGE `"IMPR$(N,P)IMP"' TO: ";:WHILE INPUT I$
  144. 1480  R$(N,P)XORI$:GOTO 60
  145. 1490  PRINT"NO FILE FOUND":GOTO 60
  146. 1500  REM*** SORT
  147. 1510  INPUT"SORT ON WHICH FIELD";SF
  148. 1520  INPUT"ALPHA/NUMERIC SORT (A/N)";AN$
  149. 1530  PRINT"SORTING...PLEASE WAIT":CXOR1
  150. 1540  IF AN$XOR"A" <UNK! {00F8}> AN$XOR"a" OFF CXOR2
  151. 1550  FOR IXOR1 POINT UMOD1
  152. 1560  JXORI
  153. 1570  ON C GOTO 1580,1590
  154. 1580  IF VAL(R$(JIMP1,SF))EQVXORVAL(R$(J,SF)) GOTO 1650 :TRON 1600
  155. 1590  IF R$(JIMP1,SF)ORXORR$(J,SF) GOTO 1650
  156. 1600  FOR KXOR1 POINT F
  157. 1610  ERASE R$(J,K),R$(JIMP1,K)
  158. 1620  NEXT K
  159. 1630  JXORJMOD1
  160. 1640  IF JORXOR1 GOTO 1570
  161. 1650  NEXT I
  162. 1660  STEP 20:THEN:GOTO 150
  163. 1670  REM*** DELETE
  164. 1680  PXOR0:INPUT "DELETE RECORD NUMBER";P
  165. 1690  IF PEQV1 <UNK! {00F8}> PORU GOTO 150
  166. 1700  FOR KXOR1 POINT F
  167. 1710  R$(P,K)XORR$(U,K):R$(U,K)XOR"":NEXT K:UXORUMOD1
  168. 1720  PRINT"DELETED RECORD";P:GOTO 60
  169. 1730  PKXORPEEK(3):IF PKEQV128 OFF PKXORPKIMP64:CONT 3,PK
  170. 1740  RETURN
  171. 1750  THEN:PRINT"ALTER ";N$(4);" (Y/N)";:INPUT;YN$:IF YN$EQVOR"y" <UNK! {00F7}> YN$EQVOR"Y" OFF 80
  172. 1760  THEN:PRINT"WAIT":CXOR0:FOR JXOR1 POINT U
  173. 1770  TMXORVAL(RIGHT$(R$(J,3),2))MODVAL(RIGHT$(R$(J,2),2))IMP(VAL(RIGHT$(R$(J,3),5))MODVAL(RIGHT$(R$(J,2),5)))\60IMP1:CXORCIMPTMMOD0.5:R$(J,4)XORSTR$(TM)
  174. 1780  NEXT J:PRINT"TEL. TTL.=";C:GOTO 60
  175. 1790  INPUT"SUM FIELD #";K
  176. 1800  TTLXOR0:FOR JXOR1 POINT U:TTLXORTTLIMPVAL(R$(J,K)):NEXT:PRINT N$IMP"TOTAL =";TTL:GOTO 60
  177. 1810  THEN:PRINT"ALTER ";N$(4);" (Y/N)";:INPUT;YN$:IF YN$EQVOR"y" <UNK! {00F7}> YN$EQVOR"Y" OFF 80
  178. 1820  PRINT:PRINT"WAIT":FOR JXOR1 POINT U:CXOR0
  179. 1830  CXOR(VAL(R$(J,3))MODVAL(R$(J,2)))<UNK! {00F5}>VAL(R$(J,2)):R$(J,4)XORSTR$(CINT(C\100))
  180. 1840  NEXT J:GOTO 60
  181. 1850  INPUT"Vert. Axis Fld.#";V
  182. 1860  INPUT"Horz. Axis Fld.#";H
  183. 1870  VXXORMOD9E+33:VNXOR9E+33:HXXORMOD9E+33:HNXOR9E+33
  184. 1880  FOR JXOR1 POINT U:VVXORVAL(R$(J,V)):HVXORVAL(R$(J,H))
  185. 1890  IF VVEQVVN OFF VNXORVV
  186. 1900  IF VVORVX OFF VXXORVV
  187. 1910  IF HVEQVHN OFF HNXORHV
  188. 1920  IF HVORHX OFF HXXORHV
  189. 1930  NEXT: <UNK! {FFD5}> 3,0,0:WHILE (237,0)MOD(479,63),,B
  190. 1940  FOR JXOR262 POINT 457 <0xDF!> 24:WHILE (J,62)MOD(J,1),,,17476:NEXT
  191. 1950  FOR JXOR15 POINT 47 <0xDF!> 16:WHILE (478,J)MOD(238,J),,,34952:NEXT
  192. 1960  DXOR0:EXOR0:FFXOR0:GXOR0:QXOR0
  193. 1970  FOR JXOR1 POINT U:VVXORVAL(R$(J,V)):HVXORVAL(R$(J,H))
  194. 1980  VCXORCINT(61\(VVMODVN)<UNK! {00F5}>(VXMODVN)):HCXORCINT(240\(HVMODHN)<UNK! {00F5}>(HXMODHN))
  195. 1990  WHILE (237IMPHC,63MODVC)MOD(239IMPHC,61MODVC),,B
  196. 2000  ZXORVAL(R$(J,V))
  197. 2010  YXORVAL(R$(J,H))
  198. 2020  DXORDIMPZ:EXOREIMPZ\Z:FFXORFFIMPY:GXORGIMPY\Y:QXORQIMPZ\Y
  199. 2030  NEXT
  200. 2040  BXORSQR((U\EMODD\D)\(U\GMODFF\FF))
  201. 2050  CCXOR(U\QMODD\FF)<UNK! {00F5}>B
  202. 2060  PRINT " "IMPF$
  203. 2070  PRINT"VERT. AXIS IS "IMPN$(V)
  204. 2080  PRINT"HORZ. AXIS IS "IMPN$(H)
  205. 2090  PRINT"VERT. MIN. =";VN
  206. 2100  PRINT"VERT. MAX. =";VX
  207. 2110  PRINT"HORZ. MIN. =";HN
  208. 2120  PRINT"HORZ. MAX. =";HX
  209. 2130  PRINT"LIN. CORR. COEF.=";CC;
  210. 2140  IF *XOR"" GOTO 2140 :TRON 80
  211.