<% ' perf: Copyright (C) 2008 Walter Bislin ' http://walter.bislins.ch/projekte/asp/perf/ ' ' some classes that boost performance with huge dynamic strings or arrays const CDA_MIN_CHUNK_SIZE = 128 const CDA_MAX_CHUNK_INCREMENT = 4096 class CDynArray public IgnoreCase private mChunk ' Array of any private mChunkSize private mChunkFill property Get LastIx LastIx = mChunkFill - 1 end property property Get Size Size = mChunkFill end property property Get Chunk ' returns working array for usage in AddSubArray and AddObjSubArray Chunk = mChunk end property private sub Class_Initialize() IgnoreCase = true Clear end sub sub Clear() mChunk = Array() mChunkSize = 0 mChunkFill = 0 end sub sub UseArray( aArray ) mChunk = aArray mChunkSize = UBound(aArray) + 1 mChunkFill = mChunkSize end sub sub SetSizeEstimate( aSize ) ' give a hint how big the array could grow, if you know ' clears the DynArray! ' require aSize > 0 mChunkSize = aSize redim mChunk( mChunkSize-1 ) mChunkFill = 0 end sub private sub EnlargeChunk() dim increment ' resize mChunk increment = mChunkSize if increment < CDA_MIN_CHUNK_SIZE then increment = CDA_MIN_CHUNK_SIZE if increment > CDA_MAX_CHUNK_INCREMENT then increment = CDA_MAX_CHUNK_INCREMENT mChunkSize = mChunkSize + increment redim preserve mChunk(mChunkSize-1) end sub sub AddItem( aItem ) ' assert mChunkFill <= mChunkSize if mChunkFill = mChunkSize then EnlargeChunk ' assert mChunkFill < mChunkSize mChunk(mChunkFill) = aItem mChunkFill = mChunkFill + 1 end sub sub AddObject( aObject ) ' use this function for object type items instead of AddItem() ' assert mChunkFill <= mChunkSize if mChunkFill = mChunkSize then EnlargeChunk ' assert mChunkFill < mChunkSize set mChunk(mChunkFill) = aObject mChunkFill = mChunkFill + 1 end sub function GetItem( aIx ) ' require ValidIndex(aIx) GetItem = mChunk(aIx) end function function GetObject( aIx ) ' use this function for object type items instead of GetItem() ' require ValidIndex(aIx) set GetObject = mChunk(aIx) end function sub SetItem( aIx, aItem ) ' require ValidIndex(aIx) mChunk(aIx) = aItem end sub sub SetObject( aIx, aObject ) ' use this function for object type items instead of SetItem() ' require ValidIndex(aIx) set mChunk(aIx) = aObject end sub function ValidIndex( aIx ) ValidIndex = (aIx >= 0 and aIx < mChunkFill) end function function GetArray( bClear ) ' returns all added items in an array of the correct size ' clears the DynArray if bClear is true if mChunkSize > mChunkFill then redim preserve mChunk( mChunkFill-1 ) mChunkSize = mChunkFill end if GetArray = mChunk if bClear then Clear end function function JoinItems( aSep, bClear ) ' joins all items and returns the resulting big string ' clears the DynArray if bClear = true! ' note: if bClear is false, the array can be further expanded! JoinItems = Join( GetArray(bClear), aSep ) end function ' some more functions with arrays function FindString( aString ) ' finds string aItem in array and returns his index or -1 if not found ' see also property IgnoreCase dim i, last, ic ic = 0 if IgnoreCase then ic = 1 last = mChunkFill - 1 for i = 0 to last if StrComp(mChunk(i),aString,ic) = 0 then FindString = i exit function end if next FindString = -1 end function sub AddItemBefore( aItem, aIndex ) ' assert mChunkFill <= mChunkSize if aIndex < 0 or aIndex > mChunkFill then AddItem aItem exit sub end if if mChunkFill = mChunkSize then EnlargeChunk ' assert mChunkFill < mChunkSize ' make room for item dim i, iStop mChunkFill = mChunkFill + 1 iStop = aIndex + 1 for i = mChunkFill to iStop step -1 mChunk(i) = mChunk(i-1) next mChunk(aIndex) = aItem end sub sub AddObjectBefore( aObject, aIndex ) ' assert mChunkFill <= mChunkSize if aIndex < 0 or aIndex > mChunkFill then AddObject aObject exit sub end if if mChunkFill = mChunkSize then EnlargeChunk ' assert mChunkFill < mChunkSize ' make room for item dim i, iStop mChunkFill = mChunkFill + 1 iStop = aIndex + 1 for i = mChunkFill to iStop step -1 set mChunk(i) = mChunk(i-1) next set mChunk(aIndex) = aObject end sub sub AddNewString( aString ) ' adds aString if the string not yet exists in array if FindString(aString) < 0 then AddItem aString end sub sub MergeStrings( aStrArray ) ' adds all strings of aStrArray to thi array, but only if not yet exists ' aStrArray as array of string dim str for each str in aStrArray AddNewString str next end sub private function PrepareAddArray( aArray, aStart, aCount ) ' returns corrected aCount or 0 if nothing is to append ' ensures mChunkFill + PrepareAddArray <= mChunkSize dim minSize, al PrepareAddArray = 0 al = UBound(aArray) if al < 0 then exit function if aStart > al or aCount < 1 then exit function if aStart+aCount > al+1 then aCount = al+1-aStart minSize = mChunkFill + aCount if minSize >= mChunkSize then mChunkSize = minSize redim preserve mChunk(mChunkSize-1) end if ' assert mChunkFill + aCount <= mChunkSize PrepareAddArray = aCount end function sub AddSubArray( aArray, aStart, aCount ) ' aArray as array of items (not objects) dim i, j, last, n n = PrepareAddArray( aArray, aStart, aCount ) if n <= 0 then exit sub ' assert mChunkFill + n <= mChunkSize j = mChunkFill last = aStart + n - 1 for i = aStart to last mChunk(j) = aArray(i) j = j + 1 next mChunkFill = mChunkFill + n end sub sub AddObjSubArray( aArray, aStart, aCount ) ' aArray as array of objects dim i, j, last, n n = PrepareAddArray( aArray, aStart, aCount ) if n <= 0 then exit sub ' assert mChunkFill + n <= mChunkSize j = mChunkFill last = aStart + n - 1 for i = aStart to last set mChunk(j) = aArray(i) j = j + 1 next mChunkFill = mChunkFill + n end sub sub AddArray( aArray ) ' aArray as array of items (not objects) AddSubArray aArray, 0, UBound(aArray)+1 end sub sub AddObjArray( aArray ) ' aArray as array of objects AddObjSubArray aArray, 0, UBound(aArray)+1 end sub end class function NewDynArray( aSizeEstimate ) ' set aSizeEstimate = 0 if final size is not known set NewDynArray = new CDynArray if aSizeEstimate > 0 then NewDynArray.SetSizeEstimate aSizeEstimate end function '------------- const CST_CHUNK_SIZE = 512 class CStream private mChunk ' Array of any private mChunkSize private mChunkFill private SizeEstimate private sub Class_Initialize() SizeEstimate = CST_CHUNK_SIZE Clear end sub sub Clear() mChunk = Array("") mChunkSize = 1 mChunkFill = 1 end sub function IsEmpty() IsEmpty = ((mChunkFill = 1) and (Len(mChunk(0)) = 0)) end function private sub Compress(bFinal) dim s ' assert mChunkFill > 0 if mChunkFill > 1 then ' Note: shrinking of mChunk before Join is not neccessary ' if mChunkFill < mChunkSize then ' redim preserve mChunk(mChunkFill-1) ' end if s = Join( mChunk, "" ) else s = mChunk(0) end if if bFinal then mChunk = Array(s) mChunkSize = 1 mChunkFill = 1 else redim mChunk( SizeEstimate-1 ) mChunkSize = SizeEstimate mChunkFill = 1 mChunk(0) = s end if end sub sub SetSizeEstimate( aSize ) ' give a hint how big the array could grow, if you know ' require aSize >= 0 if aSize <= 0 then aSize = CST_CHUNK_SIZE-1 if aSize <= 1 then aSize = 1 ' assert aSize >= 1 SizeEstimate = aSize+1 end sub sub Add( aStr ) ' assert mChunkFill <= mChunkSize if mChunkFill = mChunkSize then Compress false ' assert mChunkFill < mChunkSize mChunk(mChunkFill) = aStr mChunkFill = mChunkFill + 1 end sub sub Add2( aStr1, aStr2 ) Add aStr1 Add aStr2 end sub sub Add3( aStr1, aStr2, aStr3 ) Add aStr1 Add aStr2 Add aStr3 end sub sub Add4( aStr1, aStr2, aStr3, aStr4 ) Add aStr1 Add aStr2 Add aStr3 Add aStr4 end sub sub AddNL( aStr ) ' adds an additional vbCRLF Add aStr Add vbCRLF end sub sub Add2NL( aStr1, aStr2 ) Add aStr1 Add aStr2 Add vbCRLF end sub sub Add3NL( aStr1, aStr2, aStr3 ) Add aStr1 Add aStr2 Add aStr3 Add vbCRLF end sub sub Add4NL( aStr1, aStr2, aStr3, aStr4 ) Add aStr1 Add aStr2 Add aStr3 Add aStr4 Add vbCRLF end sub function GetString( bClear ) ' returns joined strings and clears the stream ' set bClear to false, if this stream is not used any more or if more strings are appended later ' set bClear to true, if this stream is reused and should be cleared ' Note: bClear does not affect the returned string! Compress true GetString = mChunk(0) if bClear then Clear end function end class function NewStream( aSizeEstimate ) ' set aSizeEstimate = 0 if final number of strings to join is not known set NewStream = new CStream if aSizeEstimate > 0 then NewStream.SetSizeEstimate aSizeEstimate end function %>