home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / BT-SHORT.BAS < prev    next >
BASIC Source File  |  1994-01-10  |  21KB  |  724 lines
  1. $IF NOT %NODBASE
  2. 'PUBLIC Act.Keys$, BT.Update.Always%
  3. ' be sure that you have the above PUBLIC statement near the top of
  4. ' the calling program.
  5. 'EXTERNAL Act.Keys$, BT.Update.Always%
  6. ' and put this line at the top of this file if you are creating a unit,
  7. ' otherwise, PUBLIC and EXTERNAL are not necessary with include files
  8. Sub BT(FileName$,Action$,SKy$,SDta$,RKy$,RDta$,RCCODE%) PUBLIC
  9.   Static Keys$(),Ptr$(),Stk%(),Itm$(),Dta$(),LastFile$,Cur.Lvl%,_
  10.          Hlf.Node$,Hlf.Node%,Key.Len$,Key.Len%,Dta.Len$,Dta.Len%,_
  11.          Itm.Len$,Itm.Len%,CCODE$,Root.Node$,Root.Rec%,Nxt.Node$,_
  12.          Nxt.Node%,Lst.Del$,Lst.Del%,Num.Act$,Num.Act%,Num.Keys$,_
  13.          Keys.Act%,Itm.Ptr%,Cur.Rec%
  14.  
  15.   DIM    Keys$(%BT.Max.Node),Ptr$(%BT.Max.Node),Stk%(10,1),_
  16.          Itm$(%BT.Max.Node),Dta$(%BT.Max.Node)
  17.  
  18.   UsrAct$ = Ucase$(Left$(Action$+" ",1))
  19.   If UsrAct$ = "C" Then
  20.     Gosub BT.Create
  21.   Else
  22.     Status% = -1
  23.     If UsrAct$ <> "Q" Then
  24.       If Ucase$(FileName$) <> Ucase$(LastFile$) then Gosub BT.Open.New
  25.       If LastFile$ = "" Then Status% = 0
  26.     End if
  27.     If Status% Then
  28.       Select Case UsrAct$
  29.         Case "F"  'Get First Key
  30.           Cur.Lvl% = 0
  31.           Gosub Bt.Get.Next
  32.         Case "L"  'Get Last Key
  33.           Cur.Lvl% = 0
  34.           Gosub Bt.Get.Prev
  35.         Case "S"  'Search for key in Ky$
  36.           Ky$ = Sky$
  37.           Gosub Bt.Search
  38.         Case "A"  'Add a non-unique key
  39.           Ky$ = Sky$
  40.           Da$ = SDta$
  41.           Gosub BT.Add.Non.Unique
  42.         Case "U"  'Add a unique key
  43.           Ky$ = Sky$
  44.           Da$ = Sdta$
  45.           Gosub BT.Add.Unique
  46.         Case "D"  'Delete the key/data given
  47.           Ky$ = Sky$
  48.           Gosub BT.Search
  49.           Do Until Status% = 0
  50.             If Ky$ <> Keys$(Itm.Ptr%) Then
  51.               Status% = 0
  52.               Exit Loop
  53.             End if
  54.             If SDta$ = Dta$(Itm.Ptr%) Then
  55.               Gosub BT.Del.Cur
  56.               Status% = -1
  57.               Exit Loop
  58.             Else
  59.               Gosub BT.Get.Next
  60.             End if
  61.           Loop
  62.         Case "N"  'Get Next Key
  63.           Gosub BT.Get.Next
  64.         Case "P"  'Get Previous Key
  65.           Gosub Bt.Get.Prev
  66.         Case "Q"
  67.           If LastFile$="" then
  68.             Status% =  0
  69.           Else
  70.             Status% = -1
  71.           End if
  72.         Case Else 'Error in Action CCODE
  73.           Rky$ = ""
  74.           RdTmp.Add$= ""
  75.           Status% = 0
  76.       End Select
  77.     End if
  78.     If Instr("AUDQ",UsrAct$) And Status% And (BT.Update.Always% or UsrAct$="Q") Then
  79.       Gosub BT.Update.Stats
  80.       Call UpdateFile(%BT.File.Num)
  81.       If UsrAct$ = "Q" Then
  82.         Close %BT.File.Num
  83.         LastFile$ = ""
  84.       End if
  85.     End if
  86.   End if
  87.   Rky$ = Keys$(Itm.Ptr%)
  88.   Rdta$= Dta$(Itm.Ptr%)
  89.   RCCODE% = Status%
  90.   Exit Sub
  91.  
  92. BT.Open.New:
  93.   If LastFile$ <> "" Then Gosub BT.Update.Stats
  94.   Close %BT.File.Num
  95.   Open FileName$ FOR RANDOM SHARED AS #%BT.File.Num LEN=256
  96.   Gosub Bt.Get.Stats
  97.   If Status% = 0 Then
  98.     LastFile$ = ""
  99.     Close %BT.File.Num
  100.   Else
  101.     LastFile$ = FileName$
  102.     Gosub BT.Get.Stats
  103.     Gosub Bt.Field.Node
  104.   End if
  105.   Return
  106.  
  107. BT.Create:
  108.   Close %BT.File.Num
  109.   Hlf.Node% = ( (253 \ (Len(SKy$) + Len(SDta$) + 2)) \ 2 )
  110.   If Hlf.Node% < 1 Then
  111.     Status% = 0
  112.     LastFile$ = ""
  113.     Return
  114.   End if
  115.   If Hlf.Node% > %BT.Max.Half.Node then Hlf.Node% = %BT.Max.Half.Node
  116.   Open "O",%BT.File.Num,FileName$
  117.   Close %BT.File.Num
  118.   Open "R",%BT.File.Num,FileName$,256
  119.   Gosub BT.Field.Stats
  120.   Lset Hlf.Node$ = MKI$(Hlf.Node%)
  121.   Lset Key.Len$ = MKI$(Len(SKy$))
  122.   Lset Dta.Len$ = MKI$(Len(SDta$))
  123.   Lset Itm.Len$ = MKI$(Len(SKy$) + Len(SDta$) + 2)
  124.   Lset CCODE$ = "BT"
  125.   Lset Root.Node$ = MKI$(2)
  126.   Lset Nxt.Node$ = MKI$(3)
  127.   Lset Lst.Del$ = MKI$(0)
  128.   Lset Num.Act$ = MKI$(1)
  129.   Lset Num.Keys$ = MKI$(0)
  130.   Put %BT.File.Num,1
  131.   Status% = -1
  132.   Close %BT.File.Num
  133.   LastFile$ = ""
  134.   Return
  135.  
  136. BT.GET.STATS:
  137.   GOSUB BT.Field.STATS
  138.   If CCODE$ <> "BT" Then
  139.     Status% = 0
  140.     LastFile$ = ""
  141.   Else
  142.     Status% = -1
  143.     Hlf.Node%=CVI(Hlf.Node$)
  144.     Key.Len%=CVI(Key.Len$)
  145.     Dta.Len%=CVI(Dta.Len$)
  146.     Itm.Len%=CVI(Itm.Len$)
  147.     Root.Rec%=CVI(Root.Node$)
  148.     Nxt.Node%=CVI(Nxt.Node$)
  149.     Lst.Del%=CVI(Lst.Del$)
  150.     Num.Act%=CVI(Num.Act$)
  151.     Keys.Act%=CVI(Num.Keys$)
  152.   End if
  153.   RETURN
  154.  
  155. BT.Field.STATS:
  156.   FIELD %BT.File.Num,2 AS Hlf.Node$,2 AS Key.Len$,2 AS Dta.Len$,2 AS Itm.Len$, _
  157.   2 AS CCODE$,2 AS Root.Node$,2 AS Nxt.Node$,2 AS Lst.Del$,2 AS Num.Act$,_
  158.   2 AS Num.Keys$
  159.   Cur.Rec%=1
  160.   GOSUB BT.GET.CUR
  161.   RETURN
  162.  
  163. BT.FIELD.NODE:
  164.   FIELD %BT.File.Num,1 AS Act.Keys$,2 AS Ptr$(0)
  165.   FOR Cnt%=1 TO Hlf.Node%*2
  166.     FIELD %BT.File.Num,3+Itm.Len%*(Cnt%-1) AS Tmp2$,(Key.Len%) AS Keys$(Cnt%),_
  167.     (Dta.Len%) AS Dta$(Cnt%),2 AS Ptr$(Cnt%)
  168.     FIELD %BT.File.Num,3+Itm.Len%*(Cnt%-1) AS Tmp2$,(Itm.Len%) AS Itm$(Cnt%)
  169.   NEXT Cnt%
  170.   RETURN
  171.  
  172. BT.GET.STACK.NODE:
  173.   Cur.Rec%=Stk%(Cur.Lvl%,0)
  174.   Itm.Ptr%=Stk%(Cur.Lvl%,1)
  175.   GOSUB BT.GET.CUR
  176.   RETURN
  177.  
  178. BT.POP:
  179.   Decr Cur.Lvl%
  180.   GOSUB BT.GET.STACK.NODE
  181.   RETURN
  182.  
  183. BT.PUSH:
  184.   Stk%(Cur.Lvl%,0)=Cur.Rec%
  185.   Stk%(Cur.Lvl%,1)=Itm.Ptr%
  186.   RETURN
  187.  
  188. BT.Update.Stats:
  189.   Cur.Rec%=1
  190.   GET %BT.File.Num,Cur.Rec%
  191.   LSET Root.Node$=MKI$(Root.Rec%)
  192.   LSET Nxt.Node$=MKI$(Nxt.Node%)
  193.   LSET Lst.Del$=MKI$(Lst.Del%)
  194.   LSET Num.Act$=MKI$(Num.Act%)
  195.   LSET Num.Keys$=MKI$(Keys.Act%)
  196.   PUT %BT.File.Num,Cur.Rec%
  197.   RETURN
  198.  
  199. BT.GET.CUR:
  200.   If Cur.Rec% * 256 > Lof(%BT.File.Num) Then
  201.     Field %BT.File.Num,256 as Dmy$
  202.     Lset Dmy$ = String$(256,0)
  203.     Put %BT.File.Num,Cur.Rec%
  204.   End if
  205.   GET %BT.File.Num,Cur.Rec%
  206.   RETURN
  207.  
  208. '*** SEARCH FOR FIRST OCCURANCE OF KEY ***
  209.  
  210. BT.SEARCH:
  211.   Temp%=0
  212. BT.NON.UNQ:
  213.   Status%=0
  214.   Cur.Lvl%=1
  215.   Cur.Rec%=Root.Rec%
  216.   IF LEN(KY$)<>Key.Len% THEN KY$=LEFT$(KY$+STRING$(Key.Len%," "),Key.Len%)
  217. BT.SCAN.NODE:
  218.   GOSUB BT.GET.CUR
  219.   Itm.Ptr%=1
  220.   Cnt%=ASC(Act.Keys$)
  221. BT.S.N.LOOP:
  222.   Wrk.Hlf%=INT((Itm.Ptr%+Cnt%)/2)
  223.   IF KY$>Keys$(Wrk.Hlf%) OR (Temp%<0 AND KY$=Keys$(Wrk.Hlf%)) THEN_
  224.     Itm.Ptr%=Wrk.Hlf%+1 ELSE Cnt%=Wrk.Hlf%-1
  225.   IF Cnt%>=Itm.Ptr% THEN
  226.     GOTO BT.S.N.LOOP
  227.   ELSE
  228.     GOSUB BT.PUSH
  229.     IF Itm.Ptr%<=ASC(Act.Keys$) THEN
  230.       IF KY$=Keys$(Itm.Ptr%) THEN
  231.         Status%=-1
  232.         IF CVI(Ptr$(Itm.Ptr%-1))=0 THEN RETURN
  233.       END IF
  234.     END IF
  235.   END IF
  236.   IF CVI(Ptr$(Itm.Ptr%-1))>0 THEN
  237.     Cur.Rec%=CVI(Ptr$(Itm.Ptr%-1))
  238.     Incr Cur.Lvl%
  239.     GOTO BT.SCAN.NODE
  240.   END IF
  241.   IF Status% THEN BT.GN.L.SON
  242.   If Temp% = 0 Then
  243.     Gosub BT.GN.OK
  244.     Status% = 0
  245.   End if
  246.   RETURN
  247.  
  248.  
  249.  
  250. '*** ADD KEY AT CURRENT NODE LOCATION ***
  251.  
  252. BT.ADD.AT.CUR:
  253.   Tmp.Add$=LEFT$(KY$+STRING$(Key.Len%," "),Key.Len%)+LEFT$(DA$+STRING$(Dta.Len%," "),Dta.Len%)+MKI$(0)
  254.   Temp%=0
  255. BT.CHK.FULL:
  256.   IF ASC(Act.Keys$)<Hlf.Node%*2 THEN
  257.     LSET Act.Keys$=CHR$(ASC(Act.Keys$)+1)
  258.     Cnt%=ASC(Act.Keys$)
  259.     GOSUB BT.INS.IN.NODE
  260.     LSET Ptr$(Itm.Ptr%-1)=MKI$(Temp%)
  261.     PUT %BT.File.Num,Cur.Rec%
  262.     Keys.Act%=Keys.Act%+1
  263.     Tmp.Add$=""
  264.     Temp$=""
  265.     Emerg$=""
  266.     Status% = -1
  267.     RETURN
  268.   END IF
  269.   IF Itm.Ptr%>Hlf.Node%+1 THEN
  270.     GOTO BT.ADD.RIGHT
  271.   ELSEIF Itm.Ptr%=Hlf.Node%+1 Then
  272.     Emerg$=Tmp.Add$
  273.   ELSE
  274.     Emerg$=Itm$(Hlf.Node%)
  275.     Cnt%=Hlf.Node%
  276.     GOSUB BT.INS.IN.NODE
  277.   END IF
  278.   LSET Ptr$(Itm.Ptr%-1)=MKI$(Temp%)
  279.   LSET Act.Keys$=CHR$(Hlf.Node%)
  280.   FIELD %BT.File.Num,3+Hlf.Node%*(Itm.Len%) AS Tmp2$,Hlf.Node%*(Itm.Len%) AS Tmp2$
  281.   Temp$=Tmp2$
  282.   PUT %BT.File.Num,Cur.Rec%
  283.   Temp%=Cur.Rec%
  284.   GOSUB BT.GET.AVAIL.NODE
  285.   GOSUB BT.SET.COPY
  286.   GOSUB BT.SET.RGHT.SON
  287.   GOTO BT.WRT.NODE
  288. BT.ADD.RIGHT:
  289.   FIELD %BT.File.Num,1 AS Tmp2$,2+Hlf.Node%*(Itm.Len%) AS Tmp2$
  290.   Temp$=Tmp2$
  291.   Itm.Ptr%=Itm.Ptr%-Hlf.Node%
  292.   Emerg$=Itm$(Hlf.Node%+1)
  293.   FOR Cnt%=1 TO Itm.Ptr%-2
  294.     LSET Itm$(Cnt%)=Itm$(Cnt%+Hlf.Node%+1)
  295.   NEXT Cnt%
  296.   LSET Itm$(Itm.Ptr%-1)=Tmp.Add$
  297.   IF Itm.Ptr%>Hlf.Node% THEN
  298.     GOTO BT.SET.LFT.SON
  299.   ELSE
  300.     FOR Cnt%=Itm.Ptr% TO Hlf.Node%
  301.       LSET Itm$(Cnt%)=Itm$(Cnt%+Hlf.Node%)
  302.     NEXT Cnt%
  303.   END IF
  304. BT.SET.LFT.SON:
  305.   GOSUB BT.SET.RGHT.SON
  306.   LSET Ptr$(Itm.Ptr%-2)=MKI$(Temp%)
  307.   PUT %BT.File.Num,Cur.Rec%
  308.   GOSUB BT.GET.AVAIL.NODE
  309.   FIELD %BT.File.Num,1 AS Tmp2$,LEN(Temp$) AS Tmp2$
  310.   LSET Tmp2$=Temp$
  311.   LSET Act.Keys$=CHR$(Hlf.Node%)
  312.   Temp%=Cur.Rec%
  313. BT.WRT.NODE:
  314.   PUT %BT.File.Num,Cur.Rec%
  315.   Tmp.Add$=Emerg$
  316.   Decr Cur.Lvl%
  317.   IF Cur.Lvl%=0 THEN
  318.     GOSUB BT.GET.AVAIL.NODE
  319.     Itm.Ptr%=1
  320.     Root.Rec%=Cur.Rec%
  321.     LSET Ptr$(0)=MKI$(Temp%)
  322.     GOTO BT.CHK.FULL
  323.   ELSE
  324.     GOSUB BT.GET.STACK.NODE
  325.     GOTO BT.CHK.FULL
  326.   END IF
  327. BT.INS.IN.NODE:
  328.   FOR Cnt%=Cnt% TO Itm.Ptr%+1 STEP -1
  329.     LSET Itm$(Cnt%)=Itm$(Cnt%-1)
  330.   NEXT Cnt%
  331.   LSET Itm$(Itm.Ptr%)=Tmp.Add$
  332.   RETURN
  333. BT.GET.AVAIL.NODE:
  334.   IF Lst.Del%>0 THEN
  335.     Cur.Rec%=Lst.Del%
  336.     GOSUB BT.GET.CUR
  337.     Lst.Del%=CVI(Ptr$(0))
  338.   ELSE
  339.     Cur.Rec%=Nxt.Node%
  340.     GOSUB BT.GET.CUR
  341.     Nxt.Node%=Nxt.Node%+1
  342.   END IF
  343.   Num.Act%=Num.Act%+1
  344.   LSET Act.Keys$=CHR$(0)
  345.   RETURN
  346. BT.SET.RGHT.SON:
  347.   LSET Act.Keys$=CHR$(Hlf.Node%)
  348.   LSET Ptr$(0)=RIGHT$(Emerg$,2)
  349.   MID$(Emerg$,LEN(Emerg$)-1,2)=MKI$(Cur.Rec%)
  350.   RETURN
  351. BT.SET.COPY:
  352.   FIELD %BT.File.Num,3 AS Tmp2$,LEN(Temp$) AS Tmp2$
  353.   LSET Tmp2$=Temp$
  354.   RETURN
  355.  
  356.  
  357. '*** Get Next Key in the Index ***
  358.  
  359. BT.GET.NEXT:
  360.   IF Cur.Lvl%=0 THEN
  361.     Cur.Rec%=Root.Rec%
  362.     Cur.Lvl%=1
  363.     Itm.Ptr%=1
  364.   ELSE
  365.     Itm.Ptr%=Itm.Ptr%+1
  366.   END IF
  367. BT.GN.L.SON:
  368.   GOSUB BT.GET.CUR
  369.   IF CVI(Ptr$(Itm.Ptr%-1))<>0 THEN
  370.     GOSUB BT.PUSH
  371.     Cur.Rec%=CVI(Ptr$(Itm.Ptr%-1))
  372.     Incr Cur.Lvl%
  373.     Itm.Ptr%=1
  374.     GOTO BT.GN.L.SON
  375.   END IF
  376. BT.GN.OK:
  377.   IF Itm.Ptr%<=ASC(Act.Keys$) THEN
  378.     Status%=-1
  379.     RETURN
  380.   ELSEIF Cur.Lvl%=1 Then
  381.     Cur.Lvl%=0
  382.     Status%=0
  383.     RETURN
  384.   ELSE
  385.     GOSUB BT.POP
  386.     GOTO BT.GN.OK
  387.   END IF
  388.  
  389.  
  390. '*** Get Previous Key in the Index ***
  391.  
  392. BT.GET.PREV:
  393.   IF Cur.Lvl%=0 THEN Cur.Rec%=Root.Rec% ELSE BT.GP.RHT
  394. BT.DWN1:
  395.   Incr Cur.Lvl%
  396.   GOSUB BT.GET.CUR
  397.   Itm.Ptr%=ASC(Act.Keys$)+1
  398. BT.GP.RHT:
  399.   GOSUB BT.PUSH
  400.   IF CVI(Ptr$(Itm.Ptr%-1))>0 THEN
  401.     Cur.Rec%=CVI(Ptr$(Itm.Ptr%-1))
  402.     GOTO BT.DWN1
  403.   END IF
  404. BT.GP.OK:
  405.   IF Itm.Ptr%>1 THEN
  406.     Itm.Ptr%=Itm.Ptr%-1
  407.     Status%=-1
  408.     RETURN
  409.   ELSEIF Cur.Lvl%=1 Then
  410.     Status%=0
  411.     Cur.Lvl%=0
  412.     RETURN
  413.   ELSE
  414.     GOSUB BT.POP
  415.     GOTO BT.GP.OK
  416.   END IF
  417.  
  418.  
  419. '*** Delete The Key at the Current Place in the Index ***
  420.  
  421. BT.DEL.CUR:
  422.   GOSUB BT.PUSH
  423.   IF CVI(Ptr$(Itm.Ptr%))>0 THEN
  424.     GOTO BT.DC.REPLACE
  425.   ELSE
  426.     GOSUB BT.DECR.NODE
  427.     IF Itm.Ptr%-1<>ASC(Act.Keys$) THEN GOSUB BT.SHF.FM.RHT
  428.   END IF
  429.   PUT %BT.File.Num,Cur.Rec%
  430.   IF (Cur.Rec%=Root.Rec%) OR (ASC(Act.Keys$)>=Hlf.Node%) THEN BT.DC.DONE
  431.   DO
  432.     GOSUB BT.UNDERFLOW
  433.   LOOP UNTIL Status% = 0
  434. BT.DC.DONE:
  435.   Keys.Act%=Keys.Act%-1
  436.   RETURN
  437. BT.DC.REPLACE:
  438.   GOSUB BT.GET.NEXT
  439.   Tmp.Add$=Itm$(Itm.Ptr%)
  440.   GOSUB BT.GET.PREV
  441.   GOSUB BT.REP.FTH.ITEM
  442.   PUT %BT.File.Num,Cur.Rec%
  443.   GOSUB BT.GET.NEXT
  444.   GOTO BT.DEL.CUR
  445.  
  446. BT.UNDERFLOW:
  447.   Status%=-1
  448.   GOSUB BT.POP
  449.   IF ASC(Act.Keys$)=Itm.Ptr%-1 THEN
  450.     GOTO BT.UNF.2.LFT
  451.   ELSE
  452.     Cur.Rec%=CVI(Ptr$(Itm.Ptr%))
  453.     GOSUB BT.GET.MVBL
  454.     Emerg$=Ptr$(0)
  455.   END IF
  456.   IF Wrk.Hlf%<= 0 THEN
  457.     GOTO BT.MRG.RHT
  458.   ELSE
  459.     FIELD %BT.File.Num,3 AS Tmp2$,Itm.Len%*(Wrk.Hlf%-1) AS Tmp2$
  460.     Temp$=Tmp2$
  461.     Tmp.Add$=Itm$(Wrk.Hlf%)
  462.     LSET Ptr$(0)=Ptr$(Wrk.Hlf%)
  463.     LSET Act.Keys$=CHR$(ASC(Act.Keys$)-Wrk.Hlf%)
  464.     IF ASC(Act.Keys$)>0 THEN
  465.       FOR Cnt%=1 TO ASC(Act.Keys$)
  466.         LSET Itm$(Cnt%)=Itm$(Cnt%+Wrk.Hlf%)
  467.       NEXT Cnt%
  468.     END IF
  469.   END IF
  470.   PUT %BT.File.Num,Cur.Rec%
  471.   GOSUB BT.GET.STACK.NODE
  472.   Temp$=Itm$(Itm.Ptr%)+Temp$
  473.   GOSUB BT.REP.FTH.ITEM
  474.   GOSUB BT.WRT.FTH
  475.   FIELD %BT.File.Num,3+Itm.Len%*(Hlf.Node%-1) AS Tmp2$,LEN(Temp$) AS Tmp2$
  476.   LSET Tmp2$=Temp$
  477.   LSET Ptr$(Hlf.Node%)=Emerg$
  478.   GOTO BT.ADJ.CNT
  479. BT.MRG.RHT:
  480.   FIELD %BT.File.Num,3 AS Tmp2$,Hlf.Node%*(Itm.Len%) AS Tmp2$
  481.   Temp$=Tmp2$
  482.   Tmp2$=Ptr$(0)
  483.   LSET Act.Keys$=CHR$(0)
  484.   LSET Ptr$(0)=MKI$(Lst.Del%)
  485.   Lst.Del%=Cur.Rec%
  486.   Num.Act%=Num.Act%-1
  487.   PUT %BT.File.Num,Cur.Rec%
  488.   GOSUB BT.GET.STACK.NODE
  489.   LSET Ptr$(Itm.Ptr%)=Tmp2$
  490.   Temp$=Itm$(Itm.Ptr%)+Temp$
  491.   GOSUB BT.DECR.NODE
  492.   IF Cur.Rec%=Root.Rec% AND ASC(Act.Keys$)=0 THEN
  493.     Root.Rec%=Stk%(Cur.Lvl%+1,0)
  494.     LSET Ptr$(0)=MKI$(Lst.Del%)
  495.     Lst.Del%=Cur.Rec%
  496.     Num.Act%=Num.Act%-1
  497.     Status%=0
  498.     GOTO BT.WRT.MOD.FTH
  499.   END IF
  500.   IF (ASC(Act.Keys$)>=Hlf.Node%) OR (Cur.Rec%=Root.Rec%) THEN Status%=0
  501.   IF ASC(Act.Keys$)>=Itm.Ptr% THEN GOSUB BT.SHF.FM.RHT
  502. BT.WRT.MOD.FTH:
  503.   GOSUB BT.WRT.FTH
  504.   FIELD %BT.File.Num,3+Itm.Len%*(Hlf.Node%-1) AS Tmp2$,LEN(Temp$) AS Tmp2$
  505.   GOTO BT.PUT.IN.BUF
  506. BT.UNF.2.LFT:
  507.   Cur.Rec%=CVI(Ptr$(Itm.Ptr%-2))
  508.   GOSUB BT.GET.MVBL
  509.   IF Wrk.Hlf%<=0 THEN BT.MRG.LFT
  510.   LSET Act.Keys$=CHR$(ASC(Act.Keys$)-Wrk.Hlf%)
  511.   Tmp.Add$=Itm$(ASC(Act.Keys$)+1)
  512.   FIELD %BT.File.Num,3+Itm.Len%*(ASC(Act.Keys$)+1) AS Tmp2$,Itm.Len%*(Wrk.Hlf%-1) AS Tmp2$
  513.   Temp$=Tmp2$
  514.   Emerg$=Ptr$(ASC(Act.Keys$)+1)
  515.   PUT %BT.File.Num,Cur.Rec%
  516.   GOSUB BT.GET.STACK.NODE
  517.   Temp$=Temp$+Itm$(Itm.Ptr%-1)
  518.   LSET Itm$(Itm.Ptr%-1)=Tmp.Add$
  519.   LSET Ptr$(Itm.Ptr%-1)=MKI$(Stk%(Cur.Lvl%+1,0))
  520.   GOSUB BT.WRT.FTH
  521.   IF Hlf.Node%>1 THEN
  522.     FOR Cnt%=Hlf.Node%-1 TO 1 STEP -1
  523.       LSET Itm$(Cnt%+Wrk.Hlf%)=Itm$(Cnt%)
  524.     NEXT Cnt%
  525.   END IF
  526.   GOSUB BT.SET.COPY
  527.   LSET Ptr$(Wrk.Hlf%)=Ptr$(0)
  528.   LSET Ptr$(0)=Emerg$
  529. BT.ADJ.CNT:
  530.   LSET Act.Keys$=CHR$(Hlf.Node%-1+Wrk.Hlf%)
  531.   PUT %BT.File.Num,Cur.Rec%
  532.   Status%=0
  533.   RETURN
  534. BT.MRG.LFT:
  535.   FIELD %BT.File.Num,1 AS Tmp2$,2+ASC(Act.Keys$)*(Itm.Len%) AS Tmp2$
  536.   Temp$=Tmp2$
  537.   LSET Act.Keys$=CHR$(0)
  538.   LSET Ptr$(0)=MKI$(Lst.Del%)
  539.   Lst.Del%=Cur.Rec%
  540.   Num.Act%=Num.Act%-1
  541.   PUT %BT.File.Num,Cur.Rec%
  542.   GOSUB BT.GET.STACK.NODE
  543.   Temp$=Temp$+LEFT$(Itm$(Itm.Ptr%-1),Itm.Len%-2)
  544.   LSET Ptr$(Itm.Ptr%-2)=MKI$(Stk%(Cur.Lvl%+1,0))
  545.   GOSUB BT.DECR.NODE
  546.   Status%=0
  547.   IF Cur.Rec%=Root.Rec% AND ASC(Act.Keys$)=0 THEN
  548.     Root.Rec%=Stk%(Cur.Lvl%+1,0)
  549.     LSET Ptr$(0)=MKI$(Lst.Del%)
  550.     Lst.Del%=Cur.Rec%
  551.     Num.Act%=Num.Act%-1
  552.   ELSEIF (Cur.Rec%<>Root.Rec%) AND (ASC(Act.Keys$)<Hlf.Node%) Then
  553.     Status%=-1
  554.   END IF
  555.   GOSUB BT.WRT.FTH
  556.   FIELD %BT.File.Num,3 AS Tmp2$,Itm.Len%*ASC(Act.Keys$) AS Tmp2$
  557.   Temp$=Temp$+Ptr$(0)+Tmp2$
  558.   FIELD %BT.File.Num,1 AS Tmp2$,LEN(Temp$) AS Tmp2$
  559. BT.PUT.IN.BUF:
  560.   LSET Tmp2$=Temp$
  561.   LSET Act.Keys$=CHR$(Hlf.Node%*2)
  562.   PUT %BT.File.Num,Cur.Rec%
  563.   IF Status% THEN
  564.     GOSUB BT.POP
  565.     RETURN
  566.   ELSE
  567.     RETURN
  568.   END IF
  569. BT.SHF.FM.RHT:
  570.   FOR Cnt%=Itm.Ptr% TO ASC(Act.Keys$)
  571.     LSET Itm$(Cnt%)=Itm$(Cnt%+1)
  572.   NEXT Cnt%
  573.   RETURN
  574. BT.WRT.FTH:
  575.   PUT %BT.File.Num,Cur.Rec%
  576.   Incr Cur.Lvl%
  577.   GOSUB BT.GET.STACK.NODE
  578.   RETURN
  579. BT.DECR.NODE:
  580.   LSET Act.Keys$=CHR$(ASC(Act.Keys$)-1)
  581.   RETURN
  582. BT.GET.MVBL:
  583.   GOSUB BT.GET.CUR
  584.   Wrk.Hlf%=INT((ASC(Act.Keys$)-Hlf.Node%+1)/2)
  585.   RETURN
  586. BT.REP.FTH.ITEM:
  587.   Tmp2$=Ptr$(Itm.Ptr%)
  588.   LSET Itm$(Itm.Ptr%)=Tmp.Add$
  589.   LSET Ptr$(Itm.Ptr%)=Tmp2$
  590.   RETURN
  591.  
  592. BT.ADD.NON.UNIQUE:
  593.   Temp%=-1
  594.   GOSUB BT.NON.UNQ
  595.   GOSUB BT.ADD.AT.CUR
  596.   RETURN
  597.  
  598. BT.ADD.UNIQUE:
  599.   Temp% = 1
  600.   GOSUB BT.Non.Unq
  601.   If Status% Then
  602.     Status% = 0
  603.   Else
  604.     GOSUB BT.ADD.AT.CUR
  605.   End if
  606.   RETURN
  607.  
  608. End Sub 'BT
  609.      '┌───────────────────────────────────────────────────────────┐
  610.      '│  TITLE: UPDTFILE.INC                         Version 1.0  │
  611.      '│  DESC.: Routines for updating files to disk (For Turbo B) │
  612.      '│  DATE : October 21, 1987                                  │
  613.      '│  AUTH.: Joe Vest   (BIX & GEnie: JVEST - CIS: 74017,1672) │
  614.      '│         8051 E. Roper St., Long Beach, CA, 90808          │
  615.      '│                                                           │
  616.      '│  Placed in the public domain Oct. 21, 1987 by Joe Vest.   │
  617.      '│                                                           │
  618.      '│     ***** USE THESE ROUTINES AT YOUR OWN RISK *****       │
  619.      '│                                                           │
  620.      '│  The author makes no guarantee as to the accuracy or      │
  621.      '│  suitability for a purpose of these routines.  Your use   │
  622.      '│  of these routines signifies your acceptance of the       │
  623.      '│  complete responsibility for any and all outcomes as      │
  624.      '│  the result of said use.                                  │
  625.      '│                                                           │
  626.      '│  Isn't it sad that the inherent greed of certain people   │
  627.      '│  in our society compels me to put a statement like that   │
  628.      '│  in a document that is circulated without charge for      │
  629.      '│  informational purposes?  Just remember, TANSTAAFL!       │
  630.      '│                                                           │
  631.      '│ ═════════════════════════════════════════════════════════ │
  632.      '│                                                           │
  633.      '│  I would like to thank Tod Golding of Borland Technical   │
  634.      '│  Support for showing me where the file handles for Turbo  │
  635.      '│  BASIC's files are located in memory. Without this know-  │
  636.      '│  ledge, these routines could not have been written.       │
  637.      '│                                                           │
  638.      '│ ═════════════════════════════════════════════════════════ │
  639.      '│                                                           │
  640.      '│  Documentation:                                           │
  641.      '│                                                           │
  642.      '│    These subprograms are designed to allow the programmer │
  643.      '│  to force the updating to disk of a particular file or of │
  644.      '│  all currently opened files. The routines force a write   │
  645.      '│  of the file's data and directory entry by causing MS-DOS │
  646.      '│  to duplicate the file's handle and then closing the      │
  647.      '│  duplicate handle. This performs the same function as a   │
  648.      '│  CLOSE [filenum] in BASIC while still leaving the file    │
  649.      '│  open. Consequently, you do not incur the overhead of     │
  650.      '│  actually having to open the file again. The routines     │
  651.      '│  also force all MS-DOS buffers to be physically written   │
  652.      '│  to the disk by performing a disk reset.                  │
  653.      '│    These routines can help you to make a bomb proof       │
  654.      '│  program because once a file has been updated, the user   │
  655.      '│  could turn the power off ARG! without loosing any infor- │
  656.      '│  mation from the file. Why? because all the file's data   │
  657.      '│  buffers and the directory information are on the disk    │
  658.      '│  and not in memory.                                       │
  659.      '│                                                           │
  660.      '│  The calling procedure is:                                │
  661.      '│    CALL UpdateFile(FileNum%)                              │
  662.      '│         Where FileNum% is the buffer number of a file     │
  663.      '│               that is currently open.                     │
  664.      '│  or                                                       │
  665.      '│    CALL UpdateALL                                         │
  666.      '│         This will search for all open files and update    │
  667.      '│         each of them in turn.                             │
  668.      '│                                                           │
  669.      '└───────────────────────────────────────────────────────────┘
  670.  
  671.  
  672.      '═════════════════════════════════════════════════════════════
  673.  
  674. Sub UpdateFile(FileNum%)
  675.   Local FileHandle%,Flags%
  676.  
  677.   FileHandle% = FileAttr(FileNum%,2)
  678.   'FileHandle% = FnFileHandleAddress%(FileNum%)
  679.   If FileHandle% = 0 Then Exit Sub
  680.   Reg 1,&h4500        'Duplicate Handle => AX
  681.   Reg 2,FileHandle%   'Handle => BX
  682.   Call Interrupt &h21 'Perform system service
  683.   Flags% = Reg(0)
  684.   If (Flags% and 1%) = 1% or Reg(1) = 0 Then Exit Sub
  685.   Reg 2,Reg(1)        'Dup.Handle (AX) => BX
  686.   Reg 1,&h3E00        'Close File => AX
  687.   Call Interrupt &h21
  688.   If (Flags% and 1%) = 1% Then Exit Sub
  689.   Reg 1,&h0D00        'Reset Disk
  690.   Call Interrupt &h21
  691.  
  692. End Sub 'UpdateFile
  693.  
  694.      '═════════════════════════════════════════════════════════════
  695.  
  696. SUB UpdateALL
  697.   LOCAL Segment%,Ofs%,xDone%,FileHandle%,Flags%
  698.  
  699.   DEF SEG
  700.   Segment% = PEEK(0) + (256 * PEEK(1))   ' Get the string segment.
  701.   DEF SEG  = Segment%
  702.   Ofs%     = PEEK(6) + (256 * PEEK(7))   ' Peek at the first file number.
  703.   xDone%    = -1
  704.   WHILE (PEEK(Ofs%+4) + (256 * PEEK(Ofs%+5))) <> 0
  705.     FileHandle% = Peek(Ofs%+6) + (256 * PEEK(Ofs%+7))
  706.     If FileHandle% <> 0 Then
  707.       Reg 1,&h4500        'Duplicate Handle => AX
  708.       Reg 2,FileHandle%   'Handle => BX
  709.       Call Interrupt &h21 'Perform system service
  710.       Flags% = Reg(0)
  711.       If (Flags% and 1%) = 0% and Reg(1) <> 0 Then
  712.         Reg 2,Reg(1)        'Dup.Handle (AX) => BX
  713.         Reg 1,&h3E00        'Close File => AX
  714.         Call Interrupt &h21
  715.       End if
  716.     End if
  717.     DEF SEG  = Segment%
  718.     Ofs% = PEEK(Ofs%) + (256 * PEEK(Ofs%+1))   ' Traverse the linked list.
  719.   WEND
  720.   Reg 1,&h0D00        'Reset Disk
  721.   Call Interrupt &h21
  722.  
  723. END Sub 'UpdateALL
  724. $ENDIF