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
Leave a comment: