Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

File Based String List Class

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC File Based String List Class

    One list per file.
    Unlimited strings per list.
    Unlimited string lengths.
    Any kind of data stored as strings, nulls OK.

    Update: I will be updating the Cache Class and String Class to a more simple version.

    (it's also a file-based string stack OR file-based string queue)

    Each list item can hold two strings, second string may be ignored; pass null string.
    (blocks need to be powers of 2, there was an extra 4 bytes in list item node; might as well use it)

    The list is mainly to test the File Cache Class and the File String Class.
    The File Cache Class keeps file blocks in memory for fast access.
    The File String Class uses the cache for fast access to strings.
    More than one cache object may be used on same file.
    High priority structures given high cache maximum value; nodes, key strings, etc…

    You can download the entire source files, and test app, at the bottom of the page;
    File Based String List Class: FStrList1.zip.
    There are 7 include files - too many to post.

    Public domain; use at your own risk.
    Last edited by Stanley Durham; 20 Jul 2009, 01:41 PM.
    stanthemanstan~gmail
    Dead Theory Walking
    Range Trie Tree
    HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

  • #2
    Code:
    'FStrListClass.inc
    'PB 5/9
        'File Based String List Class
        '   also File Based String Stack & String Queue
        '
        '   one list per file
        '   unlimited strings in list
        '   unlimited string length for each string
        '       string can hold any kind of data, nulls OK
        '
        'each list item node can hold two string; Item & Payload
        '   the second string may be ignored by passing a null string; ""
        '       Payload string ignored for Stack & Queue methods
        '
        'be sure to close list before object goes out of scope: list.Close()
    #Include Once "GMem1.inc"
    #Include Once "FCache16C.inc"
    #Include Once "FCache32C.inc"
    #Include Once "FStr32C.inc"
    %FStrListHeaderStartValidation = 1167169121
    %FStrListHeaderEndValidation = 1415875802
    Type FStrListItemT '(16 bytes) allocate two at a time (32 bytes)
        hNext As Long
        hPrev As Long
        item As Long
        payload As Long
    End Type
    Type FStrListHeaderT '(32 bytes)
        validateStart As Dword
        Count As Long
        hFirst As Long
        hLast As Long
        nextFreeItem As Long
        tStrHdr As FStr32HeaderT
        notUsed As Long
        validateEnd As Dword
    End Type
    Class FStrListC
        Instance mFile As Long
        Instance mHdr As FStrListHeaderT
        Instance mItemCache As FCache16I
        Instance mStr As FStr32I
        Class Method Create()
            mItemCache = Class "FCache16C"
            mStr = Class "FStr32C"
        End Method
        Interface FStrListI
            Inherit IUnknown
            Method Open(ByVal file As String) As Long
                'open file - create file if it doesn't exist
                'True/False success
                Try
                    mFile = FreeFile
                    If IsFalse IsFile(file) Then
                        Open file For Binary As mFile
                        mHdr.validateStart = %FStrListHeaderStartValidation
                        mHdr.validateEnd = %FStrListHeaderEndValidation
                        Put mFile, 1, mHdr
                        mItemCache.Open(mFile, 10000)
                        mStr.Open(mFile, VarPtr(mHdr.tStrHdr), 5000)
                        Method = boolTrue
                    Else
                        Open file For Binary As mFile
                        Get mFile, 1, mHdr
                        If mHdr.validateStart <> %FStrListHeaderStartValidation Or mHdr.validateEnd <> %FStrListHeaderEndValidation Then
                            Close mFile
                        Else
                            mItemCache.Open(mFile, 10000)
                            mStr.Open(mFile, VarPtr(mHdr.tStrHdr), 5000)
                            Method = boolTrue
                        End If
                    End If
                Catch
                    mFile = boolNull
                End Try
            End Method
            Method Close()
                'close file
                If mFile Then
                    Try
                        mItemCache.Close()
                        mStr.Close()
                        Put mFile, 1, mHdr
                        Close mFile
                    Catch
                    Finally
                        mFile = boolNull
                    End Try
                End If
            End Method
            Method Clear()
                'delete all data - truncate file to list header (32 bytes)
                mItemCache.Close()
                mStr.Close()
                mHdr.count = 0
                mHdr.hFirst = boolNull
                mHdr.hLast = boolNull
                mHdr.nextFreeItem = boolNull
                mHdr.tStrHdr.nextFree = boolNull
                Put mFile, 1, mHdr
                Seek mFile, 33
                SetEof mFile
                mItemCache.Open(mFile, 10000)
                mStr.Open(mFile, VarPtr(mHdr.tStrHdr), 5000)
            End Method
            Method Count() As Long
                'get stored item count
                If mFile Then Method = mHdr.count
            End Method
            Method Add(In ByRef item As String, In ByRef payload As String)
                'append item to end of list
                '   payload may be null if not used; ""
                Local hItem As Long
                Local pItem, pLast As FStrListItemT Ptr
                If mFile Then
                    hItem = me.AllocItem()
                    boolExitIfFalse(hItem, Method, "hItem = null")
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    @pItem.item = mStr.Set(item)
                    @pItem.payload = mStr.Set(payload)
                    If mHdr.hLast Then
                        pLast = mItemCache.Get(mHdr.hLast)
                        boolExitIfFalse(pLast, Method, "pLast = null")
                        @pLast.hNext = hItem
                    End If
                    @pItem.hPrev = mHdr.hLast
                    mHdr.hLast = hItem
                    If mHdr.hFirst = boolNull Then mHdr.hFirst = hItem
                End If
            End Method
            Method Insert(In ByRef item As String, In ByRef payload As String)
                'insert item in front of list
                '   payload may be null if not used; ""
                Local hItem As Long
                Local pItem, pFirst As FStrListItemT Ptr
                If mFile Then
                    hItem = me.AllocItem()
                    boolExitIfFalse(hItem, Method, "hItem = null")
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    @pItem.item = mStr.Set(item)
                    @pItem.payload = mStr.Set(payload)
                    If mHdr.hFirst Then
                        pFirst = mItemCache.Get(mHdr.hFirst)
                        boolExitIfFalse(pFirst, Method, "pFirst = null")
                        @pFirst.hPrev = hItem
                    End If
                    @pItem.hNext = mHdr.hFirst
                    mHdr.hFirst = hItem
                    If mHdr.hLast = boolNull Then mHdr.hLast = hItem
                End If
            End Method
            Method InsertAt(ByVal hItem As Long, In ByRef item As String, In ByRef payload As String)
                'insert values before item node handle, hItem
                Local hNew As Long
                Local pNew, pItem, pPrev As FStrListItemT Ptr
                If mFile And hItem Then
                    If hNew = mHdr.hFirst Then
                        me.Insert(item, payload)
                    Else
                        hNew = me.AllocItem()
                        boolExitIfFalse(hNew, Method, "hNew = null")
                        pNew = mItemCache.Get(hNew)
                        boolExitIfFalse(pNew, Method, "pNew = null")
                        @pNew.item = mStr.Set(item)
                        @pNew.payload = mStr.Set(payload)
                        pItem = mItemCache.Get(hItem)
                        boolExitIfFalse(pItem, Method, "pItem = null")
                        @pNew.hPrev = @pItem.hPrev
                        If @pItem.hPrev Then
                            pPrev = mItemCache.Get(@pItem.hPrev)
                            boolExitIfFalse(pPrev, Method, "pPrev = null")
                            @pPrev.hNext = hNew
                        End If
                        @pNew.hNext = hItem
                        @pItem.hPrev = hNew
                    End If
                End If
            End Method
            Method DeleteAt(ByVal hItem As Long)
                'remove hItem from list
                Local pItem, pNext, pPrev As FStrListItemT Ptr
                If mFile Then
                    boolExitIfFalse(hItem, Method, "hItem = null")
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    If mHdr.count = 1 Then
                        me.Clear()
                        Exit Method
                    End If
                    If mHdr.hFirst = hItem Then mHdr.hFirst = @pItem.hNext
                    If mHdr.hLast = hItem Then mHdr.hLast = @pItem.hPrev
                    If @pItem.hPrev Then
                        pPrev = mItemCache.Get(@pItem.hPrev)
                        boolExitIfFalse(pPrev, Method, "pPrev = null")
                        @pPrev.hNext = @pItem.hNext
                    End If
                    If @pItem.hNext Then
                        pNext = mItemCache.Get(@pItem.hNext)
                        boolExitIfFalse(pNext, Method, "pNext = null")
                        @pNext.hPrev = @pItem.hPrev
                    End If
                    me.FreeItem(hItem)
                End If
            End Method
            Method GoFirst() As Long
                'move cursor first item in list
                '   return item node handle
                '   False if fail
                If mFile Then Method = mHdr.hFirst
            End Method
            Method GoLast() As Long
                'move cursor last item in list
                '   return item node handle
                '   False if fail
                If mFile Then Method = mHdr.hLast
            End Method
            Method GoNext(ByVal hItem As Long) As Long
                'move to next item in list - go right
                '   return item node handle
                '   False if fail
                Local pItem As FStrListItemT Ptr
                If mFile And hItem Then
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    Method = @pItem.hNext
                End If
            End Method
            Method GoPrevious(ByVal hItem As Long) As Long
                'move to previous item in list - go left
                '   return item node handle
                '   False if fail
                Local pItem As FStrListItemT Ptr
                If mFile And hItem Then
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    Method = @pItem.hPrev
                End If
            End Method
            Method GetItemAt(ByVal hItem As Long) As String
                'get item at designated position
                Local pItem As FStrListItemT Ptr
                If mFile And hItem Then
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    Method = mStr.Get(@pItem.item)
                End If
            End Method
            Method GetPayloadAt(ByVal hItem As Long) As String
                'get item's payload value at designated position
                Local pItem As FStrListItemT Ptr
                If mFile And hItem Then
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    Method = mStr.Get(@pItem.payload)
                End If
            End Method
            Method SetItemAt(ByVal hItem As Long, In ByRef item As String)
                'change item at designated position
                Local pItem As FStrListItemT Ptr
                If mFile And hItem Then
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    @pItem.item = mStr.Delete(@pItem.item)
                    @pItem.item = mStr.Set(item)
                End If
            End Method
            Method SetPayloadAt(ByVal hItem As Long, In ByRef payload As String)
                'change item's payload at designated position
                Local pItem As FStrListItemT Ptr
                If mFile And hItem Then
                    pItem = mItemCache.Get(hItem)
                    boolExitIfFalse(pItem, Method, "pItem = null")
                    @pItem.payload = mStr.Delete(@pItem.payload)
                    @pItem.payload = mStr.Set(payload)
                End If
            End Method
            ' ----------------------------------------------------------------
            '   Stack Methods | Last In First Out | File Based String Stack
            ' ----------------------------------------------------------------
            Method StackPush(In ByRef item As String)
                'push item on top of stack
                If mFile Then
                    me.Add(item, "")
                End If
            End Method
            Method StackPeek() As String
                'get top item on stack
                If mFile And mHdr.count Then
                    Local hItem As Long
                    hItem = me.GoLast()
                    If hItem Then
                        Method = me.GetItemAt(hItem)
                    End If
                End If
            End Method
            Method StackPop() As String
                'pop top item off stack
                If mFile And mHdr.count Then
                    Local hItem As Long
                    hItem = me.GoLast()
                    If hItem Then
                        Method = me.GetItemAt(hItem)
                        me.DeleteAt(hItem)
                    End If
                End If
            End Method
            ' ----------------------------------------------------------------
            '   Queue Methods | First In First Out | File Based String Queue
            ' ----------------------------------------------------------------
            Method QueuePush(In ByRef item As String)
                'push item in back of queue
                me.Add(item, "")
            End Method
            Method QueuePeek() As String
                'get first item in que
                Method = me.GetItemAt(me.GoFirst())
            End Method
            Method QueuePop() As String
                'pop first item in queue
                Local hItem As Long
                hItem = me.GoFirst()
                Method = me.GetItemAt(hItem)
                me.DeleteAt(hItem)
            End Method
        End Interface ' -----------------
        Class Method AllocItem() As Long
            'allocate space for item node in file
            '   return handle (file position)
            Local hItem As Long
            hItem = me.GetFreeItem()
            If hItem Then
                Incr mHdr.count
                Method = hItem
            Else
                'make space for two item nodes so that all blocks = 32 bytes
                hItem = Lof(mFile) + 1
                Seek mFile, hItem
                Put$ mFile, Nul$(32)
                me.AddFreeItem(hItem) 'add first item to free stack
                hItem += 16
                Incr mHdr.count
                Method = hItem
            End If
        End Method
        Class Method FreeItem(ByVal hItem As Long)
            'free item node
            '   free string - add to free item stack
            Local pItem As FStrListItemT Ptr
            boolExitIfFalse(hItem, Method, "hItem = null")
            pItem = mItemCache.Get(hItem)
            boolExitIfFalse(pItem, Method, "pItem = null")
            @pItem.item = mStr.Delete(@pItem.item)
            @pItem.payload = mStr.Delete(@pItem.payload)
            me.AddFreeItem(hItem)
            Decr mHdr.count
        End Method
        Class Method GetFreeItem() As Long
            'reuse item node that was deleted
            Local hItem As Long
            Local pItem As FStrListItemT Ptr
            hItem = mHdr.nextFreeItem
            If hItem Then
                pItem = mItemCache.Get(hItem)
                boolExitIfFalse(pItem, Method, "pItem = null")
                mHdr.nextFreeItem = @pItem.hNext
                Poke$ pItem, Nul$(16)
                Method = hItem
            End If
        End Method
        Class Method AddFreeItem(ByVal hItem As Long)
            'add deleted item node to free item stack for reuse
            Local pItem As FStrListItemT Ptr
            boolExitIfFalse(hItem, Method, "hItem = null")
            pItem = mItemCache.Get(hItem)
            boolExitIfFalse(pItem, Method, "pItem = null")
            @pItem.hNext = mHdr.nextFreeItem
            mHdr.nextFreeItem = hItem
        End Method
    End Class
    stanthemanstan~gmail
    Dead Theory Walking
    Range Trie Tree
    HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

    Comment


    • #3
      Code:
      'FCache32C.inc
          'File Block Cache Manager Class
          '   only handles 32 byte blocks
          '   all file positions - ONE based - PowerBASIC default
          '
          '   instead of read/write to file
          '       use Get() to get a memory pointer to block
          '           modify memory block
          '           each accessed block always bumped to highest order in cache
          '
          '   use different cache for high/low priority items
          '       give high priority items; high CacheMax() value
          '           high priority items will always be in memory
      
      #Include Once "GMem1.inc"
      #Include Once "LongLongTree1.inc"
      %FCache32OrderMax = 2147483647
      %FCache32Min = 500
      Type FCache32Block
          buffer As String * 32
      End Type
      Type FCache32Item
          block As FCache32Block
          order As Long
          filePos As Long
          modified As Byte
      End Type
      Class  FCache32C
          Instance mCacheMax As Long
          Instance mFile As Long
          Instance mOrderCounter As Long
          Instance mFilePosTree As LongLongTree Ptr
          Instance mOrderTree As LongLongTree Ptr
          Class Method Create()
              mFilePosTree = LongLongTreeAlloc()
              mOrderTree = LongLongTreeAlloc()
          End Method
          Class Method Destroy()
              LongLongTreeFree mFilePosTree
              LongLongTreeFree mOrderTree
          End Method
          Interface FCache32I
              Inherit IUnknown
              Method Open(ByVal hFile As Long, ByVal cacheMax As Long)
                  'hFile = open binary file handle
                  'blockSize = byte size of each block - cache only handles one size
                  'cacheMax = maximum number of items allowed in cache - cache flushes excess when max reached
                  mFile = hFile
                  mCacheMax = Max&(cacheMax, %FCache32Min)
                  mOrderCounter = 0
              End Method
              Method Close()
                  'flush cache - free resources
                  me.Flush()
                  Local hNode As Long
                  hNode = LongLongTreeFirst(mFilePosTree)
                  While hNode
                      me.ItemFree(LongLongTreeGetValueAt(hNode))
                      hNode = LongLongTreeNext(hNode)
                  Wend
                  LongLongTreeClear mFilePosTree
                  LongLongTreeClear mOrderTree
              End Method
              Method Get(ByVal filePos As Long) As Long
                  'load block at filePos into cache - return memory pointer to block
                  '   give each new request the highest order in the cache
                  '       may already be in cache - bump to highest order
                  Local pi As FCache32Item Ptr
                  boolExitIfTrue(filePos < 1, Method, "filePos < 1")
                  boolExitIfTrue(filePos + 31 > Lof(mFile), Method, "filePos past End-Of-File")
                  pi = LongLongTreeGet(mFilePosTree, filePos) 'may already be in cache
                  If pi Then
                      'already in cache - bump to highest order
                      LongLongTreeRemove mOrderTree, @pi.order
                      @pi.order = me.HighestOrder()
                      @pi.modified = boolTrue
                      LongLongTreeSet(mOrderTree, @pi.order, pi)
                      Method = pi
                  Else
                      pi = me.ItemAlloc()
                      boolExitIfFalse(pi, Method, "cache item allocation failed")
                      Get mFile, filePos, @pi.block
                      @pi.filePos = filePos
                      @pi.modified = boolTrue
                      @pi.order = me.HighestOrder()
                      LongLongTreeSet(mFilePosTree, @pi.filePos, pi)
                      LongLongTreeSet(mOrderTree, @pi.order, pi)
                      me.FlushExcess() 'we may be over cache maximim
                      Method = pi
                  End If
              End Method
              Method Flush()
                  'write all blocks in cache to file
                  Local hNode As Long
                  Local pi As FCache32Item Ptr
                  hNode = LongLongTreeFirst(mFilePosTree)
                  While hNode
                      pi = LongLongTreeGetValueAt(hNode)
                      If @pi.modified Then
                          Put mFile, @pi.filePos, @pi.block
                          @pi.modified = boolFalse
                      End If
                      hNode = LongLongTreeNext(hNode)
                  Wend
                  Flush mFile
              End Method
              Method FlushSome(ByVal Count As Long)
                  'write some blocks in cache to file
                  '   write a few blocks at slow moments so whole cache doesn't need to be written on Close()
                  Local hNode As Long
                  Local pi As FCache32Item Ptr
                  hNode = LongLongTreeFirst(mFilePosTree)
                  While Count > 0 And hNode
                      pi = LongLongTreeGetValueAt(hNode)
                      If @pi.modified Then
                          Put mFile, @pi.filePos, @pi.block
                          @pi.modified = boolFalse
                          Decr Count
                      End If
                      hNode = LongLongTreeNext(hNode)
                  Wend
              End Method
          End Interface '-----------------
          Class Method HighestOrder() As Long
              Incr mOrderCounter
              If mOrderCounter <= %FCache32OrderMax Then
                  Method = mOrderCounter
              Else
                  me.RolloverOrderNumber()
                  Incr mOrderCounter
                  Method = mOrderCounter
              End If
          End Method
          Class Method RolloverOrderNumber() As Long
              'rollover all cache order numbers if we should every hit the max, 2,147,483,647
              mOrderCounter = 0
              Local pNode As LongLongTreeNode Ptr
              pNode = LongLongTreeFirst(mOrderTree)
              While pNode
                  Incr mOrderCounter
                  @pNode.k = mOrderCounter
                  Local pi As FCache32Item Ptr
                  pi = @pNode.v
                  @pi.order = mOrderCounter
                  pNode = LongLongTreeNext(pNode)
              Wend
          End Method
          Class Method FlushExcess()
              'write items to file if cache if over maximum
              Local hNode As Long
              Local pi As FCache32Item Ptr
              While @mOrderTree.count > mCacheMax
                  hNode = LongLongTreeFirst(mOrderTree)
                  boolExitIfFalse(hNode, Method, "null node handle")
                  pi = LongLongTreeGetValueAt(hNode)
                  boolExitIfFalse(pi, Method, "null cache item pointer")
                  LongLongTreeRemove mFilePosTree, @pi.filePos
                  Put  mFile, @pi.filePos, @pi.block
                  LongLongTreeRemove mOrderTree, @pi.order
                  me.ItemFree(pi)
              Wend
          End Method
          Class Method ItemAlloc() As Long
              'allocate cache item - return pointer
              Method = GMemAlloc(SizeOf(FCache32Item))
          End Method
          Class Method ItemFree(ByVal pi As FCache32Item Ptr) As Long
              'free allocated cache item
              If pi Then
                  pi = GMemFree(pi)
              End If
              Method = 0
          End Method
      End Class
      stanthemanstan~gmail
      Dead Theory Walking
      Range Trie Tree
      HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

      Comment


      • #4
        Code:
        'FStr32C.inc
        'pb 5/9
            'File Based Dynamic String Storage Class
            '   - strings may be any length
            '   - any kind of data; null OK
            '   - any number of strings may be added/deleted
            '   - reuses deleted blocks
            '
            '   strings split over 32 byte file blocks
            '   blocks stored in cache for fast access
            '
            '   may use more than one object instance on same file; (can't share same header: FStr32HeaderT)
            '       Key:  high cache value for fast access
            '       Data: small cache value
            '
            '   BE SURE TO CALL Close() before closing file handle
            '
            '   stored string referenced with LONG handle (file position to string's first block)
            '       user must retain each stored string's handle for use when file reopened
            '
            '   user responsible for storing FStr32HeaderT structure
            '       keeps track of freed file blocks for reuse
            '       DON'T share same FStr32HeaderT with another FStr32C object
            '           more than one cache will be writing to same block
            '
            '   file positions assumed to be PowerBASIC default; BASE = 1
        %FStr32BlockSize = 32
        %FStr32FirstLen = %FStr32BlockSize - 8
        %FStr32NextLen = %FStr32BlockSize - 4
        #Include Once "GMem1.inc"
        #Include Once "FCache32C.inc"
        Type FStr32FreeBlockT
            Next As Long
            deadSpace As String * (%FStr32BlockSize - 4)
        End Type
        Type FStr32FirstT
            Next As Long  'file position next block - if needed
            Count As Long 'string len
            str As String * %FStr32FirstLen
        End Type
        Type FStr32NextT
            Next As Long  'file position next block - if needed
            str As String * %FStr32NextLen
        End Type
        Type FStr32HeaderT   '(4 bytes) - header needs to be stored to keep track of freed blocks when file is reopened
            nextFree As Long
        End Type
        Class FStr32C
            Instance mPHdr As FStr32HeaderT Ptr
            Instance mFile As Long
            Instance mCache As FCache32I
            Class Method Create()
                mCache = Class "FCache32C"
            End Method
            Interface FStr32I
                Inherit IUnknown
                Method Open(ByVal hFile As Long, ByVal pStrFileHeader As FStr32HeaderT Ptr, ByVal cacheMax As Long)
                    'MUST call Open() before using class
                    '   hFile = open binary file
                    '       file must remain open until Close() called
                    '
                    'pStrFileHeader = pointer to FStr32HeaderT UDT
                    '   FStr32HeaderT must be stord in file, or separate file
                    '       keeps track of blocks that have been freed
                    '           freed blocks are reused
                    '
                    'cacheMax = maximum number of string blocks to hold in cache
                    '   32 bytes per block + cache manager overhead
                    If hFile And pStrFileHeader Then
                        mPHdr = pStrFileHeader
                        mFile = hFile
                        mCache.Open(hFile, cacheMax)
                    End If
                End Method
                Method Close()
                    'write everything to disk - free resources
                    If mFile Then
                        mCache.Close()
                    End If
                End Method
                Method Length(ByVal hStr As Long) As Long
                    'get length of stored string
                    If mFile And hStr Then
                        Local pFirst As FStr32FirstT Ptr
                        pFirst = mCache.Get(hStr)
                        If pFirst Then Method = @pFirst.Count
                    End If
                End Method
                Method Set(ByRef s As String) As Long
                    'store new string - return handle
                    '   handle = string's first block file position
                    'Note: if s = "" then Method = zero : null strings not stored
                    Local strLen, strPos, filePos, returnValue As Long
                    Local pFirst As FStr32FirstT Ptr
                    Local pNext As FStr32NextT Ptr
                    strLen = Len(s)
                    If mFile And strLen > 0 Then
                        strPos = 1
                        filePos = me.NewBlock()
                        returnValue = filePos 'return string's first block
                        pFirst = mCache.Get(filePos)
                        boolExitIfFalse(pFirst, Method, " mCache.Get(filePos) failed")
                        @pFirst.Count = strLen
                        @pFirst.str = Mid$(s, strPos, Min&(%FStr32FirstLen, strLen))
                        strLen -= %FStr32FirstLen
                        strPos += %FStr32FirstLen
                        If strLen > 0 Then
                            filePos = me.NewBlock()
                            @pFirst.next = filePos
                        End If
                        While strLen > 0
                            pNext = mCache.Get(filePos)
                            boolExitIfFalse(pFirst, Method, " mCache.Get(filePos) failed")
                            @pNext.str = Mid$(s, strPos, Min&(%FStr32NextLen, strLen))
                            strLen -= %FStr32NextLen
                            strPos += %FStr32NextLen
                            If strLen > 0 Then
                                filePos = me.NewBlock()
                                @pNext.next = filePos
                            End If
                        Wend
                        Method = returnValue
                    End If
                End Method
                Method Get(ByVal hStr As Long) As String
                    'get stored string
                    Local s As String
                    Local strLen, filePos As Long
                    Local pFirst As FStr32FirstT Ptr
                    Local pNext As FStr32NextT Ptr
                    If mFile And hStr Then
                        pFirst = mCache.Get(hStr)
                        boolExitIfFalse(pFirst, Method, "mCache.Get(hStr) failed")
                        strLen = @pFirst.count
                        s += Left$(@pFirst.str, Min&(strLen, %FStr32FirstLen))
                        filePos = @pFirst.next
                        strLen -= %FStr32FirstLen
                        While strLen > 0
                            pNext = mCache.Get(filePos)
                            boolExitIfFalse(pFirst, Method, "mCache.Get(filePos) failed")
                            s += Left$(@pNext.str, Min&(strLen, %FStr32NextLen))
                            filePos = @pNext.next
                            strLen -= %FStr32NextLen
                        Wend
                        Method = s
                    End If
                End Method
                Method Delete(ByVal hStr As Long) As Long
                    'delete string
                    '   free string's storage area
                    '       hStr = oStr.Remove(hStr)
                    Local filePos, filePos2 As Long
                    Local pFirst As FStr32FirstT Ptr
                    Local pNext As FStr32NextT Ptr
                    If mFile And hStr Then
                        pFirst = mCache.Get(hStr)
                        boolExitIfFalse(pFirst, Method, "mCache.Get(hStr) failed")
                        filePos = @pFirst.next
                        me.AddFreeBlock(hStr)
                        While filePos
                            pNext = mCache.Get(filePos)
                            boolExitIfFalse(pNext, Method, "mCache.Get(filePos) failed")
                            filePos2 = @pNext.next
                            me.AddFreeBlock(filePos)
                            filePos = filePos2
                        Wend
                    End If
                End Method
                Method Compare(ByVal hStr As Long, ByRef sB As String) As Long
                    'compare file string with string variable - case sensitive
                    '   hStr = s : Method = 0
                    '   hStr < s : Method < 0
                    '   hStr > s : Method > 0
                    Local i, compare, strALen, strBLen, theEnd As Long
                    Local sA As String
                    Local pbAStr, pbBStr As Byte Ptr
                    strBLen = Len(sB)
                    If hStr = 0 Then
                        Method = IIf&(strBLen = 0, 1, -1)
                    ElseIf strBLen = 0 Then
                        Method = 1
                    Else
                        sA = me.Get(hStr)
                        strALen = Len(sA)
                        pbAStr = StrPtr(sA)
                        pbBStr = StrPtr(sB)
                        theEnd = Min&(strALen, strBLen) - 1
                        For i = 0 To theEnd
                            compare = @pbAStr[i] - @pbBStr[i]
                            If compare Then
                                Method = compare : Exit Method
                            End If
                        Next i
                    End If
                    Method = strALen - strBLen
                End Method
                Method CompareNoCase(ByVal hStr As Long, ByRef sB As String) As Long
                    'compare file string with string variable - ignore case
                    '   hStr = s : Method = 0
                    '   hStr < s : Method < 0
                    '   hStr > s : Method > 0
                    Local i, compare, charA, charB, strALen, strBLen, theEnd As Long
                    Local sA As String
                    Local pbAStr, pbBStr As Byte Ptr
                    strBLen = Len(sB)
                    If hStr = 0 Then
                        Method = IIf&(strBLen = 0, 1, -1)
                    ElseIf strBLen = 0 Then
                        Method = 1
                    Else
                        sA = me.Get(hStr)
                        strALen = Len(sA)
                        pbAStr = StrPtr(sA)
                        pbBStr = StrPtr(sB)
                        theEnd = Min&(strALen, strBLen) - 1
                        For i = 0 To theEnd
                            charA = @pbAStr[i] : If charA > 96 And charA < 123 Then charA -= 32
                            charB = @pbBStr[i] : If charB > 96 And charB < 123 Then charB -= 32
                            compare = charA - charB
                            If compare Then
                                Method = compare : Exit Method
                            End If
                        Next i
                    End If
                    Method = strALen - strBLen
                End Method
            End Interface '----------------
            Class Method NewBlock() As Long
                'get file position of new block of memory
                Local filePos As Long
                filePos = me.GetFreeBlock()
                If filePos Then
                    Method = filePos
                Else
                    filePos = Lof(mFile) + 1
                    Seek mFile, filePos
                    Put$ mFile, Nul$(%FStr32BlockSize)
                    Method = filePos
                End If
            End Method
            Class Method GetFreeBlock() As Long
                Local filePos As Long
                filePos = @mPHdr.nextFree
                If filePos Then
                    Local pFree As FStr32FreeBlockT Ptr
                    pFree = mCache.Get(filePos)
                    If pFree Then
                        @mPHdr.nextFree = @pFree.next
                        Poke$ pFree, Nul$(%FStr32BlockSize) 'null block
                        Method = filePos
                    End If
                End If
            End Method
            Class Method AddFreeBlock(ByVal filePos As Long)
                Local pFree As FStr32FreeBlockT Ptr
                pFree = mCache.Get(filePos)
                If pFree Then
                    @pFree.next = @mPHdr.nextFree
                    @mPHdr.nextFree = filePos
                End If
            End Method
        End Class
        stanthemanstan~gmail
        Dead Theory Walking
        Range Trie Tree
        HLib ~ Free Data Container Lib ~ Arrays, Lists, Stacks, Queues, Deques, Trees, Hashes

        Comment

        Working...
        X