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