'===========================================================================
' Subject: 32-BIT BTREE FOR PBDLL 5.0        Date: 01-10-98 (14:54)       
' Author:  Kerry S. Goodin                   Code: PBDLL                  
' Origin:  medvrsys@venus.net              Packet: PBDLL.ABC
'===========================================================================
'+-------------------------------------------------------------------------+
'|                                                                         |
'|                            BT-PBDLL-50.BAS                              |
'|            Modified By Gafny Jacob To Pbdll 5.0 Compiler                |
'|   Modified By Paul Propst, Additional Modification By Marty Francom     |
'|           (Adapted from Joe Vests B-Trees ,circa 1987,89)               |
'|                                                                         |
'|  Portions of this file adapted from "Joe Vest B-TREES for Turbo         |
'|  BASIC(c) and its various PowerBASIC adaptations.                       |
'|  The original source was modified, expanded and enhanced to             |
'|  support 4 byte pointers.                                               |
'|  This file provides "B-TREE" indexing for related datafiles.            |
'|                                                                         |
'|  The original versions were all limited to 32000 records because short  |
'|  integer record pointers were used.  This version uses long integer     |
'|  pointers so a billion or so keys could theoretically be "treeed"       |
'|                                                                         |
'|  If the key string input is not full length the key will be filled and  |
'|  left justified!  The DtaIn& should be the referenced record number     |
'|  as a long integer The RData& returned Will be a record pointer as a    |
'|  long integer.                                                          |
'|                                                                         |
'|  To use this version you must compile the code with the 32 bit pbdll    |
'|  compiler (ver 5.0). In Visual Basic You must declare the bt sub as     |
'|                                                                         |
'|  DECLARE SUB BT LIB "\MyDir\BT.DLL" (FileName$, Action$, KyIn$,_        |
'|                                      DtaIn&, RKey$, RData&, RCode%)     |
'|                                                                         |
'|  This version is released without copyright and is hereby placed        |
'|  directly into the public domain.  No warranty of any kind is provided. |
'|  Basically, you are on your own!                                        |
'+-------------------------------------------------------------------------+
$COMPILE DLL
$DIM ALL

'BT.Field.STATS:
'   FIELD BtFileN%, 2 AS HlfNode$, 2 AS KeyLen$, 2 AS DtaLen$, 2 AS ItmLen$,_
'   2 AS IDCode$, 4 AS RootNode$, 4 AS NxtNode$, 4 AS LstDel$, 2 AS NumAct$,_
'   4 AS NumKeys$

' The STATRECRD UDT Will replace the status field 

TYPE STATRECORD
   HlfNode    AS INTEGER
   KeyLen     AS INTEGER
   DtaLen     AS INTEGER
   ItmLen     AS INTEGER
   IDCode     AS STRING * 2
   RootNode   AS LONG
   NxtNode    AS LONG
   LstDel     AS LONG
   NumAct     AS INTEGER
   NumKeys    AS LONG
   Filler     AS STRING * 996
END TYPE

GLOBAL Stk&()
GLOBAL SttRec AS STATRECORD
GLOBAL RecBuf AS STRING * 1024
GLOBAL DPtr  AS STRING PTR
GLOBAL SPtr  As DWORD PTR
GLOBAL BtFileN%
GLOBAL StrLen%, Offset%
GLOBAL TmpBuf$

'BT.FIELD.NODE:
'  FIELD BtFileN%, 1 AS Act.Keys$, 4 AS Ptr$(0)
'  FOR Cnt% = 1 TO HlfNode% * 2
'    FIELD BtFileN%, 5 + ItmLen% * (Cnt% - 1) AS Tmp2$, (KeyLen%) AS Keys$(Cnt%), (DtaLen%) AS Dta$(Cnt%), 4 AS Ptr$(Cnt%)
'    FIELD BtFileN%, 5 + ItmLen% * (Cnt% - 1) AS Tmp2$, (ItmLen%) AS Itm$(Cnt%)
'  NEXT Cnt%

' The Following Functions Will Replace The field node

FUNCTION GetItmPl$ (Position%)
    FUNCTION = MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) ,SttRec.ItmLen)
END FUNCTION

SUB SetItmPl (Position%, Dt$)
  MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) ,SttRec.ItmLen) = Dt$
END SUB   
   
FUNCTION GetKeyPl$ (Position%)
    FUNCTION = MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) ,SttRec.KeyLen)
