regexp.asp

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

<%
'--------------------------------------------------------------------
' regexp.asp - regexp functions
'
' Copyright (c) 2006 - 2008 MOEx Group.
'
'
' update list: 2008/06/16
'              2008/08/05
'                1、preg_replace函数中，用RegExp的Replace方法来替换匹配到的属性
'              2008/11/17
'                1、简化reg_split函数，用Chr(1)替换匹配的字符，然后再根据Chr(1)分割字符串
'--------------------------------------------------------------------

'--------------------------------------------------------------------
' reg_test          - 检测指定字符串是否匹配一个正则表达式
'                   - 返回类型：Boolean
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function reg_test(ByVal strPattern, ByVal strGI, ByVal strData)
    Dim reg
    Set reg = New RegExp
    reg.Pattern = strPattern
    reg.IgnoreCase = CBool(InStr(strGI, "i") > 0)
    reg_test = reg.test(strData)
    Set reg = Nothing
End Function

'--------------------------------------------------------------------
' reg_match         - 返回一个正则表达式在指定字符串中匹配的第一个Match的SubMatches的元素的数组
'                   - 返回类型：Variant() Or Empty
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function reg_match(ByVal strPattern, ByVal strGI, ByVal strData)
    Dim reg, arr, ptr, ret, i
    Set reg = New RegExp
    reg.Pattern = strPattern
    reg.IgnoreCase = CBool(InStr(strGI, "i") > 0)
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        Set ptr = arr(0).SubMatches
        ReDim ret(ptr.Count - 1)
        For i = 0 To ptr.Count - 1
            ret(i) = ptr(i)
        Next
        Set ptr = Nothing
    End If
    Set arr = Nothing
    Set reg = Nothing
    reg_match = ret
End Function

'--------------------------------------------------------------------
' reg_matches       - 返回一个正则表达式在指定字符串中匹配的所有Match的SubMatches的元素的二维数组
'                   - 返回类型：Variant() Or Empty
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function reg_matches(ByVal strPattern, ByVal strGI, ByVal strData)
    Dim reg, arr, i, k
    Dim ret
    Set reg = New RegExp
    reg.Pattern = strPattern
    reg.Global = CBool(InStr(strGI, "g") > 0)
    reg.IgnoreCase = CBool(InStr(strGI, "i") > 0)
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        ReDim ret(arr(0).SubMatches.Count - 1, arr.Count - 1)
        For i = 0 To UBound(ret, 2)
            For k = 0 To UBound(ret)
                ret(k, i) = arr(i).SubMatches(k)
            Next
        Next
    End If
    Set arr = Nothing
    Set reg = Nothing
    reg_matches = ret
End Function

