WaBis

walter.bislins.ch

Datei: xmailutil.inc

Inhalt der Datei: ./asp/xmail/xmailutil.inc
<%
' xmailutil: Copyright (C) 2008 Walter Bislin
' some helper functions and classes copied together from the following modules
' to make xmail.inc independent from any other modules:
'
' includes from
' - perf.inc: http://walter.bislins.ch/projekte/asp/perf/
' - pattern.inc: http://walter.bislins.ch/projekte/asp/pattern/
'
' exports:
' - class CDynArray
' - class CStream
' - some pattern functions
'

const CDA_MIN_CHUNK_SIZE = 128
const CDA_MAX_CHUNK_INCREMENT = 4096

class CDynArray
  private Chunk ' Array of any
  private ChunkSize
  private ChunkFill

  property Get LastIx
    LastIx = ChunkFill - 1
  end property

  property Get Size
    Size = ChunkFill
  end property

  private sub Class_Initialize()
    Clear
  end sub

  sub Clear()
    Chunk = Array()
    ChunkSize = 0
    ChunkFill = 0
  end sub

  sub SetSizeEstimate( aSize )
    ' give a hint how big the array could grow, if you know
    ' clears the DynArray!
    ' require aSize > 0
    ChunkSize = aSize
    redim Chunk( ChunkSize-1 )
    ChunkFill = 0
  end sub

  private sub EnlargeArray()
    dim increment
    ' resize chunk
    increment = ChunkSize
    if increment < CDA_MIN_CHUNK_SIZE then increment = CDA_MIN_CHUNK_SIZE
    if increment > CDA_MAX_CHUNK_INCREMENT then increment = CDA_MAX_CHUNK_INCREMENT
    ChunkSize = ChunkSize + increment
    redim preserve Chunk(ChunkSize-1)
  end sub

  sub AddItem( aItem )
    ' assert ChunkFill <= ChunkSize
    if ChunkFill = ChunkSize then EnlargeArray
    ' assert ChunkFill < ChunkSize
    Chunk(ChunkFill) = aItem
    ChunkFill = ChunkFill + 1
  end sub

  sub AddObject( aObject )
    ' use this function for object type items instead of AddItem()
    ' assert ChunkFill <= ChunkSize
    if ChunkFill = ChunkSize then EnlargeArray
    ' assert ChunkFill < ChunkSize
    set Chunk(ChunkFill) = aObject
    ChunkFill = ChunkFill + 1
  end sub

  function GetItem( aIx )
    ' require ValidIndex(aIx)
    GetItem = Chunk(aIx)
  end function

  function GetObject( aIx )
    ' use this function for object type items instead of GetItem()
    ' require ValidIndex(aIx)
    set GetObject = Chunk(aIx)
  end function

  sub SetItem( aIx, aItem )
    ' require ValidIndex(aIx)
    Chunk(aIx) = aItem
  end sub

  sub SetObject( aIx, aObject )
    ' use this function for object type items instead of SetItem()
    ' require ValidIndex(aIx)
    set Chunk(aIx) = aObject
  end sub

  function ValidIndex( aIx )
    ValidIndex = (aIx >= 0 and aIx < ChunkFill)
  end function

  function GetArray( bClear )
    ' returns all added items in an array of the correct size
    ' clears the DynArray if bClear is true
    if ChunkSize > ChunkFill then
      redim preserve Chunk( ChunkFill-1 )
      ChunkSize = ChunkFill
    end if
    GetArray = Chunk
    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
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 Chunk ' Array of any
  private ChunkSize
  private ChunkFill
  private SizeEstimate

  private sub Class_Initialize()
    SizeEstimate = CST_CHUNK_SIZE
    Clear
  end sub

  sub Clear()
    Chunk = Array("")
    ChunkSize = 1
    ChunkFill = 1
  end sub

  private sub Compress(bFinal)
    dim s
    ' assert ChunkFill > 0
    if ChunkFill > 1 then
      ' Note: shrinking of Chunk before Join is not neccessary
      ' if ChunkFill < ChunkSize then
      '   redim preserve Chunk(ChunkFill-1)
      ' end if
      s = Join( Chunk, "" )
    else
      s = Chunk(0)
    end if
    if bFinal then
      Chunk = Array(s)
      ChunkSize = 1
      ChunkFill = 1
    else
      redim Chunk( SizeEstimate-1 )
      ChunkSize = SizeEstimate
      ChunkFill = 1
      Chunk(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 ChunkFill <= ChunkSize
    if ChunkFill = ChunkSize then Compress false
    ' assert ChunkFill < ChunkSize
    Chunk(ChunkFill) = aStr
    ChunkFill = ChunkFill + 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

  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 = Chunk(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

'----------------------------------
' Pattern functions

function ReplacePattern( aString, aPattern, aReplace, bIgnoreCase )
  dim re
  set re = new RegExp
  re.Global = true
  re.Multiline = true
  re.IgnoreCase = bIgnoreCase
  re.Pattern = aPattern
  ReplacePattern = re.Replace( aString, aReplace )
end function

function ReplaceWithinPattern( aString, aPattern, aFindPattern, aReplace, bIgnoreCase )
  ' x = ReplaceWithinPattern( x, "(<.*?>)", "\:", "|" )
  ' ersetzt in x alle : durch |, jedoch nur jene, welche zwischen < und > stehen!
  dim re
  set re = new RegExp
  re.Global = true
  re.Multiline = false
  re.IgnoreCase = bIgnoreCase
  re.Pattern = aPattern
  gFindPattern = aFindPattern
  gReplace = aReplace
  gIgnoreCase = bIgnoreCase
  ReplaceWithinPattern = re.Replace( aString, GetRef("reReplaceWithinPattern") )
end function

dim gFindPattern, gReplace, gIgnoreCase

function reReplaceWithinPattern(match,p1,pos,source)
  reReplaceWithinPattern = ReplacePattern(p1,gFindPattern,gReplace,gIgnoreCase)
end function

%>

More Page Infos / Sitemap
Created Dienstag, 18. Oktober 2011
Scroll to Top of Page
Changed Dienstag, 3. November 2020