END FUNCTION

SUB SetKeyPl (Position%, Dt$)
    MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) ,SttRec.KeyLen) = Dt$
END SUB

FUNCTION GetDtaPl$ (Position%)
    FUNCTION = MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) + SttRec.KeyLen, 4)
END FUNCTION

SUB SetDtaPl (Position%, Dt$)
    MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) + SttRec.KeyLen, 4) = Dt$
END SUB

FUNCTION GetPtrPl$ (Position%)
  IF Position% = 0 THEN
     FUNCTION = MID$(RecBuf, 2, 4)  
  ELSE
     FUNCTION = MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) + SttRec.KeyLen + 4, 4)
  END IF
END FUNCTION

SUB SetPtrPl (Position%, Dt$)
    IF Position% = 0 THEN
       MID$(RecBuf, 2, 4) = Dt$
    ELSE
       MID$(RecBuf, 6 + SttRec.ItmLen * (Position% - 1) + SttRec.KeyLen + 4, 4) = Dt$
    END IF
END SUB

FUNCTION GetKeyAct%
  GetKeyAct% = ASC(RecBuf)
END FUNCTION

SUB SetKeyAct (Value%)
  MID$(RecBuf, 1, 1) = CHR$(Value%)
END SUB


SUB BT (FileName$, Action$, KyIn$, DtaIn&, RKey$, RData&, RCode%) EXPORT
  STATIC ItmPrt%, CurRec&, CurLvl%, LastFile$
  LOCAL LocFileName$, BtUpdtAlways%, UsrAct$, Status%
  LOCAL Ky$, Da$, RdTmpAdd$, CoreRecs&&, Temp&, TempStr$, Cnt%, WrkHlf%
  LOCAL TmpAdd$, Emerg$, FldStrt%, FldLen%, Tmp2$, Strt& 

  BtUpdtAlways% = (RCode% <> -99)
  ' if RCode% is not equal to -99 then index file will always be FLUSHed
  ' value of -1 means the file will be "FLUSH"ed after every write
  RKey$ = "": RData& = 0: RCode% = 0
  %BTMaxHalfNode = 25: BtFileN% = 200
  ' this is intended to access a single index file at a time
  FileName$ = UCASE$(FileName$): LocFileName$ = FileName$
  
  UsrAct$ = UCASE$(LEFT$(Action$ + " ", 1))
  IF UsrAct$ = "C" THEN
    GOSUB BT.Create
  ELSE
    ' if not creating then assume good status
    Status% = -1
    ' if not a close file (Q) status, check for open file
    ' open file if not already open
    IF UsrAct$ <> "Q" THEN
      IF FileName$ <> LastFile$ THEN GOSUB BT.OPEN.New
      IF LastFile$ = "" THEN Status% = 0
    END IF
    ' file open then select action
    
