Const BlockSize = 1024
Dim Rec(2) As String

Function ByteToValue (ByteNumber As String) As Long
For q = 1 To Len(ByteNumber)
  wrk$ = Hex$(Asc(Mid$(ByteNumber, q, 1)))
  ot$ = ot$ + String(2 - Len(wrk$), "0") + wrk$
Next q
ByteToValue = Val("&H" & ot$)
End Function

Function CountRecords (RecordFile As String)
xx = FreeFile
Open RecordFile & ".IDX" For Binary As #xx
CountRecords = LOF(xx) / 4
Close #xx
End Function

Sub DeleteRecord (RecordNumber, RecordFile As String)
Dim FourByte As String * 4
Dim ThreeByte As String * 3
Dim TwoByte As String * 2
Dim TransferBlock As String * BlockSize
xx = FreeFile
Open RecordFile & ".IDX" For Binary As #xx: xy = FreeFile
Open RecordFile & ".REC" For Binary As #xy
Get #xx, ((RecordNumber - 1) * 4) + 1, FourByte
Location = ByteToValue(FourByte)
Get #xy, Location, ThreeByte
Length = ByteToValue(ThreeByte)
xz = FreeFile
Open "TMP.JNK" For Output As #xz: Print #xz, ""; : Close #xz
Open "TMP.JNK" For Binary As #xz
For q = 1 To LOF(xy)
  Get #xy, q, TransferBlock
  If q + Len(TransferBlock) > LOF(xy) Then g$ = Left$(TransferBlock, LOF(xy) - q + 1) Else g$ = TransferBlock
  If (q + Len(g$) > Location And q < Location) Then f$ = Left$(g$, Location - q)
  If (q + Len(g$) > Length + Location And q < Location + Length) Then b$ = Right$(g$, Len(g$) - ((Location + Length) - q))
  g$ = f$ + b$
  Put #xz, , g$
  q = q + Len(TransferBlock) - 1
  g$ = "": b$ = "": f$ = ""
Next q
Close #xx, xy, #xz
Kill RecordFile & ".REC"
Name "TMP.JNK" As RecordFile & ".REC"
RewriteIDX RecordFile
End Sub

Function GetEntry (RecordNumber, EntryNumber, RecordFile As String) As String
Dim Byte4 As String * 4
Dim Byte3 As String * 3
Dim Byte1 As String * 1
Dim TransferBlock As String * BlockSize
xx = FreeFile: Open RecordFile & ".IDX" For Binary As #xx
xy = FreeFile: Open RecordFile & ".REC" For Binary As #xy
NumRec = LOF(xx) / 4
If RecordNumber > NumRec Then Close #xx, #xy: Exit Function
q = RecordNumber
Get #xx, ((q - 1) * 4) + 1, Byte4
LocOfRecord = ByteToValue(Byte4)
Get #xy, LocOfRecord + 5, Byte1
Get #xy, LocOfRecord, Byte3
LengthOfRecord = ByteToValue(Byte3)
NumOfEntries = ByteToValue(Byte1)
If EntryNumber <= NumOfEntries Then
  Get #xy, LocOfRecord + 6 + ((EntryNumber - 1) * 3), Byte3
  EntryStart = ByteToValue(Byte3) + LocOfRecord - 1
  If NumOfEntries > EntryNumber Then Get #xy, LocOfRecord + 6 + ((EntryNumber) * 3), Byte3: EntryEnd = ByteToValue(Byte3) + LocOfRecord - 1 Else EntryEnd = LengthOfRecord + LocOfRecord
  LengthOfEntry = EntryEnd - EntryStart
  For x = 0 To LengthOfEntry
    Get #xy, EntryStart + x, TransferBlock
    If x + Len(TransferBlock) > LengthOfEntry Then g$ = g$ + Left$(TransferBlock, LengthOfEntry - x) Else g$ = g$ + TransferBlock
    x = x + Len(TransferBlock) - 1
  Next x
  GetEntry = g$
  g$ = ""
End If
Close #xx, #xy

