DECLARE FUNCTION DichotomicSearch& (SearchValue AS STRING)
DECLARE SUB AddIndex (index AS INTEGER, FileName AS STRING, FieldReference AS INTEGER, SortOrder AS INTEGER)
DECLARE SUB AddField (TheNumber AS LONG, TheName AS STRING, TheType AS STRING, Length AS INTEGER)

' ------------------------------------------------------
'  This Structure holds the database header information
' ------------------------------------------------------
TYPE HeaderInformation
     DatabaseName     AS STRING * 30
     DatabaseVersion  AS LONG
     Created          AS STRING * 10    ' STRING representing a date
     Modified         AS STRING * 10    ' STRING representing a date
     FieldCount       AS INTEGER
     IndexCount       AS INTEGER
     RecordCount      AS LONG
     HeaderLength     AS INTEGER        ' Length of this header structure
     RecordLength     AS LONG           ' Length of the Values taken by a record
     RecordOffset     AS LONG           ' Position of the start of the 1st Record
END TYPE

' -------------------------------------------------
'  This Structure holds Field Specific Information
' -------------------------------------------------
TYPE FieldInformation
     FieldNumber      AS LONG
     FieldName        AS STRING * 32
     FieldType        AS STRING * 1     ' T=Text, I=Integer, L=Long, D=Double
     FieldLength      AS INTEGER
END TYPE
       
' -------------------------------------------------------------
'  This structure holds information about each index reference
' -------------------------------------------------------------
TYPE IndexInformation
     IndexNumber      AS LONG
     IndexName        AS STRING * 50
     FieldReference   AS INTEGER        ' Index reference in Fields() array
     SortOrder        AS INTEGER        ' 0 Ascending, 1 Descending
END TYPE

' ---------------------------------------------------------------
'  This structure holds information about each name index record
' ---------------------------------------------------------------
TYPE NameIndexInformation
     RecordNumber     AS LONG
     NameValue        AS STRING * 40
END TYPE

' ---------------------------------------------------------------
'  This structure holds information about each rate index record
' ---------------------------------------------------------------
TYPE RateIndexInformation
     RecordNumber     AS LONG
     HourlyRate       AS DOUBLE
END TYPE

' -----------------------------------------------------------------------
'  This Structure holds Employee Information read from the database file
' -----------------------------------------------------------------------
TYPE EmployeeInformation
     EmployeeNumber   AS LONG
     EmployeeName     AS STRING * 40
     Address1         AS STRING * 50
     Address2         AS STRING * 30
     City             AS STRING * 20
     State            AS STRING * 30
     ZipCode          AS LONG
     Telephone        AS STRING * 14
     Fax              AS STRING * 14
     HourlyRate       AS DOUBLE
END TYPE

' ---------------------------
'  Globally Shared Variables
' ---------------------------
DIM SHARED DBHeader          AS HeaderInformation
DIM SHARED DBFields(1 TO 10) AS FieldInformation    ' 10 Fields for this example
DIM SHARED DBIndexes(1 TO 2) AS IndexInformation    ' 2 Index File References
DIM SHARED CurrentEmployee   AS EmployeeInformation
DIM SHARED DatabaseHandle    AS INTEGER
DIM SHARED Counter           AS INTEGER
DIM SHARED WorkLength        AS INTEGER
DIM SHARED TotalLengths      AS INTEGER
DIM SHARED IndexCounter      AS LONG
DIM SHARED InnerLoop         AS LONG
DIM SHARED OuterLoop         AS LONG
DIM SHARED WorkIndex         AS STRING

'$DYNAMIC
DIM SHARED NameIndex(1)      AS NameIndexInformation
DIM SHARED RateIndex(1)      AS RateIndexInformation

' ------------------------------------------
'  Add the definitions to the DBField Array
' ------------------------------------------
CALL AddField(1, "EmployeeNumber", "I", 4)
CALL AddField(2, "EmployeeName", "T", 40)
CALL AddField(3, "Address1", "T", 50)
CALL AddField(4, "Address2", "T", 30)
CALL AddField(5, "City", "T", 20)
CALL AddField(6, "State", "T", 30)
CALL AddField(7, "ZipCode", "I", 4)
CALL AddField(8, "Telephone", "T", 14)
CALL AddField(9, "Fax", "T", 14)
CALL AddField(10, "HourlyRate", "D", 8)