Bt.Start:
    IF Status% THEN
      IF UsrAct$ <> "Q" THEN
        Strt& = TIMER :Status% = 0
        DO 
          LOCK BtFileN%, 1 to 1
          IF ERR = 0 THEN Status% = - 1: EXIT DO
        LOOP UNTIL ABS(TIMER - Strt&) > 5
      END IF  
      SELECT CASE UsrAct$
        CASE "F"                               'Get First Key
          CurLvl% = 0: GOSUB BT.GET.NEXT
        CASE "L"                               'Get Last Key
          CurLvl% = 0: GOSUB BT.GET.PREV
        CASE "S"                                'Search for key in Ky$
          Ky$ = KyIn$: GOSUB BT.SEARCH
          IF Status% = 0 AND CVL(GetDtaPl$(ItmPrt%)) > 0 THEN Status% = -1
        CASE "G"                               'Get exact match
          Ky$ = KyIn$: GOSUB BT.SEARCH
        CASE "A"                               'Add a non-unique key
          Ky$ = KyIn$: DA$ = MKL$(DtaIn&): GOSUB BT.ADD.NON.UNIQUE
        CASE "U"                               'Add a unique key
          Ky$ = KyIn$: DA$ = MKL$(DtaIn&): GOSUB BT.ADD.UNIQUE
        CASE "D"                               'Delete the key/data given
          Ky$ = KyIn$: GOSUB BT.SEARCH
          DO UNTIL Status% = 0
            IF ItmPrt% = 0 THEN Status% = 0: EXIT DO
            IF Ky$ <> GetKeyPl$(ItmPrt%) THEN Status% = 0: EXIT DO
            IF DtaIn& = CVL(GetDtaPl$(ItmPrt%)) THEN
              GOSUB BT.Del.Cur: Status% = -1
              EXIT DO
            ELSE
              GOSUB BT.GET.NEXT
            END IF
          LOOP
        CASE "N"                               'Get Next Key
          Ky$ = KyIn$: GOSUB BT.SEARCH: GOSUB BT.GET.NEXT
        CASE "P"                               'Get Previous Key
          Ky$ = KyIn$: GOSUB BT.SEARCH: GOSUB BT.GET.PREV
        CASE "Q"
          Status% = -1: IF LastFile$ = "" THEN Status% = 0
        CASE ELSE                              'Error in Action code
          RKey$ = "": RdTmpAdd$ = "": Status% = 0
      END SELECT
      IF UsrAct$ <> "Q" THEN UNLOCK BtFileN%, 1 to 1
    END IF
    
    IF INSTR("AUDQ", UsrAct$) AND Status% AND (BtUpdtAlways% OR UsrAct$ = "Q") THEN
      PUT #BtFileN%, 1, SttRec: ' FLUSH (BtFileN%)
      IF UsrAct$ = "Q" THEN CLOSE BtFileN%: LastFile$ = ""
    END IF
  END IF
  IF ItmPrt% THEN
     RKey$ = GetKeyPl$(ItmPrt%): RData& = CVL(GetDtaPl$(ItmPrt%))
  ELSE
     RKey$ = "": RData& = 0
  END IF
  RCode% = Status%
  IF INSTR("PN", UsrAct$) THEN
    KyIn$ = RKey$: DtaIn& = RData&: UsrAct$ = "S": GOTO Bt.Start
  END IF
EXIT SUB

BT.OPEN.New:
  ' if file requested is not last file then up date
  ' current file and close, then open requested file
  IF LastFile$ <> "" THEN PUT #BtFileN%, 1, SttRec
  CLOSE BtFileN%
  OPEN LocFileName$ FOR RANDOM SHARED AS #BtFileN% LEN = 1024
  ' attempt to read file header
  GOSUB BT.GET.STATS
  ' if no header info in memory then close file and delete lastfile name
  IF Status% = 0 THEN
    LastFile$ = "": CLOSE BtFileN%
  ELSE
    LastFile$ = FileName$: GOSUB BT.GET.STATS
  END IF
  ' if all of this has been sucessful we are ready to "rock and roll"
 RETURN

BT.Create:
  CLOSE BtFileN%
  OPEN LocFileName$ FOR OUTPUT AS #BtFileN%
  CLOSE BtFileN%: BEEP:BEEP:BEEP
  OPEN LocFileName$ FOR RANDOM SHARED AS #BtFileN% LEN = 1024
  ' data passed in is ALWAYS a 4 byte record pointer
  ' key passed MUST be full length
  ' Data Length + Key Pointer Length = 8
  ' how many keys will fit inside a half page
  SttRec.KeyLen = LEN(KyIn$)
  SttRec.HlfNode = (1019 \ (SttRec.KeyLen + 8)) \ 2
  IF SttRec.HlfNode < 1 THEN Status% = 0: LastFile$ = "": RETURN
  IF SttRec.HlfNode > %BTMaxHalfNode THEN SttRec.HlfNode = %BTMaxHalfNode

  SttRec.DtaLen = 4:  SttRec.ItmLen = SttRec.KeyLen + 4 + 4
  SttRec.IDCode = "BL"
  SttRec.RootNode = 2:  SttRec.NxtNode = 3
  SttRec.LstDel = 0:  SttRec.NumAct = 1:  SttRec.NumKeys = 0
  PUT #BtFileN%, 1, SttRec
  Status% = -1:  CLOSE BtFileN%:  LastFile$ = ""
 RETURN

BT.GET.STATS:
  GET #BtFileN%, 1, SttRec
  IF SttRec.IDCode <> "BL" THEN
    Status% = 0:  LastFile$ = ""
  END IF
 RETURN

BT.GET.STACK.NODE:
  CurRec& = Stk&(CurLvl%, 0): ItmPrt% = Stk&(CurLvl%, 1): GOSUB BT.GET.CUR
 RETURN