'--------------------------------------------------------------------
' reg_quote         - 返回一个非正则表达式的字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function reg_quote(ByVal strIn)
    Dim ret
    ret = strIn
    ret = Replace(ret, "\", "\\")
    ret = Replace(ret, ".", "\.")
    ret = Replace(ret, "^", "\^")
    ret = Replace(ret, "$", "\$")
    ret = Replace(ret, "(", "\(")
    ret = Replace(ret, ")", "\)")
    ret = Replace(ret, "[", "\[")
    ret = Replace(ret, "]", "\]")
    ret = Replace(ret, "*", "\*")
    ret = Replace(ret, "?", "\?")
    ret = Replace(ret, "!", "\!")
    ret = Replace(ret, "-", "\-")
    ret = Replace(ret, vbCr, "\r")
    ret = Replace(ret, vbLf, "\n")
    reg_quote = ret
End Function

'--------------------------------------------------------------------
' reg_split         - 返回一个正则表达式分割指定字符串的数组
'                   - 返回类型：Variant()
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function reg_split(ByVal strPattern, ByVal strGI, ByVal strData)
    Dim tmp, key
    key = Chr(1)
    tmp = reg_replace(strPattern, strGI, key, strData)
    reg_split = Split(tmp, key) 
End Function

'--------------------------------------------------------------------
' reg_replace       - 替换一个正则表达式在指定字符串中匹配的文本
'                   - 返回类型：String
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 替换的字符串(type: String)
'                   - arguments[3] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function reg_replace(ByVal strPattern, ByVal strGI, ByVal strRep, ByVal strData)
    Dim reg
    Set reg = New RegExp
    reg.Pattern = strPattern
    reg.Global = CBool(InStr(strGI, "g") > 0)
    reg.IgnoreCase = CBool(InStr(strGI, "i") > 0)
    reg_replace = reg.Replace(strData, strRep)
    Set reg = Nothing
End Function

'--------------------------------------------------------------------
' preg_replace      - 替换一个正则表达式在指定字符串中匹配的表达式
'                   - 返回类型：String
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 表达式(type: String)
'                   - arguments[3] = 字符串(type: String)
'e.g.
'Response.Write preg_replace("%([A-Fa-f0-9]{2})", "gi", "Chr(&H$1)", "==%48%49%50==")
'--------------------------------------------------------------------
Public Function preg_replace(ByVal strPattern, ByVal strGI, ByVal strExp, ByVal strData)
    Dim reg, arr, ptr, pos, i, k
    Dim ret, tmp
    Set reg = New RegExp
    reg.Pattern = strPattern
    reg.Global = CBool(InStr(strGI, "g") > 0)
    reg.IgnoreCase = CBool(InStr(strGI, "i") > 0)
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        ReDim tmp(arr.Count * 2)
        i = 0
        pos = 1
        For Each ptr In arr
            tmp(i) = "ret(" & i & ") = Mid(strData, " & pos & ", " & ptr.FirstIndex + 1 - pos & ")"
            i = i + 1
            pos = ptr.FirstIndex + 1 + ptr.Length
            tmp(i) = "ret(" & i & ") = " & reg.replace(ptr.value, strExp)
            i = i + 1
        Next
        tmp(i) = "ret(" & i & ") = Mid(strData, " & pos & ")"
        ReDim Preserve tmp(i)
        ReDim ret(i)
        Execute Join(tmp, vbCrLf)
        preg_replace = Join(ret, Empty)
    Else
        preg_replace = strData
    End If
    Set arr = Nothing
    Set reg = Nothing
End Function

'--------------------------------------------------------------------
' preg_replace2     - 替换一个正则表达式在指定字符串中匹配的表达式
'                   - 返回类型：String
'                   - arguments[0] = 正则表达式(type: String)
'                   - arguments[1] = 全局和大小写设置(type: String)
'                   - arguments[2] = 函数名称，函数的参数只有一个，即匹配到的Match对象(type: String)
'                   - arguments[3] = 字符串(type: String)
'e.g.
'Response.Write preg_replace2("%([A-Fa-f0-9]{2})", "gi", "Test", "==%48%49%50==")
'Function Test(match)
'    Test = Chr(CInt("&H" & match.SubMatches(0)))
'End Function
'--------------------------------------------------------------------
Public Function preg_replace2(ByVal strPattern, ByVal strGI, ByVal strFunc, ByVal strData)
    Dim reg, arr, ptr, pos, i
    Dim ret, tmp
    Set reg = New RegExp
    reg.Pattern = strPattern
    reg.Global = CBool(InStr(strGI, "g") > 0)
    reg.IgnoreCase = CBool(InStr(strGI, "i") > 0)
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        ReDim tmp(arr.Count * 2)
        i = 0
        pos = 1
        For Each ptr In arr
            tmp(i) = "ret(" & i & ") = Mid(strData, " & pos & ", " & ptr.FirstIndex + 1 - pos & ")"
            i = i + 1
            pos = ptr.FirstIndex + 1 + ptr.Length
            tmp(i) = "ret(" & i & ") = " & strFunc & "(arr(" & (i \ 2) & "))"
            i = i + 1
        Next
        tmp(i) = "ret(" & i & ") = Mid(strData, " & pos & ")"
        ReDim Preserve tmp(i)
        ReDim ret(i)
        Execute Join(tmp, vbCrLf)
        preg_replace2 = Join(ret, Empty)
    Else
        preg_replace2 = strData
    End If
    Set arr = Nothing
    Set reg = Nothing
End Function
%>