CALL AddIndex(1, "EMPNAME", 2, 0)
CALL AddIndex(2, "EMPRATE", 10, 1)


' -------------------------------------------------
'  Evaluate a few values before assigning DBHeader
' -------------------------------------------------
WorkLength = LEN(DBHeader)
FOR Counter = 1 TO UBOUND(DBFields)
    TotalLengths = TotalLengths + DBFields(Counter).FieldLength
NEXT Counter

' --------------------------------------------------------------
'  Populate the DBHeader structure with appropriate information
' --------------------------------------------------------------
DBHeader.DatabaseName = "Employee"
DBHeader.DatabaseVersion = 1
DBHeader.Created = DATE$
DBHeader.Modified = DATE$
DBHeader.FieldCount = 10
DBHeader.IndexCount = 2
DBHeader.RecordCount = 4
DBHeader.HeaderLength = WorkLength
DBHeader.RecordLength = TotalLengths
' -----------------------------------------
'  This decides where the record offset is
'  based on if index files exist or not
' -----------------------------------------
IF DBHeader.IndexCount = 0 THEN
   DBHeader.RecordOffset = WorkLength + TotalLengths
ELSE
   DBHeader.RecordOffset = WorkLength + TotalLengths + (DBHeader.IndexCount * LEN(DBIndexes(1))) + 177
END IF
' ----------------------------------------------------------------
'  Write The contents of the file definition to the database file
' ----------------------------------------------------------------
DatabaseHandle = FREEFILE
OPEN RTRIM$(DBHeader.DatabaseName) + ".df" FOR BINARY AS #DatabaseHandle
PUT #DatabaseHandle, , DBHeader

FOR Counter = 1 TO UBOUND(DBFields)
    PUT #DatabaseHandle, , DBFields(Counter)
NEXT Counter

FOR Counter = 1 TO UBOUND(DBIndexes)
    PUT #DatabaseHandle, , DBIndexes(Counter)
NEXT Counter

' ----------------------------------------------------------------------
'  Assign values to the First Employee to be Saved to the database file
' ----------------------------------------------------------------------
CurrentEmployee.EmployeeNumber = 1
CurrentEmployee.EmployeeName = "Stephane Richard"
CurrentEmployee.Address1 = "I don't know"
CurrentEmployee.Address2 = "And I never will"
CurrentEmployee.City = "Somewhere"
CurrentEmployee.State = "Out There"
CurrentEmployee.ZipCode = 12345
CurrentEmployee.Telephone = "(000) 000-0000"
CurrentEmployee.Fax = "(000) 000-0000"
CurrentEmployee.HourlyRate = 37.5
' ---------------------------------------------
'  Write this information to the database file
' ---------------------------------------------
PUT #DatabaseHandle, , CurrentEmployee

' ----------------------------------------------------------------------
'  Assign values to the Second Employee to be Saved to the database file
' ----------------------------------------------------------------------
CurrentEmployee.EmployeeNumber = 2
CurrentEmployee.EmployeeName = "Kristian Virtanen"
CurrentEmployee.Address1 = "Ain't got a clue"
CurrentEmployee.Address2 = "blueberry hill"
CurrentEmployee.City = "South of North"
CurrentEmployee.State = "down here"
CurrentEmployee.ZipCode = 12121
CurrentEmployee.Telephone = "(111) 111-1111"
CurrentEmployee.Fax = "(111) 111-1111"
CurrentEmployee.HourlyRate = 38.5   ' more than fair on salaries.
' ---------------------------------------------
'  Write this information to the database file
' ---------------------------------------------
PUT #DatabaseHandle, , CurrentEmployee

' ----------------------------------------------------------------------
'  Assign values to the Second Employee to be Saved to the database file
' ----------------------------------------------------------------------
CurrentEmployee.EmployeeNumber = 3
CurrentEmployee.EmployeeName = "Michael Wirth"
CurrentEmployee.Address1 = "Am not saying"
CurrentEmployee.Address2 = "Highway To Hell"
CurrentEmployee.City = "Not Paradise"
CurrentEmployee.State = "down here"
CurrentEmployee.ZipCode = 131313
CurrentEmployee.Telephone = "(333) 333-3333"
CurrentEmployee.Fax = "(333) 333-3334"
CurrentEmployee.HourlyRate = 48.2   ' more than fair on salaries.
' ---------------------------------------------
'  Write this information to the database file
' ---------------------------------------------
PUT #DatabaseHandle, , CurrentEmployee