BT.POP:
  CurLvl% = CurLvl% - 1: GOSUB BT.GET.STACK.NODE
 RETURN
 
BT.PUSH:
  Stk&(CurLvl%, 0) = CurRec&: Stk&(CurLvl%, 1) = ItmPrt%
 RETURN

BT.GET.CUR:
  CoreRecs&& = CurRec& * 1024
  IF (CoreRecs&& > LOF(BtFileN%)) THEN
    RecBuf = STRING$(1024, 0)
    PUT #BtFileN%, CurRec&, RecBuf
  END IF
  GET #BtFileN%, CurRec&, RecBuf
 RETURN

'*** SEARCH FOR FIRST OCCURANCE OF KEY ***

BT.SEARCH:
  Temp& = 0
BT.Non.Unq:
  Status% = 0:  CurLvl% = 1:  CurRec& = SttRec.RootNode
  IF LEN(Ky$) <> SttRec.KeyLen THEN Ky$ = LEFT$(Ky$ + STRING$(SttRec.KeyLen, " "), SttRec.KeyLen)
BT.SCAN.NODE:
  GOSUB BT.GET.CUR:  ItmPrt% = 1:  Cnt% = GetKeyAct
BT.S.N.LOOP:
  WrkHlf% = INT((ItmPrt% + Cnt%) / 2)
  IF WrkHlf% = 0 THEN
     ItmPrt% = WrkHlf% + 1
  ELSE
     IF (Ky$ > GetKeyPl$(WrkHlf%)) OR (Temp& < 0 AND Ky$ = GetKeyPl$(WrkHlf%)) THEN
       ItmPrt% = WrkHlf% + 1
     ELSE
      Cnt% = WrkHlf% - 1
     END IF
  END IF
  IF Cnt% >= ItmPrt% THEN
    GOTO BT.S.N.LOOP
  ELSE
    GOSUB BT.PUSH
    IF ItmPrt% <= GetKeyAct THEN
      IF Ky$ = GetKeyPl$(ItmPrt%) THEN
        Status% = -1: IF CVL(GetPtrPl$(ItmPrt% - 1)) = 0 THEN RETURN
      END IF
    END IF
  END IF
  IF CVL(GetPtrPl$(ItmPrt% - 1)) > 0 THEN
    CurRec& = CVL(GetPtrPl$(ItmPrt% - 1)): CurLvl% = CurLvl% + 1: GOTO BT.SCAN.NODE
  END IF
  IF Status% THEN GOTO BT.GN.L.SON
  IF Temp& = 0 THEN GOSUB BT.GN.OK:  Status% = 0
 RETURN

'*** ADD KEY AT CURRENT NODE LOCATION ***
BT.ADD.AT.CUR:
  TmpAdd$ = LEFT$(Ky$ + SPACE$(SttRec.KeyLen), SttRec.KeyLen) + LEFT$(DA$ + SPACE$(SttRec.DtaLen), SttRec.DtaLen) + MKL$(0)
  Temp& = 0
BT.CHK.FULL:
  IF GetKeyAct < SttRec.HlfNode * 2 THEN
    SetKeyAct GetKeyAct + 1: Cnt% = GetKeyAct
    GOSUB BT.INS.IN.NODE
    SetPtrPl ItmPrt% - 1, MKL$(Temp&)
    PUT #BtFileN%, CurRec&, RecBuf
    SetKeyAct GetKeyAct + 1: TmpAdd$ = "": TempStr$ = "": Emerg$ = "": Status% = -1
    RETURN
  END IF
  IF ItmPrt% > SttRec.HlfNode + 1 THEN
    GOTO BT.ADD.RIGHT
  ELSEIF ItmPrt% = SttRec.HlfNode + 1 THEN
    Emerg$ = TmpAdd$
  ELSE
    Emerg$ = GetItmPl$(SttRec.HlfNode): Cnt% = SttRec.HlfNode: GOSUB BT.INS.IN.NODE
  END IF
  SetPtrPl ItmPrt% - 1, MKL$(Temp&): SetKeyAct SttRec.HlfNode
