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