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