<%
' 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

%>