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