'  FIELD BtFileN%, 5 + SttRec.HlfNode * (SttRec.ItmLen) AS Tmp2$, SttRec.HlfNode * (SttRec.ItmLen) AS Tmp2$
  FldStrt% = 6 + SttRec.HlfNode * (SttRec.ItmLen)
  FldLen% = SttRec.HlfNode * SttRec.ItmLen
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  TempStr$ = tmp2$: PUT #BtFileN%, CurRec&, RecBuf: Temp& = CurRec&
  GOSUB BT.GET.AVAIL.NODE: GOSUB BT.SET.COPY: GOSUB BT.SET.RGHT.SON
 GOTO BT.WRT.NODE

BT.ADD.RIGHT:
'  FIELD BtFileN%, 1 AS Tmp2$, 4 + SttRec.HlfNode * (SttRec.ItmLen) AS Tmp2$
  FldStrt% = 2
  FldLen% = 4 + SttRec.HlfNode * (SttRec.ItmLen)
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  TempStr$ = tmp2$: ItmPrt% = ItmPrt% - SttRec.HlfNode: Emerg$ = GetItmPl$(SttRec.HlfNode + 1)
  FOR Cnt% = 1 TO ItmPrt% - 2
    SetItmPl Cnt%, GetItmPl$(Cnt% + SttRec.HlfNode + 1)
  NEXT Cnt%
  SetItmPl ItmPrt% - 1, TmpAdd$
  IF ItmPrt% > SttRec.HlfNode THEN
    GOTO BT.SET.LFT.SON
  ELSE
    FOR Cnt% = ItmPrt% TO SttRec.HlfNode
    SetItmPl Cnt%, GetItmPl$(Cnt% + SttRec.HlfNode)
    NEXT Cnt%
  END IF
  
BT.SET.LFT.SON:
  GOSUB BT.SET.RGHT.SON: SetPtrPl ItmPrt% - 2, MKL$(Temp&)
  PUT #BtFileN%, CurRec&, RecBuf: GOSUB BT.GET.AVAIL.NODE
'  FIELD BtFileN%, 1 AS Tmp2$, LEN(TempStr$) AS Tmp2$
  FldStrt% = 2
  FldLen% = LEN(TempStr$)
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  LSET tmp2$ = TempStr$
  MID$(RecBuf, FldStrt%, FldLen%) = tmp2$
  SetKeyAct SttRec.HlfNode: Temp& = CurRec&
BT.WRT.NODE:
  PUT #BtFileN%, CurRec&, RecBuf
  TmpAdd$ = Emerg$: CurLvl% = CurLvl% - 1
  IF CurLvl% = 0 THEN
    GOSUB BT.GET.AVAIL.NODE
    ItmPrt% = 1: SttRec.RootNode = CurRec&: SetPtrPl 0, MKL$(Temp&)
    GOTO BT.CHK.FULL
  ELSE
    GOSUB BT.GET.STACK.NODE: GOTO BT.CHK.FULL
  END IF
BT.INS.IN.NODE:
  FOR Cnt% = Cnt% TO ItmPrt% + 1 STEP -1
       SetItmPl Cnt%, GetItmPl$(Cnt% - 1)
  NEXT Cnt%
  SetItmPl ItmPrt%, TmpAdd$
 RETURN

BT.GET.AVAIL.NODE:
  IF SttRec.LstDel > 0 THEN
    CurRec& = SttRec.LstDel: GOSUB BT.GET.CUR: SttRec.LstDel = CVL(GetPtrPl$(0))
  ELSE
    CurRec& = SttRec.NxtNode: GOSUB BT.GET.CUR: SttRec.NxtNode = SttRec.NxtNode + 1
  END IF
  SttRec.NumAct = SttRec.NumAct + 1: SetKeyAct 0
 RETURN

BT.SET.RGHT.SON:
  SetKeyAct SttRec.HlfNode: SetPtrPl 0, RIGHT$(Emerg$, 4)
  MID$(Emerg$, LEN(Emerg$) - 3, 4) = MKL$(CurRec&)
 RETURN

BT.SET.COPY:
'  FIELD BtFileN%, 5 AS Tmp2$, LEN(TempStr$) AS Tmp2$: LSET Tmp2$ = TempStr$
  FldStrt% = 6
  FldLen% = LEN(TempStr$)
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  LSET tmp2$ = TempStr$
  MID$(RecBuf, FldStrt%, FldLen%) = tmp2$
 RETURN
 
'*** Get Next Key in the Index ***
BT.GET.NEXT:
  IF CurLvl% = 0 THEN
    CurRec& = SttRec.RootNode: CurLvl% = 1: ItmPrt% = 1
  ELSE
    ItmPrt% = ItmPrt% + 1
  END IF
