WaBis

walter.bislins.ch

Datei: pattern.inc

Inhalt der Datei: ./asp/pattern/pattern.inc
<%
' pattern.inc: Copyright (C) 2009 Walter Bislin
' http://walter.bislins.ch/doku/pattern
'
' pattern functions (optimized for speed via cache)
'
' Dependencies:
' - perf.inc
'

dim GPattern_RegExp, GPattern_LastPattern, GPattern_LastIC
dim GPattern_RegExp2, GPattern_LastPattern2, GPattern_LastIC2
dim GPattern_RegExpT, GPattern_LastPatternT, GPattern_LastICT
dim GPattern_Find, GPattern_Replace, GPattern_IgnoreCase, GPattern_ExtractResult

set GPattern_RegExp = new RegExp
GPattern_RegExp.Global = true
GPattern_RegExp.Multiline = true
GPattern_LastPattern = ""
GPattern_LastIC = false

set GPattern_RegExp2 = new RegExp
GPattern_RegExp2.Global = true
GPattern_RegExp2.Multiline = true
GPattern_LastPattern2 = ""
GPattern_LastIC2 = false

set GPattern_RegExpT = new RegExp
GPattern_RegExpT.Global = false
GPattern_RegExpT.Multiline = true
GPattern_LastPatternT = ""
GPattern_LastICT = false

set GPattern_ExtractResult = NewDynArray(0)

function NewRegExp( aPattern, bIgnoreCase )
  set NewRegExp = new RegExp
  NewRegExp.Global = true
  NewRegExp.Multiline = true
  NewRegExp.IgnoreCase = bIgnoreCase
  NewRegExp.Pattern = aPattern
end function

function ReplacePattern( aString, aPattern, aReplace, bIgnoreCase )
  if (GPattern_LastPattern <> aPattern) or (GPattern_LastIC <> bIgnoreCase) then
    GPattern_RegExp.IgnoreCase = bIgnoreCase
    GPattern_RegExp.Pattern = aPattern
    GPattern_LastPattern = aPattern
    GPattern_LastIC = bIgnoreCase
  end if
  ReplacePattern = GPattern_RegExp.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!
  ' x = ReplaceWithinPattern( x, "(<start>)([^\x00]*?)(<end>)", "<", "&lt;" )
  ' ersetzt in x alle < durch &lt;, jedoch nur jene, welche zwischen <start> und <end> stehen!
  ' Note: <start> und <end> bleiben erhalten, wenn sie geklammert werden!
  if (GPattern_LastPattern2 <> aPattern) or (GPattern_LastIC2 <> bIgnoreCase) then
    GPattern_RegExp2.IgnoreCase = bIgnoreCase
    GPattern_RegExp2.Pattern = aPattern
    GPattern_LastPattern2 = aPattern
    GPattern_LastIC2 = bIgnoreCase
  end if
  GPattern_Find = aFindPattern
  GPattern_Replace = aReplace
  GPattern_IgnoreCase = bIgnoreCase
  if Left(aPattern,1) = "(" and Right(aPattern,1) = ")" and InStr(aPattern,")(") then
    ReplaceWithinPattern = GPattern_RegExp2.Replace( aString, GetRef("GPattern_ReplaceWithinPattern2") )
  else
    ReplaceWithinPattern = GPattern_RegExp2.Replace( aString, GetRef("GPattern_ReplaceWithinPattern") )
  end if
end function

function GPattern_ReplaceWithinPattern(match,p1,pos,source)
  GPattern_ReplaceWithinPattern = ReplacePattern(p1,GPattern_Find,GPattern_Replace,GPattern_IgnoreCase)
end function

function GPattern_ReplaceWithinPattern2(match,p1,p2,p3,pos,source)
  GPattern_ReplaceWithinPattern2 = p1 & ReplacePattern(p2,GPattern_Find,GPattern_Replace,GPattern_IgnoreCase) & p3
end function

function TestPattern( aString, aPattern, bIgnoreCase )
  if (GPattern_LastPatternT <> aPattern) or (GPattern_LastICT <> bIgnoreCase) then
    GPattern_RegExpT.IgnoreCase = bIgnoreCase
    GPattern_RegExpT.Pattern = aPattern
    GPattern_LastPatternT = aPattern
    GPattern_LastICT = bIgnoreCase
  end if
  TestPattern = GPattern_RegExpT.Test(aString)
end function

function ExtractPattern( aStr, aPattern )
  dim x
  if (GPattern_LastPattern <> aPattern) or (GPattern_LastIC <> true) then
    GPattern_RegExp.IgnoreCase = true
    GPattern_RegExp.Pattern = aPattern
    GPattern_LastPattern = aPattern
    GPattern_LastIC = true
  end if
  x = GPattern_RegExp.Replace( aStr, GetRef("GPattern_ExtractPattern") )
  ExtractPattern = GPattern_ExtractResult.GetArray(true)
end function

function ExtractPatternCase( aStr, aPattern )
  dim x
  if (GPattern_LastPattern <> aPattern) or (GPattern_LastIC <> false) then
    GPattern_RegExp.IgnoreCase = false
    GPattern_RegExp.Pattern = aPattern
    GPattern_LastPattern = aPattern
    GPattern_LastIC = false
  end if
  x = GPattern_RegExp.Replace( aStr, GetRef("GPattern_ExtractPattern") )
  ExtractPatternCase = GPattern_ExtractResult.GetArray(true)
end function

function GPattern_ExtractPattern(match,p1,pos,source)
  if IsEmpty(p1) then p1 = ""
  GPattern_ExtractResult.AddItem p1
  GPattern_ExtractPattern = match
end function

function ExtractPattern1( aStr, aPattern )
  ' calls ExtractPattern but returns only the first element or "" if there are none
  dim colMatches
  colMatches = ExtractPattern( aStr, aPattern )
  if UBound(colMatches) >= 0 then
    ExtractPattern1 = colMatches(0)
  else
    ExtractPattern1 = ""
  end if
end function

' CReplacer: class to handle multiple ReplacePattern at once --------------------

class CReplacer
  private mRegExpList
  private mReplaceList

  private sub Class_Initialize()
    mRegExpList = Array()
    mReplaceList = Array()
  end sub

  sub AddReplacer( aPattern, aReplace, bIgnoreCase )
    dim re, pos
    set re = NewRegExp( aPattern, bIgnoreCase )
    pos = UBound(mRegExpList) + 1
    redim preserve mRegExpList(pos)
    redim preserve mReplaceList(pos)
    set mRegExpList(pos) = re
    mReplaceList(pos) = aReplace
  end sub

  function ReplaceAll( aText )
    dim i
    ReplaceAll = aText
    if aText = "" then exit function
    for i = 0 to UBound(mRegExpList)
      ReplaceAll = mRegExpList(i).Replace( ReplaceAll, mReplaceList(i) )
    next
  end function
end class

%>

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