' ----------------------------------------------------------------------
'  Assign values to the Second Employee to be Saved to the database file
' ----------------------------------------------------------------------
CurrentEmployee.EmployeeNumber = 4
CurrentEmployee.EmployeeName = "Dave Osborne"
CurrentEmployee.Address1 = "You wish"
CurrentEmployee.Address2 = "But I don't"
CurrentEmployee.City = "Definitaly Here"
CurrentEmployee.State = "down here"
CurrentEmployee.ZipCode = 141414
CurrentEmployee.Telephone = "(444) 444-4444"
CurrentEmployee.Fax = "(444) 444-4445"
CurrentEmployee.HourlyRate = 58.6   ' more than fair on salaries.
' ---------------------------------------------
'  Write this information to the database file
' ---------------------------------------------
PUT #DatabaseHandle, , CurrentEmployee

' --------------------------------------------------------------------
'  Position our file pointer and loop to read and add values to index
' --------------------------------------------------------------------
CLS
IndexCounter = 0
REDIM NameIndex(1 TO 4) AS NameIndexInformation
REDIM RateIndex(1 TO 4) AS RateIndexInformation
SEEK #DatabaseHandle, DBHeader.RecordOffset
FOR Counter = 1 TO DBHeader.RecordCount
    GET #DatabaseHandle, , CurrentEmployee
    IndexCounter = IndexCounter + 1
    ' ---------------------------------------
    '  Redimension Name Index and Add Values
    ' ---------------------------------------
    NameIndex(IndexCounter).RecordNumber = DBHeader.RecordOffset + ((Counter - 1) * LEN(CurrentEmployee))
    NameIndex(IndexCounter).NameValue = CurrentEmployee.EmployeeName
    ' ---------------------------------------
    '  Redimension Rate Index and Add Values
    ' ---------------------------------------
    RateIndex(IndexCounter).RecordNumber = DBHeader.RecordOffset + ((Counter - 1) * LEN(CurrentEmployee))
    RateIndex(IndexCounter).HourlyRate = CurrentEmployee.HourlyRate
NEXT Counter

' -------------------------------
'  Sort Name Index Based On Name
' -------------------------------
FOR OuterLoop = 1 TO UBOUND(NameIndex)
    FOR InnerLoop = OuterLoop + 1 TO UBOUND(NameIndex)
         IF NameIndex(OuterLoop).NameValue > NameIndex(InnerLoop).NameValue THEN
            SWAP NameIndex(OuterLoop), NameIndex(InnerLoop)
         END IF
    NEXT InnerLoop
NEXT OuterLoop

' -------------------------------
'  Sort Name Index Based On Name
' -------------------------------
FOR OuterLoop = 1 TO UBOUND(RateIndex)
    FOR InnerLoop = OuterLoop + 1 TO UBOUND(RateIndex)
         IF RateIndex(OuterLoop).HourlyRate < RateIndex(InnerLoop).HourlyRate THEN
            SWAP RateIndex(OuterLoop), RateIndex(InnerLoop)
         END IF
    NEXT InnerLoop
NEXT OuterLoop

' ------------------------------------
'  Create and populate the Name Index
' ------------------------------------
WorkIndex = RTRIM$(DBIndexes(1).IndexName) + ".IDX"
IndexHandle = FREEFILE
OPEN WorkIndex FOR BINARY AS #IndexHandle
FOR Counter = 1 TO UBOUND(NameIndex)
    PUT #IndexHandle, , NameIndex(Counter)
NEXT Counter
CLOSE #IndexHandle

' ------------------------------------
'  Create and populate the Rate Index
' ------------------------------------
WorkIndex = RTRIM$(DBIndexes(2).IndexName) + ".IDX"
IndexHandle = FREEFILE
OPEN WorkIndex FOR BINARY AS #IndexHandle
FOR Counter = 1 TO UBOUND(NameIndex)
    PUT #IndexHandle, , RateIndex(Counter)
NEXT Counter
CLOSE #IndexHandle

