GFIndexColLight (to be deleted)/GFIndexColLight.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = ‑1 'True
  Persistable = 0 'NotPersistable
  DataBindingBehavior = 0 'vbNone
  DataSourceBehavior  = 0 'vbNone
  MTSTransactionMode  = 0 'NotAnMTSObject
END
Attribute VB_Name = "GFIndexColLight"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'(c)2003 by Louis. Class that serves as a small and thus non‑CPU intensive index collection.
'NOTE: runs not _much_ faster than GFIndexCol :‑(
'File operations
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'IndexArray
Dim IndexNumberGlobal As Long
Dim IndexArrayGlobal() As Long

Public Sub Index_Add(ByVal Index As Long)
    'on error resume next
    IndexNumberGlobal = IndexNumberGlobal + 1&
    If ((IndexNumberGlobal ‑ 1&) Mod 512&) = 0& Then
        ReDim Preserve IndexArrayGlobal(1 To (IndexNumberGlobal + 512&)) As Long
    End If
    IndexArrayGlobal(IndexNumberGlobal) = Index
End Sub

Public Function Index_AddIfNotExisting(ByVal Index As Long) As Boolean
    'on error resume next 'returns True if index has been added, False if not
    Dim IndexFor As Long
    'begin
    For IndexFor = 1& To IndexNumberGlobal
        If IndexArrayGlobal(IndexFor) = Index Then
            Index_AddIfNotExisting = False
            Exit Function
        End If
    Next IndexFor
    Call Index_Add(Index) 'add the index
    Index_AddIfNotExisting = True
    Exit Function
End Function

Public Function GetIndexArrayIndex(ByVal Index As Long, Optional ByVal SearchStartPos As Long = 1) As Long
    'on error resume next 'returns index of array element that is equal to the passed index (or 0 if index not found)
    Dim IndexFor As Long
    '
    'NOTE: if this function returns 0 then the passed index has not been added yet,
    'if the function returns a non‑zero (greater 0) index then the passed index was added.
    '
    'verify
    If (SearchStartPos < 1) Or (SearchStartPos > IndexNumberGlobal) Then
        GetIndexArrayIndex = 0&
        Exit Function
    End If
    'begin
    For IndexFor = SearchStartPos To IndexNumberGlobal
        If IndexArrayGlobal(IndexFor) = Index Then
            GetIndexArrayIndex = IndexFor
            Exit Function
        End If
    Next IndexFor
    GetIndexArrayIndex = 0&
    Exit Function
End Function

Public Sub Clear()
    'on error resume next
    IndexNumberGlobal = 0 'reset
    ReDim IndexArrayGlobal(1 To 1) As Long
End Sub

Public Property Set IndexNumber() As Long
    'on error resume next
    IndexNumber = IndexNumberGlobal
End Property

Public Property Set IndexArray(ByVal IndexArrayIndex As Long) As Long
    'on error resume next 'calling procedure must verify passed index is valid
    If IndexArrayIndex = ‑1& Then IndexArrayIndex = IndexNumberGlobal
    IndexArray = IndexArrayGlobal(IndexArrayIndex)
End Property

Public Property Let IndexArray(ByVal IndexArrayIndex As Long, ByVal Index As Long)
    'on error resume next 'calling procedure must verify passed (IndexArray‑) index is valid
    IndexArrayGlobal(IndexArrayIndex) = Index
End Property

'NOTE: the file functions differ from those in GFIndexCol, here we have NO TagArray support.

Public Function WriteToFile(ByVal FileDescriptor As Integer) As Long
    'on error resume next 'returns number of array indices written (no error checking, 0 needn't to mean error)
    Dim IndexString As String * 4
    Dim IndexFor As Long
    'preset
    Print #FileDescriptor, "INDEXCOL";
    Call CopyMemory(ByVal IndexString, IndexNumberGlobal, 4&)
    Print #FileDescriptor, IndexString;
    'begin
    For IndexFor = 1& To IndexNumberGlobal
        Call CopyMemory(ByVal IndexString, IndexArrayGlobal(IndexFor), 4&)
        Print #FileDescriptor, IndexString;
    Next IndexFor
    WriteToFile = IndexNumberGlobal
End Function

Public Function ReadFromFile(ByVal FileDescriptor As Integer) As Long
    'on error resume next 'returns number of indices read (‑1 for error), jumps back to original file position if no index col header existing
    Dim Index As Long
    Dim IndexNumberLocal As Long
    Dim IndexString As String * 4
    Dim IndexFor As Long
    'verify
    Get #FileDescriptor, , IndexString
    If Not (IndexString = "INDE") Then
        Seek #FileDescriptor, Seek(FileDescriptor) ‑ 4&
        ReadFromFile = ‑1&
        Exit Function
    End If
    Get #FileDescriptor, , IndexString
    If Not (IndexString = "XCOL") Then
        Seek #FileDescriptor, Seek(FileDescriptor) ‑ 8&
        ReadFromFile = ‑1&
        Exit Function
    End If
    'reset
    Call Me.Clear
    'begin
    Get #FileDescriptor, , IndexString
    Call CopyMemory(IndexNumberLocal, ByVal IndexString, 4&)
    For IndexFor = 1& To IndexNumberLocal
        Get #FileDescriptor, , IndexString
        Call CopyMemory(Index, ByVal IndexString, 4&)
        Call Me.Index_Add(Index)
    Next IndexFor
    ReadFromFile = IndexNumberLocal
End Function


[END OF FILE]