Announcement

**Stanley Durham** · 19 Jul 2009, 01:15 PM

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

**Stanley Durham** · 19 Jul 2009, 01:32 PM

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

**Stanley Durham** · 19 Jul 2009, 01:33 PM

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

Announcement

Forum Guidelines

File Based String List Class

PBWin/PBCC File Based String List Class

Comment

Comment

Comment