' ---------------------------------------------------------------------------
'  Display the records in 1 natural order, 2 name order, 3 hourly rate order
' ---------------------------------------------------------------------------
PRINT "NATURAL ORDER IN THE DATABASE:"
PRINT "------------------------------"
SEEK #DatabaseHandle, DBHeader.RecordOffset
FOR Counter = 1 TO DBHeader.RecordCount
    GET #DatabaseHandle, , CurrentEmployee
    PRINT LTRIM$(STR$(CurrentEmployee.EmployeeNumber)); " - ";
    PRINT CurrentEmployee.EmployeeName;
    PRINT USING "##.##"; CurrentEmployee.HourlyRate
NEXT Counter
PRINT

' ---------------------------------------------------------------------------
'  Display the records in 1 natural order, 2 name order, 3 hourly rate order
' ---------------------------------------------------------------------------
PRINT "RECORDS SORTED BY NAME:"
PRINT "-----------------------"
FOR Counter = 1 TO UBOUND(NameIndex)
    SEEK #DatabaseHandle, NameIndex(Counter).RecordNumber
    GET #DatabaseHandle, , CurrentEmployee
    PRINT LTRIM$(STR$(CurrentEmployee.EmployeeNumber)); " - ";
    PRINT CurrentEmployee.EmployeeName;
    PRINT USING "##.##"; CurrentEmployee.HourlyRate
NEXT Counter
PRINT

' ---------------------------------------------------------------------------
'  Display the records in 1 natural order, 2 name order, 3 hourly rate order
' ---------------------------------------------------------------------------
PRINT "RECORDS SORTED BY HOURLY RATE (Bigger to smaller rate):"
PRINT "-------------------------------------------------------"
FOR Counter = 1 TO UBOUND(RateIndex)
    SEEK #DatabaseHandle, RateIndex(Counter).RecordNumber
    GET #DatabaseHandle, , CurrentEmployee
    PRINT LTRIM$(STR$(CurrentEmployee.EmployeeNumber)); " - ";
    PRINT CurrentEmployee.EmployeeName;
    PRINT USING "##.##"; CurrentEmployee.HourlyRate
NEXT Counter

DO WHILE INKEY$ = "": LOOP
' ------------------------------
'  And we close the file handle
' ------------------------------
CLOSE #DatabaseHandle

REM $STATIC
SUB AddField (TheNumber AS LONG, TheName AS STRING, TheType AS STRING, Length AS INTEGER)

     DBFields(TheNumber).FieldNumber = TheNumber
     DBFields(TheNumber).FieldName = TheName
     DBFields(TheNumber).FieldType = TheType
     DBFields(TheNumber).FieldLength = Length

END SUB

SUB AddIndex (index AS INTEGER, FileName AS STRING, FieldReference AS INTEGER, SortOrder AS INTEGER)

    DBIndexes(index).IndexNumber = index
    DBIndexes(index).IndexName = FileName
    DBIndexes(index).FieldReference = FieldReference
    DBIndexes(index).SortOrder = SortOrder

END SUB

FUNCTION DichotomicSearch& (SearchValue AS STRING)

    DIM UpperBound AS LONG
    DIM LowerBound AS LONG
    DIM Current    AS LONG

    ' -----------------------------
    '  Set default Starting Values
    ' -----------------------------
    LowerBound = LBOUND(NameIndex)
    OpperBound = UBOUND(NameIndex)
    IF INT(UpperBound / 2) = UpperBound / 2 THEN
       Current = INT(UpperBound / 2)
    ELSE
       Current = UpperBound / 2 + .5
    END IF

    IF NameIndex(Current).NameValue = SearchValue THEN
       DichotomicSearch = NameIndex(Current).RecordNumber
    ELSE
       DO WHILE UpperBound <> LowerBound OR NameIndex(Current).NameValue <> SearchValue
          IF NameIndex(Current).NameValue < SearchValue THEN
             UpperBound = Current - 1
          ELSE
             LowerBound = Current + 1
          END IF
          IF INT(UpperBound / 2) = UpperBound / 2 THEN
             Current = INT(UpperBound / 2)
          ELSE
             Current = UpperBound / 2 + .5
          END IF
          IF NameIndex(Current).NameValue = SearchValue THEN
             EXIT DO
          END IF
       LOOP
       IF NameIndex(Current).NameValue <> SearchValue THEN
          Current = 0
       END IF
    END IF
    ' ----------------------------
    '  Return the Record Position
    ' ----------------------------
    DichotomicSearch& = Current

END FUNCTION