BT.GN.L.SON:
  GOSUB BT.GET.CUR
  IF CVL(GetPtrPl$(ItmPrt% - 1)) <> 0 THEN
    GOSUB BT.PUSH
    CurRec& = CVL(GetPtrPl$(ItmPrt% - 1)): CurLvl% = CurLvl% + 1: ItmPrt% = 1
    GOTO BT.GN.L.SON
  END IF
BT.GN.OK:
  IF ItmPrt% <= GetKeyAct THEN
    Status% = -1: RETURN
  ELSEIF CurLvl% = 1 THEN
    CurLvl% = 0: Status% = 0: RETURN
  ELSE
    GOSUB BT.POP:  GOTO BT.GN.OK
  END IF

'*** Get Previous Key in the Index ***
BT.GET.PREV:
  IF CurLvl% = 0 THEN CurRec& = SttRec.RootNode ELSE GOTO BT.GP.RHT
BT.DWN1:
  CurLvl% = CurLvl% + 1: GOSUB BT.GET.CUR: ItmPrt% = GetKeyAct + 1
BT.GP.RHT:
  GOSUB BT.PUSH
  IF CVL(GetPtrPl$(ItmPrt% - 1)) > 0 THEN
    CurRec& = CVL(GetPtrPl$(ItmPrt% - 1)): GOTO BT.DWN1
  END IF
BT.GP.OK:
  IF ItmPrt% > 1 THEN
    ItmPrt% = ItmPrt% - 1: Status% = -1: RETURN
  ELSEIF CurLvl% = 1 THEN
    Status% = 0: CurLvl% = 0: RETURN
  ELSE
    GOSUB BT.POP:  GOTO BT.GP.OK
  END IF

'*** Delete The Key at the Current Place in the Index ***
BT.Del.Cur:
  GOSUB BT.PUSH
  IF CVL(GetPtrPl$(ItmPrt%)) > 0 THEN
    GOTO BT.DC.REPLACE
  ELSE
    GOSUB BT.DECR.NODE
    IF ItmPrt% - 1 <> GetKeyAct THEN GOSUB BT.SHF.FM.RHT
  END IF
  PUT #BtFileN%, CurRec&, RecBuf
  IF (CurRec& = SttRec.RootNode) OR (GetKeyAct >= SttRec.HlfNode) THEN GOTO BT.DC.DONE
  DO
    GOSUB BT.UNDERFLOW
  LOOP UNTIL Status% = 0
BT.DC.DONE:
  SetKeyAct GetKeyAct - 1
 RETURN

BT.DC.REPLACE:
  GOSUB BT.GET.NEXT:  TmpAdd$ = GetItmPl$(ItmPrt%): GOSUB BT.GET.PREV
  GOSUB BT.REP.FTH.ITEM: PUT #BtFileN%, CurRec&, RecBuf: GOSUB BT.GET.NEXT
 GOTO BT.Del.Cur

BT.UNDERFLOW:
  Status% = -1: GOSUB BT.POP
  IF GetKeyAct = ItmPrt% - 1 THEN
    GOTO BT.UNF.2.LFT
  ELSE
    CurRec& = CVL(GetPtrPl$(ItmPrt%)): GOSUB BT.GET.MVBL: Emerg$ = GetPtrPl$(0)
  END IF
  IF WrkHlf% <= 0 THEN
    GOTO BT.MRG.RHT
  ELSE
'    FIELD BtFileN%, 5 AS Tmp2$, SttRec.ItmLen * (WrkHlf% - 1) AS Tmp2$
    FldStrt% = 6
    FldLen% = SttRec.ItmLen * (WrkHlf% - 1)
    tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
    TempStr$ = tmp2$: TmpAdd$ = GetItmPl$(WrkHlf%)
    SetPtrPl 0, GetPtrPl$(WrkHlf%): SetKeyAct GetKeyAct - WrkHlf%
    IF GetKeyAct > 0 THEN
      FOR Cnt% = 1 TO GetKeyAct
       SetItmPl Cnt%, GetItmPl$(Cnt% + WrkHlf%)
      NEXT Cnt%
    END IF
  END IF
  PUT #BtFileN%, CurRec&, RecBuf
  GOSUB BT.GET.STACK.NODE:  TempStr$ = GetItmPl$(ItmPrt%) + TempStr$
  GOSUB BT.REP.FTH.ITEM:  GOSUB BT.WRT.FTH