End Function

Sub GetEntryFromEach (EntryNumber, EntryData() As String, RecordFile As String)
Dim Byte4 As String * 4
Dim Byte3 As String * 3
Dim Byte1 As String * 1
Dim TransferBlock As String * BlockSize
xx = FreeFile: Open RecordFile & ".IDX" For Binary As #xx
xy = FreeFile: Open RecordFile & ".REC" For Binary As #xy
NumArray = (UBound(EntryData) - LBound(EntryData)) + 1
NumRec = LOF(xx) / 4
For q = 1 To Switch(NumRec <= NumArray, NumRec, NumArray < NumRec, NumArray)
  Get #xx, ((q - 1) * 4) + 1, Byte4
  LocOfRecord = ByteToValue(Byte4)
  Get #xy, LocOfRecord + 5, Byte1
  Get #xy, LocOfRecord, Byte3
  LengthOfRecord = ByteToValue(Byte3)
  NumOfEntries = ByteToValue(Byte1)
  If EntryNumber <= NumOfEntries Then
    Get #xy, LocOfRecord + 6 + ((EntryNumber - 1) * 3), Byte3
    EntryStart = ByteToValue(Byte3) + LocOfRecord - 1
    If NumOfEntries > EntryNumber Then Get #xy, LocOfRecord + 6 + ((EntryNumber) * 3), Byte3: EntryEnd = ByteToValue(Byte3) + LocOfRecord - 1 Else EntryEnd = LengthOfRecord + LocOfRecord
    LengthOfEntry = EntryEnd - EntryStart
    For x = 0 To LengthOfEntry
      Get #xy, EntryStart + x, TransferBlock
      If x + Len(TransferBlock) > LengthOfEntry Then g$ = g$ + Left$(TransferBlock, LengthOfEntry - x) Else g$ = g$ + TransferBlock
      x = x + Len(TransferBlock) - 1
    Next x
    EntryData(LBound(EntryData) + (q - 1)) = g$
    g$ = ""
  End If
Next q
Close #xx, #xy
End Sub

Sub LoadRecord (RecordNumber, RecordData() As String, RecordFile As String)
Dim Byte4 As String * 4
Dim Byte3 As String * 3
Dim Byte2 As String * 2
Dim Byte1 As String * 1
Dim TransferBlock As String * BlockSize
xx = FreeFile
Open RecordFile & ".IDX" For Binary As #xx
If LOF(xx) < RecordNumber * 4 Then Close #xx: Exit Sub
Get #xx, ((RecordNumber - 1) * 4) + 1, Byte4
Close #xx
Location = ByteToValue(Byte4)
Open RecordFile & ".REC" For Binary As #xx
Get #xx, Location, Byte3
Length = ByteToValue(Byte3)
Get #xx, Location + 3, Byte2
RecNum = ByteToValue(Byte2)
If RecNum <> RecordNumber Then Close #xx: Exit Sub
Get #xx, Location + 5, Byte1
NumEntries = ByteToValue(Byte1)
n1 = (UBound(RecordData) - LBound(RecordData)) + 1
n2 = NumEntries
OffSet = LBound(RecordData) - 1
For q = 1 To Switch(n1 <= n2, n1, n2 < n1, n2)
  Get #xx, (Location + 6) + ((q - 1) * 3), Byte3
  LocOfEntry = ByteToValue(Byte3)
  If q <> NumEntries Then Get #xx, (Location + 6) + ((q) * 3), Byte3: LocOfNextEntry = ByteToValue(Byte3) Else LocOfNextEntry = Length + 1
  EntryLength = LocOfNextEntry - LocOfEntry
  For x = 0 To EntryLength
    ReadLoc = ((Location + LocOfEntry) - 1) + x
    Get #xx, ReadLoc, TransferBlock
    If x + Len(TransferBlock) > EntryLength Then g$ = g$ + Left$(TransferBlock, EntryLength - x) Else g$ = g$ + TransferBlock
    x = x + Len(TransferBlock)
  Next x
  RecordData(OffSet + q) = g$
  g$ = ""
