home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / PROGEN / PROSRC.ZIP / PIMLIB71.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-10-09  |  19.5 KB  |  785 lines
  1. DECLARE FUNCTION strval$ (a%)
  2. DECLARE SUB PIM (cmd$, indexnum%, key$, MastRec%, CurrentIndexREC%)
  3. DECLARE SUB PIMCreate (indexnum%, file$, keylength%, mfile$)
  4. DECLARE SUB PIMOpen (indexnum%, file$)
  5. DECLARE FUNCTION PIMstats% (indexnum%)
  6. DEFINT A-Z
  7. '    PIMLIB71.BAS
  8. '    TREE TYPE INDEX MAMAGER FOR QB45 AND USED IN PROGEN71.BAS
  9. '    NOT NEEDED FOR PROGRAMS GENERATED BY PROGEN71 (USE ISAM)
  10. '    WORKS GREAT FOR QB45 OR QBX. IF NEEDED I WILL SUPPLY
  11. '    PROGEN45.BAS IF YOU PREFER A BASIC INDEX SYSTEM.
  12. '
  13. '    PIMLIB71.BAS NEEDED TO COMPILE PROGEN71.BAS
  14. '
  15. '
  16. '
  17. '
  18. '
  19.  
  20. TYPE PIMindex
  21.      desc       AS STRING * 24
  22.      file       AS STRING * 8
  23.      indexF(20) AS STRING * 32
  24.      klen(20)   AS INTEGER
  25.      nok(20)    AS INTEGER
  26.      nexav(20)  AS INTEGER
  27.      kdel(20)   AS INTEGER
  28. END TYPE
  29.  
  30.   DIM SHARED PIMmaster AS PIMindex
  31.   DIM SHARED indexKEY$(20, 6)       'Index variables
  32. ' DIM SHARED RecField AS RecordType
  33.  
  34. '$INCLUDE: 'PROLIB71.BI'
  35.  
  36.    SUB PIM (cmd$, indexnum, key$, MastRec, CurrentIndexREC)
  37.         Trim cmd$
  38.       PIMcmd$ = UCASE$(cmd$)
  39.  
  40.       key$ = LEFT$(key$, PIMmaster.klen(indexnum))
  41.       
  42.       SELECT CASE PIMcmd$
  43.  
  44.        CASE "F", "P", "N", "S", "L", "D", "E"
  45.  
  46.        IF PIMmaster.nok(indexnum) = 0 THEN
  47.      mr = 0
  48.      CurrentIndexREC = 0
  49.      EXIT SUB
  50.       END IF
  51.  
  52.       CASE "A"
  53.     'ok to add
  54.       CASE ELSE
  55.        EXIT SUB
  56.       END SELECT
  57.  
  58.       SELECT CASE PIMcmd$
  59.  
  60. '******************************************
  61.     CASE "F" 'find first
  62. '******************************************
  63.  
  64.         Rec = 1
  65. doleft:
  66.         GET #indexnum, Rec
  67.         CurrentIndexREC = CVI(indexKEY$(indexnum, 2))
  68.  
  69.         IF CurrentIndexREC = 0 THEN
  70.            GOTO leftend
  71.         END IF
  72.         Rec = CurrentIndexREC
  73.         GOTO doleft
  74. leftend:
  75.         key$ = indexKEY$(indexnum, 1)
  76.         CurrentIndexREC = Rec
  77.         MastRec = CVI(indexKEY$(indexnum, 5))
  78.         EXIT SUB
  79.  
  80. '******************************************
  81.      CASE "L" 'find last key
  82. '******************************************
  83.  
  84.         Rec = 1
  85. doright:
  86.         GET #indexnum, Rec
  87.         CurrentIndexREC = CVI(indexKEY$(indexnum, 3))
  88.         IF CurrentIndexREC = 0 THEN
  89.            GOTO rightend
  90.         END IF
  91.         Rec = CurrentIndexREC
  92.         GOTO doright
  93. rightend:
  94.         key$ = indexKEY$(indexnum, 1)
  95.         CurrentIndexREC = Rec
  96.         MastRec = CVI(indexKEY$(indexnum, 5))
  97.         EXIT SUB
  98.  
  99. '******************************************
  100.      CASE "S"   'search for key
  101. '******************************************
  102.  
  103.         MastRec = 0
  104.         CurrentIndexREC = 0
  105.         IF LEN(key$) < PIMmaster.klen(indexnum) THEN
  106.            key$ = key$ + STRING$(PIMmaster.klen(indexnum) - LEN(key$), 32)
  107.         END IF
  108.         rrec = 1
  109.         lp = 0
  110.  
  111.         WHILE lp = 0
  112.            prevREC = rrec
  113.            GET #indexnum, rrec
  114.  
  115.            IF CVI(indexKEY$(indexnum, 5)) = 0 THEN
  116.           GOTO fplace
  117.            ELSEIF key$ < indexKEY$(indexnum, 1) THEN
  118.           side = 2
  119.            ELSEIF key$ > indexKEY$(indexnum, 1) THEN
  120.           side = 3
  121.  
  122.            ELSE
  123.           CurrentIndexREC = rrec
  124.           MastRec = CVI(indexKEY$(indexnum, 5))
  125.           GOTO matchfound
  126.  
  127.            END IF
  128.  
  129.            rrec = CVI(indexKEY$(indexnum, side))
  130.  
  131.            IF rrec = 0 THEN
  132.           GOTO fplace
  133.            END IF
  134.         WEND
  135. fplace:
  136.         MastRec = CVI(indexKEY$(indexnum, 5))
  137.         CurrentIndexREC = prevREC
  138.         key$ = indexKEY$(indexnum, 1)
  139. matchfound:
  140.  
  141.         EXIT SUB
  142.  
  143. '******************************************
  144.      CASE "E"   'search for key
  145. '******************************************
  146.  
  147.         MastRec = 0
  148.         CurrentIndexREC = 0
  149.         IF LEN(key$) < PIMmaster.klen(indexnum) THEN
  150.            key$ = key$ + STRING$(PIMmaster.klen(indexnum) - LEN(key$), 32)
  151.         END IF
  152.         rrec = 1
  153.         lp = 0
  154.  
  155.         WHILE lp = 0
  156.            prevREC = rrec
  157.            GET #indexnum, rrec
  158.  
  159.            IF CVI(indexKEY$(indexnum, 5)) = 0 THEN
  160.           GOTO ufplace
  161.            ELSEIF key$ < indexKEY$(indexnum, 1) THEN
  162.           side = 2
  163.            ELSEIF key$ > indexKEY$(indexnum, 1) THEN
  164.           side = 3
  165.  
  166.            ELSE
  167.           CurrentIndexREC = rrec
  168.           MastRec = CVI(indexKEY$(indexnum, 5))
  169.           GOTO umatchfound
  170.  
  171.            END IF
  172.  
  173.            rrec = CVI(indexKEY$(indexnum, side))
  174.  
  175.            IF rrec = 0 THEN
  176.           GOTO ufplace
  177.            END IF
  178.         WEND
  179. ufplace:
  180.         MastRec = 0
  181.         CurrentIndexREC = 0
  182.         
  183. umatchfound:
  184.  
  185.         EXIT SUB
  186.  
  187. '******************************************
  188.      CASE "A"   'add new key
  189. '******************************************
  190.  
  191.         CurrentIndexREC = 0
  192.  
  193.         IF MastRec < 1 THEN
  194.            CurrentIndexREC = -1 'bad record number
  195.         END IF
  196.  
  197.         IF LEN(key$) < 1 THEN   'key to short
  198.            CurrentIndexREC = -2
  199.         END IF
  200.  
  201.         IF PIMmaster.nok(indexnum) = 32767 THEN  'max records
  202.            CurrentIndexREC = -3
  203.         END IF
  204.  
  205.         IF CurrentIndexREC < 0 THEN     'exit with error
  206.            EXIT SUB
  207.         END IF
  208.  
  209.         IF LEN(key$) < PIMmaster.klen(indexnum) THEN
  210.            key$ = key$ + STRING$(PIMmaster.klen(indexnum) - LEN(key$), 32)
  211.         END IF
  212.  
  213.         rrec = 1
  214.         lp = 0
  215.  
  216.         DO WHILE lp = 0
  217.            prevREC = rrec
  218.  
  219.            GET #indexnum, rrec
  220.  
  221.            IF CVI(indexKEY$(indexnum, 5)) = 0 THEN
  222.           GOTO place
  223.            END IF
  224.  
  225.            IF key$ < indexKEY$(indexnum, 1) THEN
  226.           side = 2
  227.            ELSE
  228.           side = 3
  229.            END IF
  230.            rrec = CVI(indexKEY$(indexnum, side))
  231.            IF rrec = 0 THEN
  232.           lp = 1
  233.            END IF
  234.         LOOP 'WEND
  235. place:
  236.         IF PIMmaster.kdel(indexnum) THEN
  237.            GF = 4
  238.            GET #indexnum, PIMmaster.kdel(indexnum)
  239.         ELSE
  240.            GF = 3
  241.            GET #indexnum, PIMmaster.nexav(indexnum)
  242.         END IF
  243.  
  244.         nextREC = CVI(indexKEY$(indexnum, 6))
  245.  
  246.         LSET indexKEY$(indexnum, 1) = key$
  247.  
  248.         IF PIMmaster.nexav(indexnum) <> 1 THEN
  249.            GOTO nfirst
  250.         END IF
  251.  
  252.         LSET indexKEY$(indexnum, 4) = MKI$(0)
  253.         GOTO other
  254. nfirst:
  255.         LSET indexKEY$(indexnum, 4) = MKI$(prevREC)
  256. other:
  257.         LSET indexKEY$(indexnum, 3) = MKI$(0)
  258.         LSET indexKEY$(indexnum, 2) = MKI$(0)
  259.         LSET indexKEY$(indexnum, 5) = MKI$(MastRec)
  260.         LSET indexKEY$(indexnum, 6) = MKI$(0)
  261.  
  262.         IF GF = 3 THEN
  263.         PUT #indexnum, PIMmaster.nexav(indexnum)
  264.            IF PIMmaster.nexav(indexnum) = 1 THEN
  265.           GOTO increment
  266.            END IF
  267.         ELSE
  268.  
  269.         PUT #indexnum, PIMmaster.kdel(indexnum)
  270.  
  271.         END IF
  272.  
  273.         GET #indexnum, prevREC
  274.  
  275.         IF GF = 3 THEN
  276.         LSET indexKEY$(indexnum, side) = MKI$(PIMmaster.nexav(indexnum))
  277.  
  278.         ELSEIF GF = 4 THEN
  279.  
  280.         LSET indexKEY$(indexnum, side) = MKI$(PIMmaster.kdel(indexnum))
  281.  
  282.         END IF
  283.  
  284.         PUT #indexnum, prevREC
  285. increment:
  286.         IF GF = 4 THEN
  287.            PIMmaster.kdel(indexnum) = nextREC
  288.  
  289.         ELSE
  290.            PIMmaster.kdel(indexnum) = 0
  291.            PIMmaster.nexav(indexnum) = PIMmaster.nexav(indexnum) + 1
  292.  
  293.            LSET indexKEY$(indexnum, 1) = STRING$(PIMmaster.klen(indexnum), 0)
  294.  
  295.            FOR j = 2 TO 6
  296.           LSET indexKEY$(indexnum, j) = MKI$(0)
  297.            NEXT j
  298.            PUT #indexnum, PIMmaster.nexav(indexnum)
  299.         END IF
  300.  
  301.         PIMmaster.nok(indexnum) = PIMmaster.nok(indexnum) + 1
  302.         CurrentIndexREC = 1
  303.         EXIT SUB
  304.  
  305. '******************************************
  306.     CASE "D"   'delete existing key
  307. '******************************************
  308.  
  309.         IF MastRec < 1 THEN
  310.            GOTO badkey
  311.         END IF
  312.         IF CurrentIndexREC < 1 THEN
  313.            GOTO badkey
  314.         END IF
  315.         GET #indexnum, CurrentIndexREC
  316.         dk$ = indexKEY$(indexnum, 1)
  317.         curREC = CurrentIndexREC
  318.  
  319.         leftREC = CVI(indexKEY$(indexnum, 2))
  320.         rightREC = CVI(indexKEY$(indexnum, 3))
  321.         parentREC = CVI(indexKEY$(indexnum, 4))
  322.         realREC = CVI(indexKEY$(indexnum, 5))
  323.         deletedREC = CVI(indexKEY$(indexnum, 6))
  324.  
  325.         IF (parentREC <> 0) THEN
  326.            IF (leftREC <> 0) AND (rightREC = 0) THEN
  327.           GET #indexnum, parentREC
  328.           IF CVI(indexKEY$(indexnum, 2)) = curREC THEN
  329.              side = 2
  330.           ELSE
  331.              side = 3
  332.           END IF
  333.  
  334.           LSET indexKEY$(indexnum, side) = MKI$(leftREC)
  335.           PUT #indexnum, parentREC
  336.           GET #indexnum, leftREC
  337.           LSET indexKEY$(indexnum, 4) = MKI$(parentREC)
  338.           PUT #indexnum, leftREC
  339.           GOSUB initkeyrec
  340.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  341.           PUT #indexnum, curREC
  342.           PIMmaster.kdel(indexnum) = curREC
  343.            END IF
  344.  
  345.            IF (rightREC <> 0) AND (leftREC = 0) THEN
  346.           GET #indexnum, parentREC
  347.           IF CVI(indexKEY$(indexnum, 2)) = curREC THEN
  348.              side = 2
  349.           ELSE
  350.              side = 3
  351.           END IF
  352.           LSET indexKEY$(indexnum, side) = MKI$(rightREC)
  353.           PUT #indexnum, parentREC
  354.           GET #indexnum, rightREC
  355.           LSET indexKEY$(indexnum, 4) = MKI$(parentREC)
  356.           PUT #indexnum, rightREC
  357.           GOSUB initkeyrec
  358.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  359.           PUT #indexnum, curREC
  360.           PIMmaster.kdel(indexnum) = curREC
  361.            END IF
  362.  
  363.            IF ((leftREC = 0) AND (rightREC = 0)) THEN
  364.           GET #indexnum, parentREC
  365.           IF CVI(indexKEY$(indexnum, 2)) = curREC THEN
  366.              side = 2
  367.           ELSE
  368.              side = 3
  369.           END IF
  370.           LSET indexKEY$(indexnum, side) = MKI$(0)
  371.           PUT #indexnum, parentREC
  372.           GOSUB initkeyrec
  373.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  374.           PUT #indexnum, curREC
  375.           PIMmaster.kdel(indexnum) = curREC
  376.            END IF
  377.  
  378.            IF (leftREC <> 0) AND (rightREC <> 0) THEN
  379.           GET #indexnum, leftREC
  380.           LSET indexKEY$(indexnum, 4) = MKI$(parentREC)
  381.           PUT #indexnum, leftREC
  382.           pnh = leftREC
  383.           nh = CVI(indexKEY$(indexnum, 3))
  384.           WHILE nh <> 0
  385.              GET #indexnum, nh
  386.              pnh = nh
  387.              nh = CVI(indexKEY$(indexnum, 3))
  388.           WEND
  389.           LSET indexKEY$(indexnum, 3) = MKI$(rightREC)
  390.           PUT #indexnum, pnh
  391.           GET #indexnum, rightREC
  392.           LSET indexKEY$(indexnum, 4) = MKI$(pnh)
  393.           PUT #indexnum, rightREC
  394.           GET #indexnum, parentREC
  395.           IF CVI(indexKEY$(indexnum, 2)) = curREC THEN
  396.              side = 2
  397.           ELSE
  398.              side = 3
  399.           END IF
  400.           LSET indexKEY$(indexnum, side) = MKI$(leftREC)
  401.           PUT #indexnum, parentREC
  402.           GOSUB initkeyrec
  403.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  404.           PUT #indexnum, curREC
  405.           PIMmaster.kdel(indexnum) = curREC
  406.            END IF
  407.         ELSEIF (curREC = 1) THEN
  408.            IF (leftREC <> 0) AND (rightREC = 0) THEN
  409.           GET #indexnum, leftREC
  410.           lrec = CVI(indexKEY$(indexnum, 2))
  411.           rrec = CVI(indexKEY$(indexnum, 3))
  412.           LSET indexKEY$(indexnum, 4) = MKI$(0)
  413.           PUT #indexnum, 1
  414.           IF (lrec <> 0) THEN
  415.              GET #indexnum, lrec
  416.              LSET indexKEY$(indexnum, 4) = MKI$(1)
  417.              PUT #indexnum, lrec
  418.           END IF
  419.           IF (rrec <> 0) THEN
  420.              GET #indexnum, rrec
  421.              LSET indexKEY$(indexnum, 4) = MKI$(1)
  422.              PUT #indexnum, rrec
  423.           END IF
  424.           GOSUB initkeyrec
  425.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  426.           PUT #indexnum, leftREC
  427.           PIMmaster.kdel(indexnum) = leftREC
  428.            END IF
  429.            IF (rightREC <> 0) AND (leftREC = 0) THEN
  430.           GET #indexnum, rightREC
  431.           lrec = CVI(indexKEY$(indexnum, 2))
  432.           rrec = CVI(indexKEY$(indexnum, 3))
  433.           LSET indexKEY$(indexnum, 4) = MKI$(0)
  434.           PUT #indexnum, 1
  435.           IF (lrec <> 0) THEN
  436.              GET #indexnum, lrec
  437.              LSET indexKEY$(indexnum, 4) = MKI$(1)
  438.              PUT #indexnum, lrec
  439.           END IF
  440.           IF (rrec <> 0) THEN
  441.              GET #indexnum, rrec
  442.              LSET indexKEY$(indexnum, 4) = MKI$(1)
  443.              PUT #indexnum, rrec
  444.           END IF
  445.           GOSUB initkeyrec
  446.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  447.           PUT #indexnum, rightREC
  448.           PIMmaster.kdel(indexnum) = rightREC
  449.            END IF
  450.            IF ((leftREC = 0) AND (rightREC = 0)) THEN
  451.           CLOSE #indexnum
  452.           PIMmasterfile$ = PIMmaster.file
  453.           kl = PIMmaster.klen(indexnum)
  454.           idxfile$ = PIMmaster.indexF(indexnum)
  455.           CALL PIMCreate(indexnum, idxfile$, kl, PIMmasterfile$)
  456.           IF PIMfatal THEN
  457.              GOTO PIMErr
  458.           END IF
  459.           CALL PIMOpen(indexnum, PIMmasterfile$)
  460.            END IF
  461.            IF (leftREC <> 0) AND (rightREC <> 0) THEN
  462.           GET #indexnum, leftREC
  463.           lrec = CVI(indexKEY$(indexnum, 2))
  464.           rrec = CVI(indexKEY$(indexnum, 3))
  465.           LSET indexKEY$(indexnum, 4) = MKI$(0)
  466.           PUT #indexnum, 1
  467.           IF (lrec <> 0) THEN
  468.              GET #indexnum, lrec
  469.              LSET indexKEY$(indexnum, 4) = MKI$(1)
  470.              PUT #indexnum, lrec
  471.           END IF
  472.           IF (rrec <> 0) THEN
  473.              GET #indexnum, rrec
  474.              LSET indexKEY$(indexnum, 4) = MKI$(1)
  475.              PUT #indexnum, rrec
  476.           END IF
  477.           GET #indexnum, 1
  478.           pnh = 1
  479.           nh = CVI(indexKEY$(indexnum, 3))
  480.           WHILE nh <> 0
  481.              GET #indexnum, nh
  482.              pnh = nh
  483.              nh = CVI(indexKEY$(indexnum, 3))
  484.           WEND
  485.           LSET indexKEY$(indexnum, 3) = MKI$(rightREC)
  486.           PUT #indexnum, pnh
  487.           GET #indexnum, rightREC
  488.           LSET indexKEY$(indexnum, 4) = MKI$(pnh)
  489.           PUT #indexnum, rightREC
  490.           GOSUB initkeyrec
  491.           LSET indexKEY$(indexnum, 6) = MKI$(PIMmaster.kdel(indexnum))
  492.           PUT #indexnum, leftREC
  493.           PIMmaster.kdel(indexnum) = leftREC
  494.            END IF
  495.         END IF
  496.         GOTO goodkey
  497. initkeyrec:
  498.         FOR j = 2 TO 6
  499.            LSET indexKEY$(indexnum, j) = MKI$(0)
  500.         NEXT j
  501.         LSET indexKEY$(indexnum, 1) = STRING$(PIMmaster.klen(indexnum) + 10, 0)
  502.         PIMmaster.nok(indexnum) = PIMmaster.nok(indexnum) - 1
  503.         RETURN
  504. goodkey:
  505.         CurrentIndexREC = 1
  506.         GOTO deleted
  507. badkey:
  508.         MastRec = 0
  509.         CurrentIndexREC = 0
  510. deleted:
  511.         EXIT SUB
  512.  
  513. '******************************************
  514.      CASE "N"
  515. '******************************************
  516.  
  517.         pKey$ = key$
  518.         PMastRec = MastRec
  519.         PreviousIndexREC = CurrentIndexREC
  520.         
  521.         IF CurrentIndexREC = 0 THEN
  522.            GOTO nonext
  523.         END IF
  524.  
  525.         GET #indexnum, CurrentIndexREC
  526.         tkey$ = indexKEY$(indexnum, 1)
  527.         rght = CVI(indexKEY$(indexnum, 3))
  528.         IF rght = 0 THEN
  529.            GOTO master
  530.         END IF
  531.         CurrentIndexREC = rght
  532. mleft:
  533.         GET #indexnum, CurrentIndexREC
  534.         lft = CVI(indexKEY$(indexnum, 2))
  535.         IF lft = 0 THEN
  536.            GOTO nhere
  537.         END IF
  538.         CurrentIndexREC = lft
  539.         GOTO mleft
  540. master:
  541.         parent = CVI(indexKEY$(indexnum, 4))
  542.         IF parent = 0 THEN
  543.            GOTO nonext
  544.         END IF
  545.         CurrentIndexREC = parent
  546.         GET #indexnum, CurrentIndexREC
  547.         IF indexKEY$(indexnum, 1) > tkey$ THEN
  548.            GOTO nhere
  549.         END IF
  550.         GOTO master
  551. nhere:
  552.         MastRec = CVI(indexKEY$(indexnum, 5))
  553.         key$ = indexKEY$(indexnum, 1)
  554.         GOTO fnext
  555. nonext:
  556.         key$ = ""
  557.         MastRec = 0
  558.         CurrentIndexREC = 0
  559. fnext:
  560.         IF CurrentIndexREC = 0 OR MastRec = 0 THEN
  561.            IF PMastRec > 0 AND PreviousIndexREC > 0 THEN
  562.           key$ = pKey$
  563.           MastRec = PMastRec
  564.           CurrentIndexREC = PreviousIndexREC
  565.            END IF
  566.         END IF
  567.         EXIT SUB
  568.  
  569. '******************************************
  570.      CASE "P"
  571. '******************************************
  572.  
  573.         PMastRec = MastRec
  574.         PreviousIndexREC = CurrentIndexREC
  575.         pKey$ = key$
  576.         IF CurrentIndexREC = 0 THEN
  577.            GOTO noprev
  578.         END IF
  579.         GET #indexnum, CurrentIndexREC
  580.         key$ = indexKEY$(indexnum, 1)
  581.         lft = CVI(indexKEY$(indexnum, 2))
  582.         IF lft = 0 THEN
  583.            GOTO phead
  584.         END IF
  585.         CurrentIndexREC = lft
  586. prnxt:
  587.         GET #indexnum, CurrentIndexREC
  588.         rgt = CVI(indexKEY$(indexnum, 3))
  589.         IF rgt = 0 THEN
  590.            GOTO pread
  591.         END IF
  592.         CurrentIndexREC = rgt
  593.         GOTO prnxt
  594. phead:
  595.         CurrentIndexREC = CVI(indexKEY$(indexnum, 4))
  596.         IF CurrentIndexREC = 0 THEN
  597.            GOTO noprev
  598.         END IF
  599.         GET #indexnum, CurrentIndexREC
  600.         IF key$ >= indexKEY$(indexnum, 1) THEN
  601.            GOTO pread
  602.         END IF
  603.         GOTO phead
  604. pread:
  605.         key$ = indexKEY$(indexnum, 1)
  606.         MastRec = CVI(indexKEY$(indexnum, 5))
  607.         GOTO pfin
  608. noprev:
  609.         MastRec = 0
  610.         CurrentIndexREC = 0
  611.         key$ = ""
  612. pfin:
  613.         IF MastRec = 0 OR CurrentIndexREC = 0 THEN
  614.            IF PMastRec > 0 AND PreviousIndexREC > 0 THEN
  615.           MastRec = PMastRec
  616.           CurrentIndexREC = PreviousIndexREC
  617.           key$ = pKey$
  618.            END IF
  619.         END IF
  620.         EXIT SUB
  621.      CASE ELSE
  622.       END SELECT
  623.  
  624. PIMErr:
  625.       
  626.       PRINT " Index Error "
  627.       END
  628.    END SUB
  629.  
  630.    SUB PIMClose (indexnum, file$) STATIC
  631.       
  632.           filespec$ = file$
  633.           delimit = INSTR(filespec$, ".")
  634.  
  635.           IF delimit THEN
  636.          FileName$ = LEFT$(filespec$, delimit - 1)
  637.          ELSE
  638.          FileName$ = filespec$
  639.           END IF
  640.  
  641.       FileName$ = LTRIM$(RTRIM$(FileName$))
  642.  
  643.       CLOSE #indexnum
  644.  
  645.       master = FREEFILE
  646.  
  647.       OPEN "r", master, FileName$ + ".key", LEN(PIMmaster)
  648.  
  649.       PUT #master, 1, PIMmaster
  650.  
  651.       CLOSE #master
  652.  
  653.    END SUB
  654.  
  655.    SUB PIMCreate (indexnum, file$, keylength, mfile$)
  656.       
  657.       indexLEN = keylength
  658.       master = FREEFILE
  659.  
  660.       IF indexLEN > 1 AND indexLEN < 256 THEN
  661.           filespec$ = file$
  662.           delimit = INSTR(filespec$, ".")
  663.  
  664.           IF delimit THEN
  665.          FileName$ = LEFT$(filespec$, delimit - 1)
  666.          ELSE
  667.          FileName$ = filespec$
  668.           END IF
  669.           FileName$ = LTRIM$(RTRIM$(FileName$))
  670.  
  671.           mfilespec$ = mfile$
  672.           delimit = INSTR(mfilespec$, ".")
  673.  
  674.           IF delimit THEN
  675.          mFileName$ = LEFT$(mfilespec$, delimit - 1)
  676.          ELSE
  677.          mFileName$ = mfilespec$
  678.           END IF
  679.           masfile$ = LTRIM$(RTRIM$(mFileName$))
  680.  
  681.      IF FileName$ <> "" THEN
  682.  
  683.         indexfile$ = FileName$ + ".F" + LTRIM$(STR$(indexnum))
  684.         masfile$ = masfile$ + ".key"
  685.         recsize = indexLEN + 10
  686.  
  687.         IF FileExists(masfile$) = 1 THEN
  688.         OPEN "r", master, masfile$, LEN(PIMmaster)
  689.         GET #master, 1, PIMmaster
  690.         ELSE
  691.         OPEN "r", master, masfile$, LEN(PIMmaster)
  692.         END IF
  693.  
  694.         PIMmaster.desc$ = "PIM (c) R.Dixon  1990 "
  695.         PIMmaster.file = masfile$
  696.         PIMmaster.indexF(indexnum) = LTRIM$(RTRIM$(indexfile$))
  697.         PIMmaster.nok(indexnum) = 0
  698.         PIMmaster.nexav(indexnum) = 1
  699.         PIMmaster.kdel(indexnum) = 0
  700.         PIMmaster.klen(indexnum) = indexLEN
  701.  
  702.         PUT #master, 1, PIMmaster
  703.  
  704.         CLOSE #master
  705.  
  706.         OPEN "r", indexnum, indexfile$, recsize
  707.  
  708.         FIELD #indexnum, recsize AS dummy$
  709.         LSET dummy$ = STRING$(recsize, 0)
  710.         PUT #indexnum, 1
  711.         CLOSE indexnum
  712.         
  713.      END IF
  714.      indexLEN = 0
  715.       END IF
  716.    END SUB
  717.  
  718. SUB PIMdelkey (IxNum, temp$, MastRec, IndexRec)
  719.  
  720.                PIM "S", IxNum, temp$, Mchk, IndexRec
  721.                DO
  722.                   IF Mchk = MastRec THEN  'YES! Found, so quit
  723.                  EXIT DO
  724.                   ELSE  'Continue looking
  725.                  PIM "N", IxNum, temp$, Mchk, IndexRec
  726.                   END IF
  727.                LOOP  '
  728. 'Delete
  729.                PIM "D", IxNum, temp$, Mchk, IndexRec
  730.  
  731.  
  732. END SUB
  733.  
  734.    SUB PIMOpen (indexnum, file$) STATIC
  735.  
  736.       master = FREEFILE
  737.       PIMfatal = 0
  738.  
  739.       IF indexnum > 20 OR indexnum < 1 THEN
  740.      PIMfatal = 1
  741.       ELSE
  742.           filespec$ = file$
  743.           delimit = INSTR(filespec$, ".")
  744.  
  745.           IF delimit THEN
  746.          FileName$ = LEFT$(filespec$, delimit - 1)
  747.          ELSE
  748.          FileName$ = filespec$
  749.           END IF
  750.           FileName$ = LTRIM$(RTRIM$(FileName$))
  751.          
  752.      OPEN "r", master, FileName$ + ".key", LEN(PIMmaster)
  753.      GET #master, 1, PIMmaster
  754.      CLOSE master
  755.  
  756.      keyfile$ = LTRIM$(RTRIM$(PIMmaster.indexF(indexnum)))
  757.  
  758.      OPEN "r", indexnum, keyfile$, PIMmaster.klen(indexnum) + 10' PIMmaster.klen(indexnum) + 10
  759.  
  760.      FIELD #indexnum, PIMmaster.klen(indexnum) AS indexKEY$(indexnum, 1), 2 AS indexKEY$(indexnum, 2), 2 AS indexKEY$(indexnum, 3)
  761.      FIELD #indexnum, PIMmaster.klen(indexnum) + 4 AS dummy$, 2 AS indexKEY$(indexnum, 4), 2 AS indexKEY$(indexnum, 5), 2 AS indexKEY$(indexnum, 6)
  762.  
  763.      LSET indexKEY$(indexnum, 1) = STRING$(PIMmaster.klen(indexnum), 0)
  764.      LSET indexKEY$(indexnum, 2) = MKI$(0)
  765.      LSET indexKEY$(indexnum, 3) = MKI$(0)
  766.      LSET indexKEY$(indexnum, 4) = MKI$(0)
  767.      LSET indexKEY$(indexnum, 5) = MKI$(0)
  768.      LSET indexKEY$(indexnum, 6) = MKI$(0)
  769.      
  770.      PUT #indexnum, PIMmaster.nexav(indexnum)
  771.       END IF
  772.  
  773.    END SUB
  774.  
  775. FUNCTION PIMstats (indexnum)
  776.  
  777.       IF PIMmaster.nok(indexnum) = 0 THEN  '  No Ikeys in the index
  778.       PIMstats = 0
  779.       ELSE
  780.       PIMstats = 1
  781.       END IF
  782.  
  783. END FUNCTION
  784.  
  785.