'  FIELD BtFileN%, 5 + SttRec.ItmLen * (SttRec.HlfNode - 1) AS Tmp2$, LEN(TempStr$) AS Tmp2$
  FldStrt% = 6 + SttRec.ItmLen * (SttRec.HlfNode - 1)
  FldLen% = LEN(TempStr$)
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  LSET tmp2$ = TempStr$
  MID$(RecBuf, FldStrt%, FldLen%) = tmp2$
  SetPtrPl SttRec.HlfNode, Emerg$
 GOTO BT.ADJ.CNT

BT.MRG.RHT:
'  FIELD BtFileN%, 5 AS Tmp2$, SttRec.HlfNode * (SttRec.ItmLen) AS Tmp2$
  FldStrt% = 6
  FldLen% = SttRec.HlfNode * SttRec.ItmLen
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  TempStr$ = tmp2$: tmp2$ = GetPtrPl$(0)
  SetKeyAct 0: SetPtrPl 0, MKL$(SttRec.LstDel)
  SttRec.LstDel = CurRec&: SttRec.NumAct = SttRec.NumAct - 1
  PUT #BtFileN%, CurRec&, RecBuf
  GOSUB BT.GET.STACK.NODE
  SetPtrPl ItmPrt%, tmp2$: TempStr$ = GetItmPl$(ItmPrt%) + TempStr$
  GOSUB BT.DECR.NODE
  IF CurRec& = SttRec.RootNode AND GetKeyAct = 0 THEN
    SttRec.RootNode = Stk&(CurLvl% + 1, 0)
    SetPtrPl 0, MKL$(SttRec.LstDel): SttRec.LstDel = CurRec&
    SttRec.NumAct = SttRec.NumAct - 1: Status% = 0
    GOTO BT.WRT.MOD.FTH
  END IF
  IF (GetKeyAct >= SttRec.HlfNode) OR (CurRec& = SttRec.RootNode) THEN Status% = 0
  IF GetKeyAct >= ItmPrt% THEN GOSUB BT.SHF.FM.RHT
BT.WRT.MOD.FTH:
  GOSUB BT.WRT.FTH
'  FIELD BtFileN%, 5 + SttRec.ItmLen * (SttRec.HlfNode - 1) AS Tmp2$, LEN(TempStr$) AS Tmp2$
  FldStrt% = 6 + SttRec.ItmLen * (SttRec.HlfNode - 1)
  FldLen% = LEN(TempStr$)
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  GOTO BT.PUT.IN.BUF
BT.UNF.2.LFT:
  CurRec& = CVL(GetPtrPl$(ItmPrt% - 2)): GOSUB BT.GET.MVBL
  IF WrkHlf% <= 0 THEN GOTO BT.MRG.LFT
  SetKeyAct GetKeyAct - WrkHlf%
  TmpAdd$ = GetItmPl$(GetKeyAct + 1)
'  FIELD BtFileN%, 5 + SttRec.ItmLen * (ASC(Act.Keys$) + 1) AS Tmp2$, SttRec.ItmLen * (WrkHlf% - 1) AS Tmp2$
  FldStrt% = 6 + SttRec.ItmLen * (GetKeyAct + 1)
  FldLen% = SttRec.ItmLen * (WrkHlf% - 1)
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  TempStr$ = tmp2$: Emerg$ = GetPtrPl$(GetKeyAct + 1)
  PUT #BtFileN%, CurRec&, RecBuf
  GOSUB BT.GET.STACK.NODE
  TempStr$ = TempStr$ + GetItmPl$(ItmPrt% - 1): SetItmPl ItmPrt% - 1, TmpAdd$
  SetPtrPl ItmPrt% - 1, MKL$(Stk&(CurLvl% + 1, 0))
  GOSUB BT.WRT.FTH
  IF SttRec.HlfNode > 1 THEN
    FOR Cnt% = SttRec.HlfNode - 1 TO 1 STEP -1
       SetItmPl Cnt% + WrkHlf%, GetItmPl$(Cnt%)
    NEXT Cnt%
  END IF
  GOSUB BT.SET.COPY
  SetPtrPl WrkHlf%, GetPtrPl$(0): SetPtrPl 0, Emerg$
