home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / flix11.zip / FLIX.BAS next >
BASIC Source File  |  1990-09-22  |  34KB  |  779 lines
  1.  9 COLOR 14 , 1 
  2.  110  V1$="C:FLIX.DAT"'  Master File Name
  3.  112  V2$="C:FLIX.ISI"'  Key File Name
  4.  113  V3$="C:FLIX.MAP"'  Map File
  5.  120  PN$="C:FLIX"'  Program Name
  6.  130  T=16'  Total Number of Fields
  7.  135  KL%=32'  Key Length
  8.  11001 COLOR 14,1
  9.  15060 FL=32
  10.  15065 LOCATE 4,24:PRINT STRING$(FL,46):LOCATE 4,24
  11.  15070 TY$="A": HELP=400
  12.  15100 GOSUB 21000:HELP=999
  13.  15110 IF LEN(T$)=0 THEN 700:'RETURN TO MAIN IF NO INPUT
  14.  15200 K$=T$+STRING$(KL-LEN(T$),32):'PAD ENTRY & SET TO SEARCH KEY
  15.  301 DATA 32,23,3,A
  16.  302 DATA 4,23,4,N
  17.  303 DATA 3,36,4,A
  18.  304 DATA 16,23,5,A
  19.  305 DATA 28,27,8,A
  20.  306 DATA 28,27,9,A
  21.  307 DATA 28,27,12,A
  22.  308 DATA 28,27,13,A
  23.  309 DATA 28,27,15,A
  24.  310 DATA 3,27,16,N
  25.  310 DATA 3,27,16,N
  26.  311 DATA 7,48,16,A
  27.  312 DATA 7,23,17,N
  28.  313 DATA 7,36,17,N
  29.  314 DATA 32,23,18,A
  30.  315 DATA 31,24,19,A
  31.  316 DATA 3,24,20,N
  32.  380 'Read parameters
  33.  381 FOR X=1 TO T:READ FL(X),CX(X),CY(X),TY$(X):NEXT X
  34.  700 COLOR 14,1: LOCATE 1, 1
  35.  701  PRINT "                    Flix Video Cataloging Data Base"
  36.  702  PRINT "              ╔═════════════════════════════════════════╗"
  37.  703  PRINT "              ╠═════════════════════════════════════════╣"
  38.  704  PRINT "              ║ TITLE: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  39.  705  PRINT "              ║ YEAR:  ■■■■ RATING: ■■■                 ║"
  40.  706  PRINT "              ║ TYPE:  ■■■■■■■■■■■■■■■■                 ║"
  41.  707  PRINT "              ║                                         ║"
  42.  708  PRINT "              ║ ACTORS  -                               ║"
  43.  709  PRINT "              ║ ACTOR 1:   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  44.  710  PRINT "              ║ ACTOR 2:   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  45.  711  PRINT "              ║                                         ║"
  46.  712  PRINT "              ║ ACTRESSES -                             ║"
  47.  713  PRINT "              ║ ACTRESS 1: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  48.  714  PRINT "              ║ ACTRESS 2: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  49.  715  PRINT "              ║                                         ║"
  50.  716  PRINT "              ║ DIRECTOR:  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  51.  717  PRINT "              ║ MINUTES:   ■■■  CATALOG NUMBER: ■■■■■■■ ║"
  52.  718  PRINT "              ║ FROM:  ■■■■■■■  TO: ■■■■■■■             ║"
  53.  719  PRINT "              ║ MAKER: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  54.  720  PRINT "              ║ AWARDS: ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ ║"
  55.  721  PRINT "              ║ NUMBER: ■■■                             ║"
  56.  722  PRINT "              ╚═════════════════════════════════════════╝"
  57.  4004 COLOR 15,4:LOCATE 25, 1: PRINT " indicates a field overflow.        Press F1 for help.          "; : LOCATE 25, 65: PRINT USING "##,###"; NKA; : PRINT " Records"; : LOCATE 1, 1:COLOR 14 ,1
  58.  4103 LOCATE BY,BX:PRINT ;BLANK$;:LOCATE BY,BX:PRINT "Enter the < Key to back up a Field";
  59.  4108 'Field No. 1 / TITLE / Length: 32 / Type: Alphanumeric
  60.  4123 LOCATE 4,24
  61.  4128 FL=32
  62.  4133 TY$="A"
  63.  4134 Color 7,1
  64.  4135 HELP=1
  65.  4138 T$=FIELDBUFFER$(1):GOSUB 22000:HELP=999
  66.  4143 IF LEN(T$)=0 THEN BADKEY=2:GOSUB 65100:GOTO 4108 
  67.  4145 IF ASC(T$)=8 THEN 700
  68.  4149 F$(1)=T$
  69.  4153 '
  70.  4154 F$(1) = F$(1)+STRING$(32-LEN(F$(1)),32)
  71.  4155 LOCATE 4,24:PRINT F$(1);
  72.  4161 IF F$(1)<>"" THEN K$=F$(1) ELSE GOTO 700
  73.  4163 COLOR 14,1
  74.  4208 'Field No. 2 / YEAR / Length: 4 / Type: Numeric
  75.  4223 LOCATE 5,24
  76.  4228 FL=4
  77.  4233 TY$="N"
  78.  4234 Color 14,1
  79.  4235 HELP=2
  80.  4238 T$=FIELDBUFFER$(2):GOSUB 22000:HELP=999
  81.  4243 IF LEN(T$)=0 THEN 4253
  82.  4245 IF ASC(T$)=8 THEN LOCATE 5,24:PRINT FIELDBUFFER$(2);: GOTO 4108 
  83.  4249 F$(2)=T$
  84.  4246 GOSUB 23000
  85.  4247 IF N=0 THEN GOTO 4208 
  86.  4250  RV#=VAL(T$):DL=0:ML=4:GOSUB 65200:F$(2)=RX$:F#(2)=VAL(RX$)
  87.  4253 IF LEFT$(F$(2),1)=CHR$(4) THEN LOCATE 5,24:PRINT F$(2);:GOTO 4263 
  88.  4262  LOCATE 5,24:PRINT USING  "####";VAL(F$(2));
  89.  4263 COLOR 14,1
  90.  4308 'Field No. 3 / RATING / Length: 3 / Type: Alphanumeric
  91.  4323 LOCATE 5,37
  92.  4328 FL=3
  93.  4333 TY$="A"
  94.  4334 Color 14,1
  95.  4335 HELP=3
  96.  4338 T$=FIELDBUFFER$(3):GOSUB 22000:HELP=999
  97.  4343 IF LEN(T$)=0 THEN 4353
  98.  4345 IF ASC(T$)=8 THEN LOCATE 5,37:PRINT FIELDBUFFER$(3);: GOTO 4208 
  99.  4349 F$(3)=T$
  100.  4353 '
  101.  4354 F$(3) = F$(3)+STRING$(3-LEN(F$(3)),32)
  102.  4355 LOCATE 5,37:PRINT F$(3);
  103.  4363 COLOR 14,1
  104.  4408 'Field No. 4 / TYPE / Length: 16 / Type: Alphanumeric
  105.  4423 LOCATE 6,24
  106.  4428 FL=16
  107.  4433 TY$="A"
  108.  4434 Color 14,1
  109.  4435 HELP=4
  110.  4438 T$=FIELDBUFFER$(4):GOSUB 22000:HELP=999
  111.  4443 IF LEN(T$)=0 THEN 4453
  112.  4445 IF ASC(T$)=8 THEN LOCATE 6,24:PRINT FIELDBUFFER$(4);: GOTO 4308 
  113.  4449 F$(4)=T$
  114.  4453 '
  115.  4454 F$(4) = F$(4)+STRING$(16-LEN(F$(4)),32)
  116.  4455 LOCATE 6,24:PRINT F$(4);
  117.  4463 COLOR 14,1
  118.  4508 'Field No. 5 / ACTOR1 / Length: 28 / Type: Alphanumeric
  119.  4523 LOCATE 9,28
  120.  4528 FL=28
  121.  4533 TY$="A"
  122.  4534 Color 14,1
  123.  4535 HELP=5
  124.  4538 T$=FIELDBUFFER$(5):GOSUB 22000:HELP=999
  125.  4543 IF LEN(T$)=0 THEN 4553
  126.  4545 IF ASC(T$)=8 THEN LOCATE 9,28:PRINT FIELDBUFFER$(5);: GOTO 4408 
  127.  4549 F$(5)=T$
  128.  4553 '
  129.  4554 F$(5) = F$(5)+STRING$(28-LEN(F$(5)),32)
  130.  4555 LOCATE 9,28:PRINT F$(5);
  131.  4563 COLOR 14,1
  132.  4608 'Field No. 6 / ACTOR2 / Length: 28 / Type: Alphanumeric
  133.  4623 LOCATE 10,28
  134.  4628 FL=28
  135.  4633 TY$="A"
  136.  4634 Color 14,1
  137.  4635 HELP=6
  138.  4638 T$=FIELDBUFFER$(6):GOSUB 22000:HELP=999
  139.  4643 IF LEN(T$)=0 THEN 4653
  140.  4645 IF ASC(T$)=8 THEN LOCATE 10,28:PRINT FIELDBUFFER$(6);: GOTO 4508 
  141.  4649 F$(6)=T$
  142.  4653 '
  143.  4654 F$(6) = F$(6)+STRING$(28-LEN(F$(6)),32)
  144.  4655 LOCATE 10,28:PRINT F$(6);
  145.  4663 COLOR 14,1
  146.  4708 'Field No. 7 / ACTRESS1 / Length: 28 / Type: Alphanumeric
  147.  4723 LOCATE 13,28
  148.  4728 FL=28
  149.  4733 TY$="A"
  150.  4734 Color 14,1
  151.  4735 HELP=7
  152.  4738 T$=FIELDBUFFER$(7):GOSUB 22000:HELP=999
  153.  4743 IF LEN(T$)=0 THEN 4753
  154.  4745 IF ASC(T$)=8 THEN LOCATE 13,28:PRINT FIELDBUFFER$(7);: GOTO 4608 
  155.  4749 F$(7)=T$
  156.  4753 '
  157.  4754 F$(7) = F$(7)+STRING$(28-LEN(F$(7)),32)
  158.  4755 LOCATE 13,28:PRINT F$(7);
  159.  4763 COLOR 14,1
  160.  4808 'Field No. 8 / ACTRESS2 / Length: 28 / Type: Alphanumeric
  161.  4823 LOCATE 14,28
  162.  4828 FL=28
  163.  4833 TY$="A"
  164.  4834 Color 14,1
  165.  4835 HELP=8
  166.  4838 T$=FIELDBUFFER$(8):GOSUB 22000:HELP=999
  167.  4843 IF LEN(T$)=0 THEN 4853
  168.  4845 IF ASC(T$)=8 THEN LOCATE 14,28:PRINT FIELDBUFFER$(8);: GOTO 4708 
  169.  4849 F$(8)=T$
  170.  4853 '
  171.  4854 F$(8) = F$(8)+STRING$(28-LEN(F$(8)),32)
  172.  4855 LOCATE 14,28:PRINT F$(8);
  173.  4863 COLOR 14,1
  174.  4908 'Field No. 9 / DIRECTOR / Length: 28 / Type: Alphanumeric
  175.  4923 LOCATE 16,28
  176.  4928 FL=28
  177.  4933 TY$="A"
  178.  4934 Color 14,1
  179.  4935 HELP=9
  180.  4938 T$=FIELDBUFFER$(9):GOSUB 22000:HELP=999
  181.  4943 IF LEN(T$)=0 THEN 4953
  182.  4945 IF ASC(T$)=8 THEN LOCATE 16,28:PRINT FIELDBUFFER$(9);: GOTO 4808 
  183.  4949 F$(9)=T$
  184.  4953 '
  185.  4954 F$(9) = F$(9)+STRING$(28-LEN(F$(9)),32)
  186.  4955 LOCATE 16,28:PRINT F$(9);
  187.  4963 COLOR 14,1
  188.  5008 'Field No. 10 / MINUTES / Length: 3 / Type: Numeric
  189.  5023 LOCATE 17,28
  190.  5028 FL=3
  191.  5033 TY$="N"
  192.  5034 Color 14,1
  193.  5035 HELP=10
  194.  5038 T$=FIELDBUFFER$(10):GOSUB 22000:HELP=999
  195.  5043 IF LEN(T$)=0 THEN 5053
  196.  5045 IF ASC(T$)=8 THEN LOCATE 17,28:PRINT FIELDBUFFER$(10);: GOTO 4908 
  197.  5049 F$(10)=T$
  198.  5046 GOSUB 23000
  199.  5047 IF N=0 THEN GOTO 5008 
  200.  5050  RV#=VAL(T$):DL=0:ML=3:GOSUB 65200:F$(10)=RX$:F#(10)=VAL(RX$)
  201.  5053 IF LEFT$(F$(10),1)=CHR$(4) THEN LOCATE 17,28:PRINT F$(10);:GOTO 5063 
  202.  5062  LOCATE 17,28:PRINT USING  "###";VAL(F$(10));
  203.  5063 COLOR 14,1
  204.  5108 'Field No. 11 / CATALOG# / Length: 7 / Type: Alphanumeric
  205.  5123 LOCATE 17,49
  206.  5128 FL=7
  207.  5133 TY$="A"
  208.  5134 Color 14,1
  209.  5135 HELP=11
  210.  5138 T$=FIELDBUFFER$(11):GOSUB 22000:HELP=999
  211.  5143 IF LEN(T$)=0 THEN 5153
  212.  5145 IF ASC(T$)=8 THEN LOCATE 17,49:PRINT FIELDBUFFER$(11);: GOTO 5008 
  213.  5149 F$(11)=T$
  214.  5153 '
  215.  5154 F$(11) = F$(11)+STRING$(7-LEN(F$(11)),32)
  216.  5155 LOCATE 17,49:PRINT F$(11);
  217.  5163 COLOR 14,1
  218.  5208 'Field No. 12 / FROM / Length: 7 / Type: Numeric
  219.  5223 LOCATE 18,24
  220.  5228 FL=7
  221.  5233 TY$="N"
  222.  5234 Color 14,1
  223.  5235 HELP=12
  224.  5238 T$=FIELDBUFFER$(12):GOSUB 22000:HELP=999
  225.  5243 IF LEN(T$)=0 THEN 5253
  226.  5245 IF ASC(T$)=8 THEN LOCATE 18,24:PRINT FIELDBUFFER$(12);: GOTO 5108 
  227.  5249 F$(12)=T$
  228.  5246 GOSUB 23000
  229.  5247 IF N=0 THEN GOTO 5208 
  230.  5250  RV#=VAL(T$):DL=0:ML=7:GOSUB 65200:F$(12)=RX$:F#(12)=VAL(RX$)
  231.  5253 IF LEFT$(F$(12),1)=CHR$(4) THEN LOCATE 18,24:PRINT F$(12);:GOTO 5263 
  232.  5262  LOCATE 18,24:PRINT USING  "#######";VAL(F$(12));
  233.  5263 COLOR 14,1
  234.  5308 'Field No. 13 / TO / Length: 7 / Type: Numeric
  235.  5323 LOCATE 18,37
  236.  5328 FL=7
  237.  5333 TY$="N"
  238.  5334 Color 14,1
  239.  5335 HELP=13
  240.  5338 T$=FIELDBUFFER$(13):GOSUB 22000:HELP=999
  241.  5343 IF LEN(T$)=0 THEN 5353
  242.  5345 IF ASC(T$)=8 THEN LOCATE 18,37:PRINT FIELDBUFFER$(13);: GOTO 5208 
  243.  5349 F$(13)=T$
  244.  5346 GOSUB 23000
  245.  5347 IF N=0 THEN GOTO 5308 
  246.  5350  RV#=VAL(T$):DL=0:ML=7:GOSUB 65200:F$(13)=RX$:F#(13)=VAL(RX$)
  247.  5353 IF LEFT$(F$(13),1)=CHR$(4) THEN LOCATE 18,37:PRINT F$(13);:GOTO 5363 
  248.  5362  LOCATE 18,37:PRINT USING  "#######";VAL(F$(13));
  249.  5363 COLOR 14,1
  250.  5408 'Field No. 14 / MAKER / Length: 32 / Type: Alphanumeric
  251.  5423 LOCATE 19,24
  252.  5428 FL=32
  253.  5433 TY$="A"
  254.  5434 Color 14,1
  255.  5435 HELP=14
  256.  5438 T$=FIELDBUFFER$(14):GOSUB 22000:HELP=999
  257.  5443 IF LEN(T$)=0 THEN 5453
  258.  5445 IF ASC(T$)=8 THEN LOCATE 19,24:PRINT FIELDBUFFER$(14);: GOTO 5308 
  259.  5449 F$(14)=T$
  260.  5453 '
  261.  5454 F$(14) = F$(14)+STRING$(32-LEN(F$(14)),32)
  262.  5455 LOCATE 19,24:PRINT F$(14);
  263.  5463 COLOR 14,1
  264.  5508 'Field No. 15 / AWARDS / Length: 31 / Type: Alphanumeric
  265.  5523 LOCATE 20,25
  266.  5528 FL=31
  267.  5533 TY$="A"
  268.  5534 Color 14,1
  269.  5535 HELP=15
  270.  5538 T$=FIELDBUFFER$(15):GOSUB 22000:HELP=999
  271.  5543 IF LEN(T$)=0 THEN 5553
  272.  5545 IF ASC(T$)=8 THEN LOCATE 20,25:PRINT FIELDBUFFER$(15);: GOTO 5408 
  273.  5549 F$(15)=T$
  274.  5553 '
  275.  5554 F$(15) = F$(15)+STRING$(31-LEN(F$(15)),32)
  276.  5555 LOCATE 20,25:PRINT F$(15);
  277.  5563 COLOR 14,1
  278.  5608 'Field No. 16 / NUMBER / Length: 3 / Type: Numeric
  279.  5623 LOCATE 21,25
  280.  5628 FL=3
  281.  5633 TY$="N"
  282.  5634 Color 14,1
  283.  5635 HELP=16
  284.  5638 T$=FIELDBUFFER$(16):GOSUB 22000:HELP=999
  285.  5643 IF LEN(T$)=0 THEN 5653
  286.  5645 IF ASC(T$)=8 THEN LOCATE 21,25:PRINT FIELDBUFFER$(16);: GOTO 5508 
  287.  5649 F$(16)=T$
  288.  5646 GOSUB 23000
  289.  5647 IF N=0 THEN GOTO 5608 
  290.  5650  RV#=VAL(T$):DL=0:ML=3:GOSUB 65200:F$(16)=RX$:F#(16)=VAL(RX$)
  291.  5653 IF LEFT$(F$(16),1)=CHR$(4) THEN LOCATE 21,25:PRINT F$(16);:GOTO 5663 
  292.  5662  LOCATE 21,25:PRINT USING  "###";VAL(F$(16));
  293.  5663 COLOR 14,1
  294.  17002  F#(2) = VAL(F$(2))
  295.  17010  F#(10) = VAL(F$(10))
  296.  17012  F#(12) = VAL(F$(12))
  297.  17013  F#(13) = VAL(F$(13))
  298.  17016  F#(16) = VAL(F$(16))
  299.  17503 Color 7,1
  300.  17504 locate 4,24:print F$(1);
  301.  17506 COLOR 14,1
  302.  17507 locate 5,24:IF F$(2)=STRING$(FL(2),4) THEN PRINT F$(2); ELSE PRINT USING  "####";F#(2);
  303.  17509 COLOR 14,1
  304.  17510 locate 5,37:print F$(3);
  305.  17512 COLOR 14,1
  306.  17513 locate 6,24:print F$(4);
  307.  17515 COLOR 14,1
  308.  17516 locate 9,28:print F$(5);
  309.  17518 COLOR 14,1
  310.  17519 locate 10,28:print F$(6);
  311.  17521 COLOR 14,1
  312.  17522 locate 13,28:print F$(7);
  313.  17524 COLOR 14,1
  314.  17525 locate 14,28:print F$(8);
  315.  17527 COLOR 14,1
  316.  17528 locate 16,28:print F$(9);
  317.  17530 COLOR 14,1
  318.  17531 locate 17,28:IF F$(10)=STRING$(FL(10),4) THEN PRINT F$(10); ELSE PRINT USING  "###";F#(10);
  319.  17533 COLOR 14,1
  320.  17534 locate 17,49:print F$(11);
  321.  17536 COLOR 14,1
  322.  17537 locate 18,24:IF F$(12)=STRING$(FL(12),4) THEN PRINT F$(12); ELSE PRINT USING  "#######";F#(12);
  323.  17539 COLOR 14,1
  324.  17540 locate 18,37:IF F$(13)=STRING$(FL(13),4) THEN PRINT F$(13); ELSE PRINT USING  "#######";F#(13);
  325.  17542 COLOR 14,1
  326.  17543 locate 19,24:print F$(14);
  327.  17545 COLOR 14,1
  328.  17546 locate 20,25:print F$(15);
  329.  17548 COLOR 14,1
  330.  17549 locate 21,25:IF F$(16)=STRING$(FL(16),4) THEN PRINT F$(16); ELSE PRINT USING  "###";F#(16);
  331.  17551        COLOR 14 ,1
  332. 8 KEY OFF: KEY 1, CHR$(27)
  333. 10 CLEAR : DEFINT B-Z: DIM X, Y, Z: RESET
  334. 12 ON ERROR GOTO 53000: STARTUP = 1
  335. 15  HOME$ = CHR$(11)
  336. 16  BOTT$ = HOME$ + STRING$(0, 28) + STRING$(22, 31)
  337. 17  BLANK$ = STRING$(75, 32): BB$ = BOTT$ + BLANK$ + BOTT$
  338. 18  CL$ = CHR$(11) + CHR$(12) + CHR$(11)
  339. 19  RC = 28: DC = 31: RB$ = CHR$(32) + CHR$(29): SB$ = CHR$(219) + CHR$(29)
  340. 23  BS$ = CHR$(29) + "_" + CHR$(29): FF$ = CHR$(140): CR$ = "\│/─"
  341. 150 DIM F$(T), F#(T), CX(T), CY(T), FL(T), TY$(T), K(T), KL(T)
  342. 155 DIM FIELDBUFFER$(T)
  343. 200 'Field Parameters
  344. 382 'Calculate Record / Key Lengths
  345. 384  FOR X = 1 TO T
  346. 386   IF TY$(X) <> "Z" THEN RL% = RL% + FL(X)
  347. 388   IF K(X) = 1 THEN KL(X) = FL(X):     'KEY FIELDS
  348. 390  NEXT X
  349. 395 '
  350. 500 'Open Files
  351. 505 '
  352. 510 OPEN "R", 1, V1$, RL%: 'Open Master File
  353. 520 GOSUB 48105: 'Init BTREE
  354. 530 GOSUB 48140: 'Open BTREE
  355. 540 '
  356. 550 'Field Master File
  357. 551 '
  358. 555 BBT = 1: BUF = 0
  359. 560 FOR X = 1 TO T: IF TY$(X) = "Z" THEN 580 ELSE BUF = BUF + 1
  360. 565  IF FL(X) + BT(BBT) > 255 THEN BBT = BBT + 1
  361. 570  FIELD #1, BT(1) AS D$(1), BT(2) AS D$(2), BT(3) AS D$(3), BT(4) AS D$(4), BT(5) AS D$(5), BT(6) AS D$(6), BT(7) AS D$(7), FL(X) AS FIELDBUFFER$(BUF)
  362. 575  BT(BBT) = BT(BBT) + FL(X)
  363. 580 NEXT X
  364. 585 FIELD #1, BT(1) AS D$(1), BT(2) AS D$(2), BT(3) AS D$(3), BT(4) AS D$(4), BT(5) AS D$(5), BT(6) AS D$(6), BT(7) AS D$(7), BT(8) AS D$(8)
  365. 600 PRINT CL$;
  366. 699  '
  367. 4000 'Begin Main Program
  368. 4001 '
  369. 4002 UPDTE$ = "": IF STARTUP = 1 THEN HELP = 600: GOSUB 63000: HELP = 999: STARTUP = 0
  370. 4003 FOR X = 1 TO T: F$(X) = "": F#(X) = 0: LSET FIELDBUFFER$(X) = F$(X): NEXT X' Clear Fields
  371. 4005 PRINT BB$; "<A>dd Record, <G>et Record, <S>earch or <E>nd Program                           Copyright 1990, CBase Enterprises     Make A Choice ";
  372. 4010 TY$ = "A": FL = 1: HELP = 100: BK$ = " "
  373. 4015 GOSUB 21000: HELP = 999
  374. 4020  IF T$ = "A" OR T$ = "a" THEN 4100
  375. 4025  IF T$ = "G" OR T$ = "g" THEN UPDTE$ = "YES": GR = 0: GOTO 15000
  376. 4030  IF T$ = "E" OR T$ = "e" THEN 40000
  377. 4035  IF T$ = "S" OR T$ = "s" THEN 14000
  378. 4040 SOUND 1500, 1
  379. 4050 GOTO 4005
  380. 4051 '
  381. 4100 'Input Routines
  382. 4101 '
  383. 4103 PRINT BB$; "Press the " + CHR$(27) + " key at the beginning of a field to back up. Press F1 for help."; : BK$ = CHR$(254)
  384. 5000 '
  385. 11000 'Move F$(n) to FIELDBUFFER$(n)
  386. 11001 '
  387. 11002 WIK = 0: FOR X = 1 TO T: IF TY$(X) <> "Z" THEN WIK = WIK + 1: LSET FIELDBUFFER$(WIK) = F$(X)
  388. 11003 NEXT X: BK$ = " "
  389. 11008 'Check Update Flag
  390. 11009 IF UPDTE$ = "YES" THEN 13000
  391. 12000 '
  392. 12005 GOSUB 48210: GOSUB 48570
  393. 12010 LSET FR$ = R$: PUT 1, I: GOTO 700
  394. 12099 '
  395. 13000 'Update Current Record
  396. 13001 '
  397. 13010 IF PREVKEY$ = K$ THEN PUT 1, I: GOTO 700 'If key not changed, update DAT
  398. 13020 OLDREC = I 'Store record number to delete
  399. 13030 GOSUB 48210: GOSUB 48570 'Add new key
  400. 13040 PUT 1, I 'Add new data
  401. 13050 K$ = PREVKEY$: I = OLDREC 'Restore old key
  402. 13060 GOSUB 48360: GOSUB 48570 'Delete old key
  403. 13070 FOR X = 1 TO 8: LSET D$(X) = STRING$(255, 0): NEXT X
  404. 13080 PUT 1, OLDREC 'Overwrite old record
  405. 13090 GOTO 700 'Record deleted
  406. 13099 '
  407. 14000 'String Search
  408. 14001 '
  409. 14005 MATCH = 0: ST = 0: ZK = 1: UPDTE$ = "S"
  410. 14006 PRINT BB$; "Search for data in a <F>ield, <A>nywhere, or <R>etrieve all records? "; : TY$ = "A": FL = 1: HELP = 700: GOSUB 21000: HELP = 999
  411. 14007 IF T$ = "F" OR T$ = "f" THEN ST = 1 ELSE IF T$ = "A" OR T$ = "a" THEN ST = 2 ELSE IF T$ = "R" OR T$ = "r" THEN GOTO 14025 ELSE GOTO 14006
  412. 14008 IF ST = 2 THEN GOTO 14019 ELSE FC = 0
  413. 14009 PRINT BB$; "Press Enter to select the field to search in."; : TY$ = "A": FL = 1: HELP = 800: GOSUB 21000: HELP = 999
  414. 14010 PRINT BB$; "When you're at the field you want to search, type the search string."; : HELP = 850
  415. 14011 FC = FC + 1: IF FC > T THEN GOTO 700
  416. 14012 IF TY$(FC) = "Z" THEN GOTO 14011 ELSE LOCATE CY(FC) + 1, CX(FC) + 1: FL = FL(FC): TY$ = TY$(FC): GOSUB 21000
  417. 14013 IF T$ = "" THEN 14011 ELSE IF TY$(FC) <> "A" THEN GOSUB 23000
  418. 14014 IF TY$(FC) <> "A" AND N = 0 THEN PRINT BB$; "Field"; FC; "requires numeric input."; : FC = FC - 1: GOTO 14011
  419. 14015 SSEARCH$ = T$: RE = 0
  420. 14016 IF TY$(FC) = "N" THEN GOSUB 49500
  421. 14017 GOTO 14040
  422. 14019 PRINT BB$; "Search for what ? "; : TY$ = "A": FL = 30: HELP = 200: GOSUB 21000: HELP = 999: RE = 0
  423. 14020  IF T$ <> "" THEN SSEARCH$ = T$: GOTO 14040 ELSE GOTO 700
  424. 14025  RE = 1: ZK = 2
  425. 14030  SSEARCH$ = "": 'If RE is 1, retrieve all records
  426. 14040  FOR W = 1 TO LOF(1) / RL%: GET 1, W: FOUND = 0: IF RE THEN MATCH = MATCH + 1: GOTO 14060
  427. 14041   IF ST = 2 THEN 14050
  428. 14042   WIK = 0: FOR X = 1 TO T: IF TY$(X) <> "Z" THEN WIK = WIK + 1: F$(X) = FIELDBUFFER$(WIK)
  429. 14043   NEXT X
  430. 14044   IF TY$(FC) = "N" THEN ON SCH GOSUB 49100, 49200, 49300: GOTO 14056
  431. 14047   FOUND = INSTR(F$(FC), SSEARCH$): GOTO 14056
  432. 14050    FOR Y = 1 TO BBT: FOUND = FOUND + INSTR(D$(Y), SSEARCH$)
  433. 14055    NEXT Y
  434. 14056   IF FOUND = 0 THEN GOTO 14080 ELSE ZK = 2: MATCH = MATCH + 1
  435. 14060   IF D$(1) = STRING$(LEN(D$(1)), 0) THEN BLANK = -1: GOTO 14080 ELSE BLANK = 0: GOSUB 15390
  436. 14070   PRINT BB$; "<S> to stop search or any other key for more..."
  437. 14073   PRINT "This record is match number"; MATCH; "...";
  438. 14074   II$ = INPUT$(1)
  439. 14075   IF II$ = "S" OR II$ = "s" THEN GOTO 600
  440. 14080   IF BLANK AND RE = 1 THEN MATCH = MATCH - 1
  441. 14084  NEXT W
  442. 14085  FOUND = 0: LOCATE 1, 1
  443. 14090 GOTO 15350
  444. 15000 '
  445. 15300 ZK = 1: GOSUB 48310
  446. 15350 IF FOUND = 0 AND ZK = 1 THEN PRINT BB$; " --- Record Not Found ---"; : GOSUB 60000: GOTO 600
  447. 15355 IF FOUND = 0 AND ZK = 2 THEN PRINT BB$; " --- No More Records Found ---"; : GOSUB 60000: GOTO 600
  448. 15380 GET 1, I
  449. 15390 'Print Record
  450. 15395 WIK = 0: FOR X = 1 TO T: IF TY$(X) <> "Z" THEN WIK = WIK + 1: F$(X) = FIELDBUFFER$(WIK)
  451. 15396 NEXT X
  452. 15400 PREVKEY$ = K$ 'Key indicator in case user wants to <C>hange
  453. 18000 '
  454. 18200 IF UPDTE$ = "S" THEN RETURN 'Search? If yes, return
  455. 18500 GR = GR + 1: LOCATE 24, 1: PRINT "This record is match number"; GR; "...";
  456. 18505 LOCATE 23, 1: PRINT BLANK$; : LOCATE 23, 1: PRINT "<C>hange, <D>elete, <S>top or Enter to continue: ";
  457. 18510 FL = 1
  458. 18520 TY$ = "A": HELP = 300
  459. 18530 GOSUB 21000: HELP = 999
  460. 18540 IF T$ = "S" OR T$ = "s" THEN 700
  461. 18550 IF T$ = "C" OR T$ = "c" THEN 4100
  462. 18557 IF T$ = "D" OR T$ = "d" THEN 19000
  463. 18560 ZK = 2: I = LR: GOSUB 48320: GOTO 15350
  464. 18999 '
  465. 19000 'Delete Record
  466. 19001 PRINT BB$; "Are You Sure you want to DELETE (Y/N) ";
  467. 19002 FL = 1: GOSUB 21000: IF T$ = "N" OR T$ = "n" THEN SOUND 1500, 1: PRINT BB$; "--> Not      Deleted <--"; : GOSUB 60000: GOTO 700
  468. 19003 IF T$ <> "Y" AND T$ <> "y" THEN 19002
  469. 19004 PRINT BB$; "--> Deleted <--";
  470. 19005 GOSUB 48360: GOSUB 48570
  471. 19020 FOR ZT = 1 TO 8: LSET D$(ZT) = STRING$(255, 0): NEXT ZT
  472. 19030 PUT 1, I: GOTO 700
  473. 23000 'Number Validation
  474. 23005 F1 = 0: F2 = 0: N = 0
  475. 23010 FOR X = 1 TO LEN(T$)
  476. 23020 A = ASC(MID$(T$, X, 1))
  477. 23030 IF (A < 45 OR A > 57) AND A <> 32 THEN SOUND 1500, 1: GOTO 23100
  478. 23050 IF A = 46 THEN F1 = F1 + 1: IF F1 > 1 THEN SOUND 1500, 1: GOTO 23100
  479. 23060 IF A = 45 THEN F2 = F2 + 1: IF F2 > 1 THEN SOUND 1500, 1: GOTO 23100
  480. 23070 NEXT X
  481. 23080 IF INSTR(T$, "-") > 1 THEN SOUND 1500, 1: GOTO 23100
  482. 23090 N = 1
  483. 23100 RETURN
  484. 39999 'Exit
  485. 40000 PRINT BB$; "Do you really want to end? "; : Z2 = 1: HELP = 999: GOSUB 21000: IF T$ = "N" OR T$ = "n" THEN GOTO 4001 ELSE IF T$ <> "Y" AND T$ <> "y" THEN GOTO 40000
  486. 40010 COLOR 7, 0, 0: CLS : PRINT "You have exited your filing program"
  487. 40020 PRINT "and are now in MS-DOS at the system"
  488. 40030 PRINT "prompt."
  489. 40040 SYSTEM ' You may branch to another program from here
  490. 48005 GOSUB 48105: GOSUB 48140
  491. 48010 INPUT "D,P,I, OR A "; CH$:  IF CH$ = "A" THEN 48025
  492. 48015  IF CH$ = "I" THEN 48035
  493. 48020  IF CH$ = "P" THEN 48050
  494. 48025  IF CH$ = "A" THEN 48040
  495. 48030  IF CH$ = "D" THEN 48045
  496. 48035  INPUT K$: GOSUB 48310: GOTO 48010
  497. 48040 INPUT K$: GOSUB 48210: GOSUB 48570: GOTO 48010
  498. 48045 INPUT K$: GOSUB 48360: GOSUB 48570: GOTO 48010
  499. 48050 GOSUB 48505: GOTO 48010
  500. 48055 'B-TREE ROUTINES
  501. 48100 'INITALIZATION
  502. 48105 I = 0: LR = 0: LL = 0: NKT = 0: NKA = 0: W = 0: R = 0: F = 0: Z = 0: LW = 0: RW = 0: DIM STK(100)
  503. 48115 TKL% = KL% + 5: BUS = 1 'In-memory link disabled to save memory
  504. 48120 DIM A$(BUS)
  505. 48130 RETURN
  506. 48135 'OPEN INDEX FILES & INIT BUFFERS
  507. 48140  OPEN "R", 3, V3$, 56
  508. 48145  FIELD 3, 2 AS RT$, 2 AS NKT$, 2 AS NKA$, 50 AS FD$
  509. 48150 '
  510. 48155  OPEN "R", 2, V2$, TKL%
  511. 48160  FIELD 2, 2 AS LJ$, 2 AS LK$, KL% AS KS$, 1 AS DF$
  512. 48165  FIELD 2, TKL% AS AM$
  513. 48170 '
  514. 48175  IF LOF(2) / TKL% > BUS THEN BUI = BUS ELSE BUI = LOF(2) / TKL%
  515. 48180  FOR X = 1 TO BUS: GET 2, X: A$(X) = AM$: NEXT X
  516. 48185  IF LOF(2) = 0 THEN KE = 1: GOTO 48205
  517. 48190 '
  518. 48195  GET 3, 1: R = CVI(RT$): NKT = CVI(NKT$): NKA = CVI(NKA$): KE = NKT + 1
  519. 48200 '
  520. 48205 RETURN
  521. 48210 'ADD RECORD
  522. 48220 I = R 'K$ contains key to look for
  523. 48230 IF I = 0 THEN LL = 0: LR = 0: GOTO 48270
  524. 48241 IF I <= BUS THEN LSET AM$ = A$(I) ELSE GET 2, I
  525. 48242 LL = CVI(LJ$): LR = CVI(LK$): KX$ = KS$
  526. 48243 IF K$ = KX$ THEN 48260
  527. 48244 IF K$ > KX$ THEN GOTO 48260
  528. 48250 IF LL <> 0 THEN I = LL: GOTO 48241
  529. 48255 LSET LJ$ = MKI$(KE): PUT 2, I: IF I <= BUS THEN A$(I) = AM$
  530. 48259 GOTO 48270
  531. 48260 IF LR <> 0 THEN I = LR: GOTO 48241
  532. 48265 LSET LK$ = MKI$(KE): PUT 2, I: IF I <= BUS THEN A$(I) = AM$
  533. 48270 LSET KS$ = K$: LSET LJ$ = MKI$(0): LSET LK$ = MKI$(0): LSET DF$ = "A"
  534. 48275 IF R = 0 THEN R = 1: KE = 1: NKA = 0: NKT = 0
  535. 48280 PUT 2, KE: I = KE: NKA = NKA + 1: NKT = NKT + 1: KE = KE + 1: IF KE - 1 <= BUS THEN A$(KE - 1) = AM$
  536. 48290 RETURN
  537. 48310 'B-TREE INQUIRY
  538. 48315 I = R
  539. 48320 IF I = 0 THEN 48355
  540. 48325 IF I <= BUS THEN LSET AM$ = A$(I) ELSE GET 2, I
  541. 48330 LL = CVI(LJ$): LR = CVI(LK$): KX$ = KS$: DLF$ = DF$
  542. 48335 IF K$ > KX$ THEN 48350
  543. 48340 IF K$ = KX$ AND DLF$ = "A" THEN FOUND = 1: RETURN
  544. 48341 IF K$ = KX$ AND DLF$ = "D" AND LR <> 0 THEN I = LR: GOTO 48325
  545. 48342 IF K$ = KX$ AND DLF$ = "D" THEN GOTO 48355
  546. 48345 IF LL <> 0 THEN I = LL: GOTO 48325 ELSE GOTO 48355
  547. 48350 IF LR <> 0 THEN I = LR: GOTO 48325
  548. 48355 FOUND = 0: RETURN
  549. 48360 'DELETE A RECORD
  550. 48365 CHK = I: 'RECORD # COMPARISON
  551. 48370 GET 3, 1: R = CVI(RT$): NKT = CVI(NKT$): NKA = CVI(NKA$)
  552. 48375 IF R = 0 THEN END
  553. 48380 '
  554. 48385 W = R: GC = 0: '  K$ IS KEY
  555. 48395 I = R: GOSUB 48490: PL = CVI(LJ$): PR = CVI(LK$): IF K$ <> KX$ THEN 48420
  556. 48396 GC = GC + 1: F = W: IF CHK <> I THEN S = 0: W = PR: GOTO 48420
  557. 48400 IF PR = 0 THEN R = PL: GOTO 48480
  558. 48405 IF PL = 0 THEN R = PR: GOTO 48480
  559. 48410 F = R: R = PR: S = 0
  560. 48415 IF W = 0 THEN PRINT "NOT FOUND": GOTO 48495
  561. 48420 I = W: GOSUB 48490: LW = CVI(LJ$): RW = CVI(LK$): IF K$ = KX$ THEN 48430
  562. 48425 F = W: IF K$ < KX$ THEN S = 1: W = LW: GOTO 48415 ELSE S = 0: W = RW: GOTO 48415
  563. 48430 GC = GC + 1: F = W: IF CHK <> I THEN S = 0: W = RW: GOTO 48415
  564. 48431 IF LW = 0 THEN 48455
  565. 48435 IF RW = 0 THEN 48470
  566. 48440 I = F: GOSUB 48490: IF S = 0 THEN LSET LK$ = MKI$(RW) ELSE LSET LJ$ = MKI$(RW)
  567. 48445 PUT 2, I: Z = RW: IF I <= BUS THEN A$(I) = AM$
  568. 48450 I = Z: GOSUB 48490: LZ = CVI(LJ$): IF LZ <> 0 THEN Z = LZ: GOTO 48450 ELSE LSET LJ$ = MKI$(LW): GOTO 48480
  569. 48455 IF RW = 0 THEN 48470
  570. 48460 I = F: GOSUB 48490: IF S = 0 THEN LSET LK$ = MKI$(RW) ELSE LSET LJ$ = MKI$(RW)
  571. 48465 GOTO 48480
  572. 48470 I = F: GOSUB 48490: IF S = 0 THEN LSET LK$ = MKI$(LW) ELSE LSET LJ$ = MKI$(LW)
  573. 48480 NKA = NKA - 1: PUT 2, I: GOSUB 48485: I = W: GOSUB 48490: LSET DF$ = "D": PUT 2, I: GOSUB 48485: GOSUB 48570: GOTO 48495
  574. 48485 IF I <= BUS THEN A$(I) = AM$: RETURN
  575. 48490 GET 2, I: KX$ = KS$: RETURN
  576. 48495   RETURN
  577. 48500 '
  578. 48505 '
  579. 48565 'WRITE MAP FILE
  580. 48570  LSET RT$ = MKI$(R): LSET NKT$ = MKI$(NKT): LSET NKA$ = MKI$(NKA): LSET D$ = V2$:    PUT 3, 1
  581. 48575  RETURN
  582. 49000 'Numeric comparisons
  583. 49100 IF VAL(F$(FC)) < VAL(SSEARCH$) THEN FOUND = 1 ELSE FOUND = 0
  584. 49110 RETURN
  585. 49200 IF VAL(F$(FC)) > VAL(SSEARCH$) THEN FOUND = 1 ELSE FOUND = 0
  586. 49210 RETURN
  587. 49300 IF VAL(F$(FC)) = VAL(SSEARCH$) THEN FOUND = 1 ELSE FOUND = 0
  588. 49310 RETURN
  589. 49499 'Choose Greater/Less than/Equal
  590. 49500 PRINT BB$; "Show if <G>reater than, <L>ess than or <E>qual to what you typed? -"; : FL = 1: HELP = 888: GOSUB 21000: IF T$ = "" THEN GOTO 700 ELSE T$ = CHR$(ASC(T$) AND 95)
  591. 49510 SCH = INSTR("LGE", T$): IF SCH = 0 THEN GOTO 49500 ELSE RETURN
  592. 49999 '
  593. 53000 'Error Traps
  594. 53001 IF ERR = 11 THEN ER = ERR: RESUME NEXT
  595. 53002 FOR ZX = 1 TO 3: SOUND 1000, 1: SOUND 25000, 1: NEXT ZX: COLOR 14, 4: PRINT BB$;
  596. 53003 IF ERR = 7 OR ERR = 14 THEN LOCATE 25, 1: PRINT " OUT OF MEMORY  (BASIC may not have been started with /S:2048)": END
  597. 53004 IF ERR <> 27 AND ERR <> 24 AND ERR <> 25 AND ERR <> 57 AND ERR <> 68 THEN 53009
  598. 53006 PRINT "Printer I/O Error. Abort or Retry?"; : Z$ = INPUT$(1): PRINT BB$;
  599. 53007 IF Z$ = "A" OR Z$ = "a" THEN PRINT "Operation aborted."; : GOTO 53050
  600. 53008 IF Z$ <> "R" AND Z$ <> "r" THEN 53006 ELSE PRINT "Retrying..."; : GOTO 53040
  601. 53009 IF ERR = 53 THEN PRINT "Your data file or a support file was not found at line"; ERL; ".": END
  602. 53010 IF ERR = 61 THEN PRINT "Disk full. No recovery possible. Program aborting.": END
  603. 53011 IF ERR = 4 THEN PRINT "Out of DATA. Probably errors in help subroutines.": END
  604. 53012 IF ERR = 6 THEN PRINT "Overflow error in line"; ERL; ". No recovery possible. Program aborting.": END
  605. 53013 IF ERR = 11 THEN PRINT "There is a division by zero in your computation in line"; ERL; ".": END
  606. 53014 IF ERR = 51 THEN PRINT "BASIC Interpreter Error. No recovery possible. Program aborting.": END
  607. 53015 IF ERR = 64 THEN PRINT "Illegal filename used in line"; ERL; ". No recovery possible. Program aborting.": END
  608. 53016 IF ERR = 67 THEN PRINT "Too many files open. Modify or add FILES line in CONFIG.SYS.": END
  609. 53017 IF ERR = 71 THEN PRINT "Disk not ready. Check drive door. Press ENTER to continue..."; : Z$ = INPUT$(1): GOTO 53040
  610. 53018 IF ERR = 72 THEN PRINT "Disk damaged. No recovery possible. Program aborting.": END
  611. 53019 IF ERR = 75 OR ERR = 76 THEN PRINT "Path not found. No recovery possible. Program aborting.": END
  612. 53020 PRINT "Filing program error"; ERR; "trapped at line"; ERL; ". Program aborting.": END
  613. 53040 RESUME
  614. 53050 ECode = -1: RESUME NEXT
  615. 55000 RUN
  616. 60000 '4 Second Delay
  617. 60010 COUNT# = TIMER
  618. 60020 IF INKEY$ = "" AND TIMER - COUNT# < 4 THEN 60020
  619. 60030 RETURN
  620. 60999 'DATA statements for user-defined help messages
  621. 63000 'Check monitor type
  622. 63010 BSV = &HB800
  623. 63020 DEF SEG = &H40: ZZZ = PEEK(&H87)
  624. 63030 IF ZZZ <> 0 THEN GOTO 63050
  625. 63040 ZZZ = PEEK(&H10): YYY = ZZZ AND 48: IF YYY = 48 THEN BSV = &HB000
  626. 63050 DEF SEG = BSV: BSAVE "$$$$$$$$.$$$", 1440, 960
  627. 63060 'Read until proper help block is found
  628. 63070 RESTORE 60999: CURSX = POS(0): CURSY = CSRLIN
  629. 63080 HLP = 0: NMLIN = 0
  630. 63090 READ HLP, NMLIN
  631. 63100 IF HLP = 999 OR HLP = HELP THEN COLOR 15, 1: GOTO 63120
  632. 63110 FOR TTT = 1 TO NMLIN: READ XXX$: NEXT TTT: GOTO 63090
  633. 63120 'Found it
  634. 63130 LOCATE 10, 15: PRINT CHR$(221); STRING$(52, CHR$(223)); CHR$(222); : LOCATE 15, 15: PRINT CHR$(221); STRING$(52, CHR$(220)); CHR$(222);
  635. 63140 FOR TTT = 11 TO 14: LOCATE TTT, 15: PRINT CHR$(221) + SPACE$(52) + CHR$(222); : NEXT TTT
  636. 63150 COLOR 14, 1: FOR TTT = 11 TO NMLIN + 10: READ XXX$: LOCATE TTT, 17: PRINT XXX$; : NEXT TTT
  637. 63160 COLOR 15, 1: LOCATE 14, 17, 0: PRINT "         (press any key to continue...)            ";
  638. 63165 IF HELP = 600 THEN GOSUB 65010
  639. 63170 IF INKEY$ = "" THEN GOTO 63170
  640. 63180 BLOAD "$$$$$$$$.$$$", 1440: KILL "$$$$$$$$.$$$": DEF SEG
  641. 63499 'Help DATA for program
  642. 63500 DATA 100,3
  643. 63510 DATA "Add - Create a record and add to the data file"
  644. 63520 DATA "Get - Find a record based on key field data"
  645. 63530 DATA "Search - Search by field, record or all records"
  646. 63540 DATA 200,3
  647. 63550 DATA "Enter a string to be searched for. The program"
  648. 63560 DATA "will search all fields in each record for this"
  649. 63570 DATA "string."
  650. 63580 DATA 300,3
  651. 63590 DATA "Change - Update the information in this record"
  652. 63600 DATA "Delete - Remove this record from your data file"
  653. 63610 DATA "REMEMBER -- RECORD DELETIONS ARE PERMANENT!"
  654. 63620 DATA 400,3
  655. 63630 DATA "The Get command searches for data in the key"
  656. 63640 DATA "field only. Enter the information to search for,"
  657. 63650 DATA "or press Enter to abort this function."
  658. 63690 DATA 600,3
  659. 63700 DATA "Technical Information On                          "
  660. 63710 DATA "##,### Records active, ##,### deleted.            "
  661. 63720 DATA "## fields occupy #,### bytes each.                "
  662. 63730 DATA 700,3
  663. 63740 DATA "F - Searches for data in a particular field only."
  664. 63750 DATA "A - Returns record if string appears in any field."
  665. 63760 DATA "R - Retrieves all records one at a time."
  666. 63810 DATA 800,3
  667. 63820 DATA "You chose to search for data in a particular field"
  668. 63830 DATA "in your record. You must indicate which field you"
  669. 63840 DATA "want to use. Press Return to begin the selection."
  670. 63850 DATA 850,3
  671. 63860 DATA "Press Return until the cursor is in the field you"
  672. 63870 DATA "you want to search. Type the search string then"
  673. 63880 DATA "press Enter again."
  674. 63881 DATA 860,3
  675. 63882 DATA "This is the key field. The number you typed will"
  676. 63883 DATA "not fit into this field's format. Key fields with"
  677. 63884 DATA "overflow values will not be accepted."
  678. 63885 DATA 862,2
  679. 63886 DATA "This is the key field. The key field cannot be"
  680. 63887 DATA "indexed if it is left blank. Please reenter it."
  681. 63890 DATA 888,3
  682. 63900 DATA "The field you're searching is a numeric field. You"
  683. 63910 DATA "can show records where this field is greater than,"
  684. 63920 DATA "less than or equal to the number you typed."
  685. 64000 DATA 999,2
  686. 64001 DATA "         No Help Available Here      "
  687. 64002 DATA "                                                 "
  688. 21000 'Keyboard Scan Routine
  689. 21001 '
  690. 21010 LOCATE , , 0: T$ = "": PY = CSRLIN: PX = POS(0): CSP = 0: PRINT STRING$(FL, 254); : LOCATE PY, PX
  691. 21020 A$ = INKEY$: IF A$ <> "" THEN 21045
  692. 21030 CSP = CSP + 1: IF CSP = 6 THEN CSP = 1
  693. 21040 PRINT MID$(CR$, CSP, 1); : LOCATE PY, PX: GOTO 21020
  694. 21045 IF LEN(A$) = FL OR LEN(A$) = 0 THEN BK$ = " " ELSE BK$ = CHR$(254)
  695. 21050 IF A$ = CHR$(27) THEN GOSUB 63000: GOTO 21020
  696. 21055 IF A$ = CHR$(20) THEN GOSUB 65000: GOTO 21020
  697. 21060 IF A$ = CHR$(8) AND LEN(T$) > 0 THEN PRINT BK$; : PX = PX - 1: LOCATE PY, PX: T$ = LEFT$(T$, LEN(T$) - 1): GOTO 21020 ELSE IF A$ = CHR$(8) THEN PRINT BK$; : T$ = A$: GOTO 21100
  698. 21070 IF A$ = CHR$(13) THEN PRINT " "; : GOTO 21100
  699. 21080 IF A$ < " " OR A$ > "~" THEN 21020
  700. 21090 IF LEN(T$) = FL THEN SOUND 1500, 1: GOTO 21020 ELSE T$ = T$ + A$: PRINT A$; : PX = PX + 1: GOTO 21020
  701. 21100 RETURN
  702. 65000 SHLP = HELP: HELP = 600: GOSUB 63000: HELP = SHLP: RETURN
  703. 65010 LOCATE 11, 42: PRINT PN$; ":";
  704. 65020 LOCATE 12, 17: PRINT USING "##,###"; NKA; : LOCATE 12, 40: PRINT USING "##,###"; NKT - NKA;
  705. 65030 LOCATE 13, 17: PRINT USING "##"; T; : LOCATE 13, 34: PRINT USING "#,###"; RL%;
  706. 65040 RETURN
  707. 65100 IF BADKEY = 2 THEN GOTO 65120
  708. 65110 H = HELP: HELP = 860: GOSUB 63000: GOTO 65130
  709. 65120 H = HELP: HELP = 862: GOSUB 63000
  710. 65130 HELP = H: RETURN
  711. 65200 'Rounding/Overflow/Formatting routine
  712. 65210 'Pass RV# with value to round, DL with decimal len, ML with max len
  713. 65220 'Return is in RX$
  714. 65230  IF DL = 0 THEN RV# = INT(RV#): WL = ML ELSE DI = 10 ^ DL: RV# = INT(RV# * DI + .5) / DI: WL = ML - DL - 1
  715. 65240  RX$ = STR$(RV#): IF RV# >= 0 THEN RX$ = MID$(RX$, 2)
  716. 65250  DI = INSTR(RX$, ".")
  717. 65260  IF DI = 0 THEN WH$ = RX$: DE$ = "" ELSE WH$ = LEFT$(RX$, DI - 1): DE$ = MID$(RX$, DI + 1)
  718. 65270  IF LEN(WH$) > WL THEN RX$ = STRING$(ML, 4): RETURN
  719. 65280  IF LEN(DE$) > DL THEN DE$ = LEFT$(DE$, DL)
  720. 65290  IF LEN(DE$) < DL THEN DE$ = DE$ + "0": GOTO 65290
  721. 65300  IF LEN(WH$) < WL THEN WH$ = " " + WH$: GOTO 65300
  722. 65310  RX$ = WH$: IF DL > 0 THEN RX$ = RX$ + "." + DE$
  723. 65320  IF LEN(RX$) > ML THEN RX$ = STRING$(ML, 4)
  724. 65330 RETURN
  725. 22000 'Preliminary input; see if changes will be made
  726. 22005 IF T$ = STRING$(FL, 32) THEN GOTO 21010
  727. 22010 LOCATE , , 0: PY = CSRLIN: PX = POS(0): CSP = 0: PRINT T$; : LOCATE PY, PX
  728. 22020 A$ = INKEY$: IF A$ <> "" THEN 22050
  729. 22030 CSP = CSP + 1: IF CSP = 6 THEN CSP = 1
  730. 22040 PRINT MID$(CR$, CSP, 1); : LOCATE PY, PX: GOTO 22020
  731. 22050 IF A$ = CHR$(13) THEN PRINT " "; : GOTO 21100
  732. 22060 T$ = "": PRINT STRING$(FL, 254); : LOCATE PY, PX: GOTO 21045
  733.  
  734.  63190 LOCATE CURSY, CURSX, 1:COLOR 14 , 1 : RETURN
  735.  61000 DATA 1 , 3 
  736.  61001 DATA "ENTER THE TITLE OF THE MOVIE.  THE FIELDS WITH    "
  737.  61002 DATA "HELP SCREENS ARE TYPE, ACTOR 1, ACTRESS 1, MINUTES"
  738.  61003 DATA "CATALOG NUMBER, FROM, TO, MAKER, AWARDS & NUMBER. "
  739.  61004 DATA 4 , 3 
  740.  61005 DATA "IN THIS FIELD, ENTER THE TYPE OF MOVIE, I.E.      "
  741.  61006 DATA "SCI-FI, HORROR, DRAMA, WESTERN, COMEDY, CARTOON,  "
  742.  61007 DATA "ETC.                                              "
  743.  61008 DATA 5 , 3 
  744.  61009 DATA "FLIX ALLOWS YOU TO ENTER IN TWO ACTORS FOR EACH   "
  745.  61010 DATA "MOVIE TITLE.  THIS ALLOWS YOU TO MAKE BETTER      "
  746.  61011 DATA "REPORTS FOR YOU RECORDS.                          "
  747.  61012 DATA 7 , 3 
  748.  61013 DATA "FLIX ALLOWS YOU TO ENTER TWO ACTRESSES PER MOVIE  "
  749.  61014 DATA "TITLE.  THIS ALLOWS YOU MORE EXTENSIVE REPORTING  "
  750.  61015 DATA "CAPABILITIES.                                     "
  751.  61016 DATA 10 , 3 
  752.  61017 DATA "ENTER THE NUMBER OF MINUTES THIS MOVIE TITLE TAKES"
  753.  61018 DATA "TO VIEW.  NORMALLY THIS FIGURE IS FOUND SOMWHERE  "
  754.  61019 DATA "ON THE MOVIE JACKET OR CASSETTE.                  "
  755.  61020 DATA 11 , 3 
  756.  61021 DATA "FLIX ALLOWS YOU TO ASSIGN YOUR OWN CATALOG NUMBER "
  757.  61022 DATA "TO EACH MOVIE TITLE.  IF YOU ALREADY HAVE A NUM-  "
  758.  61023 DATA "BER FOR YOUR MOVIES, ENTER THIS NUMBER.           "
  759.  61024 DATA 12 , 3 
  760.  61025 DATA "SOME VHS TAPES CAN RECORD MORE THAN ONE MOVIE PER "
  761.  61026 DATA "TAPE. ENTER THE COUNTER NUMBER WHERE THE VHS      "
  762.  61027 DATA "BEGINS RECORDING THE MOVIE.                       "
  763.  61028 DATA 13 , 3 
  764.  61029 DATA "ENTER THE COUNTER NUMBER WHERE YOUR VHS FINISHES  "
  765.  61030 DATA "RECORDING YOUR MOVIE.                             "
  766.  61031 DATA "                                                  "
  767.  61032 DATA 14 , 3 
  768.  61033 DATA "ENTER THE MAKER OF THE MOVIE, I.E., PARAMOUNT,    "
  769.  61034 DATA "MGM, TOUCHTONE, ETC.                              "
  770.  61035 DATA "                                                  "
  771.  61036 DATA 15 , 3 
  772.  61037 DATA "ENTER THE DIFFERENT AWARDS THIS MOVIE MIGHT HAVE  "
  773.  61038 DATA "WON, I.E., GRAMMY, TONY, OSCAR, ETC.              "
  774.  61039 DATA "                                                  "
  775.  61040 DATA 16 , 3 
  776.  61041 DATA "ENTER THE NUMBER OF AWARDS THIS MOIVE MIGHT HAVE  "
  777.  61042 DATA "WON.                                              "
  778.  61043 DATA "                                                  "
  779.