Next q
Close #xx
End Sub

Function RecordExists (RecordNumber, RecordFile As String) As Integer
Dim FourByte As String * 4
Dim TwoByte As String * 2
xx = FreeFile
Open RecordFile & ".IDX" For Binary As #xx: xy = FreeFile
If LOF(xx) / 4 < RecordNumber Or RecordNumber <= 0 Then Close #xx: RecordExists = 0: Exit Function
Open RecordFile & ".REC" For Binary As #xy
Get #xx, Int((RecordNumber - 1) * 4) + 1, FourByte
Close #xx
Location = ByteToValue(FourByte)
If Location > LOF(xy) Then Close #xy: RecordExists = 0: Exit Function
Get #xy, Location + 3, TwoByte
RecNum = ByteToValue(TwoByte)
If RecNum = RecordNumber Then RecordExists = -1 Else RecordExists = 0
Close #xy
End Function

Sub RewriteIDX (RecordFile As String)
Dim FourByte As String * 4
Dim ThreeByte As String * 3
Dim TwoByte As String * 2
xy = FreeFile
Open RecordFile & ".REC" For Binary As #xy: xz = FreeFile
Open "TMP.JK1" For Binary As #xz
For q = 1 To LOF(xy)
  Get #xy, q, ThreeByte
  Get #xy, q + 3, TwoByte
  RecNum = ByteToValue(TwoByte)
  Length = ByteToValue(ThreeByte)
  Location$ = ValueToByte(q, 4)
  Put #xz, ((RecNum - 1) * 4) + 1, Location$
  q = q + Length - 1
Next q
Close #xy, #xz
Open RecordFile & ".IDX" For Output As #xy: Print #xy, ""; : Close #xy
Kill RecordFile & ".IDX"
Name "TMP.JK1" As RecordFile & ".IDX"
End Sub

Sub SaveRecord (RecordNumber, RecordData() As String, RecordFile As String)
Dim Byte4 As String * 4
Dim Byte3 As String * 3
Dim Byte2 As String * 2
Dim Byte1 As String * 1
xx = FreeFile: Open RecordFile & ".IDX" For Binary As #xx: xy = FreeFile
NumberOfRecords = LOF(xx) / 4
Close #xx
If RecordNumber < 0 Or RecordNumber > NumberOfRecords Then Adding = 0: RecordNumber = NumberOfRecords + 1 Else Adding = 1
If Adding = 1 Then DeleteRecord RecordNumber, RecordFile
Open RecordFile & ".REC" For Binary As #xx
Location = LOF(xx) + 1
NumEntries = (UBound(RecordData) - LBound(RecordData)) + 1
NumEnt$ = ValueToByte(NumEntries, 1)
RecNumb$ = ValueToByte(RecordNumber, 2)
Put #xx, Location + 3, RecNumb$
Put #xx, Location + 5, NumEnt$
EntryOffset = Location + 6 + (NumEntries * 3)
For q = LBound(RecordData) To UBound(RecordData)
  Byte3 = ValueToByte(7 + (NumEntries * 3) + DataSoFar, 3)
  Put #xx, EntryOffset + DataSoFar, RecordData(q)
  Put #xx, Location + 6 + (cnt * 3), Byte3
  cnt = cnt + 1
  DataSoFar = DataSoFar + Len(RecordData(q))
Next q
TotalLength$ = ValueToByte(DataSoFar + (NumEntries * 3) + 6, 3)
Put #xx, Location, TotalLength$
Close #xx
RewriteIDX RecordFile
End Sub

Function ValueToByte (Number, Length As Integer) As String
wrk$ = Hex$(Number)
wrk$ = String(Len(wrk$) Mod 2, "0") + wrk$
For q = 1 To Len(wrk$) Step 2
  ot$ = ot$ + Chr$(Val("&H" + Mid$(wrk$, q, 2)))
Next q
ValueToByte = String(Length - Len(ot$), Chr$(0)) + ot$
End Function