BT.ADJ.CNT:
  SetKeyAct SttRec.HlfNode - 1 + WrkHlf%
  PUT #BtFileN%, CurRec&, RecBuf: Status% = 0
 RETURN

BT.MRG.LFT:
'  FIELD BtFileN%, 1 AS Tmp2$, 4 + ASC(Act.Keys$) * (SttRec.ItmLen) AS Tmp2$
  FldStrt% = 2
  FldLen% = 4 + GetKeyAct * SttRec.ItmLen
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  TempStr$ = tmp2$: SetKeyAct 0: SetPtrPl 0, MKL$(SttRec.LstDel)
  SttRec.LstDel = CurRec&: SttRec.NumAct = SttRec.NumAct - 1
  PUT #BtFileN%, CurRec&, RecBuf
  GOSUB BT.GET.STACK.NODE
  TempStr$ = TempStr$ + LEFT$(GetItmPl$(ItmPrt% - 1), SttRec.ItmLen - 2)
  SetPtrPl ItmPrt% - 2, MKL$(Stk&(CurLvl% + 1, 0))
  GOSUB BT.DECR.NODE:  Status% = 0
  IF (CurRec& = SttRec.RootNode) AND (GetKeyAct = 0) THEN
    SttRec.RootNode = Stk&(CurLvl% + 1, 0)
    SetPtrPl 0, MKL$(SttRec.LstDel): SttRec.LstDel = CurRec&: SttRec.NumAct = SttRec.NumAct - 1
  ELSEIF (CurRec& <> SttRec.RootNode) AND (GetKeyAct < SttRec.HlfNode) THEN
    Status% = -1
  END IF
  GOSUB BT.WRT.FTH
'  FIELD BtFileN%, 5 AS Tmp2$, SttRec.ItmLen * ASC(Act.Keys$) AS Tmp2$
  FldStrt% = 6
  FldLen% = SttRec.ItmLen * GetKeyAct
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
  TempStr$ = TempStr$ + GetPtrPl$(0) + tmp2$
'  FIELD BtFileN%, 1 AS Tmp2$, LEN(TempStr$) AS Tmp2$
  FldStrt% = 6
  FldLen% = SttRec.ItmLen * GetKeyAct
  tmp2$ = MID$(RecBuf, FldStrt%, FldLen%)
BT.PUT.IN.BUF:
  LSET tmp2$ = TempStr$
  MID$(RecBuf, FldStrt%, FldLen%) = tmp2$
  SetKeyAct SttRec.HlfNode * 2
  PUT #BtFileN%, CurRec&, RecBuf
  IF Status% THEN GOSUB BT.POP
 RETURN

BT.SHF.FM.RHT:
  FOR Cnt% = ItmPrt% TO GetKeyAct
    SetItmPl Cnt%, GetItmPl$(Cnt% + 1)
  NEXT Cnt%
 RETURN

BT.WRT.FTH:
  PUT #BtFileN%, CurRec&, RecBuf: CurLvl% = CurLvl% + 1: GOSUB BT.GET.STACK.NODE
 RETURN
  
BT.DECR.NODE:
  SetKeyAct GetKeyAct - 1
 RETURN

BT.GET.MVBL:
  GOSUB BT.GET.CUR:  WrkHlf% = INT((GetKeyAct - SttRec.HlfNode + 1) / 2)
 RETURN

BT.REP.FTH.ITEM:
  tmp2$ = GetPtrPl$(ItmPrt%): SetItmPl ItmPrt%, TmpAdd$: SetPtrPl ItmPrt%, tmp2$
 RETURN
 
BT.ADD.NON.UNIQUE:
  Temp& = -1: GOSUB BT.Non.Unq: GOSUB BT.ADD.AT.CUR
 RETURN

BT.ADD.UNIQUE:
  Temp& = 1:  GOSUB BT.Non.Unq
  IF Status% THEN Status% = 0 ELSE GOSUB BT.ADD.AT.CUR
 RETURN
END SUB 'BT

FUNCTION LibMain( BYVAL hInstDLL     AS LONG, _
                  BYVAL fdwReason    AS LONG, _
                  BYVAL lpvReserved  AS LONG) EXPORT AS LONG
   DIM Stk&(53,0:1)
   BtFileN% = FREEFILE
   FUNCTION = 1                
END FUNCTION