将唯一的锚点添加到文本中的正则表达式匹配

Question

我使用 vbs 正则表达式来突出显示文本中的搜索匹配项，并尝试弄清楚如何将突出显示的垃圾邮件与唯一 ID 锚点结合起来以从匹配项列表中建立超链接。

我尝试了一个 for IncrementCount = 1 到 match.count 循环，但是 return 所有匹配项的总数。

Function HighlightText(strInput,arrtext)
    Set re = New RegExp 
    re.Pattern="(?!<.*?)(" & arrtext & ")(?![^<>]*?>)" 
    re.IgnoreCase = True 
    re.Global = True
         if arrtext <> "" then 
         strOutput = re.Replace(strInput,"<span id="""&IncrementCount&""" style=""background-color:#FFD200;"">"&""&"$&</span>")
         Else
         strOutput = strInput
         end if
    HighlightText = strOutput
    set re = nothing
end function

Answer 1

据我所知，在 vbScript 中使用 RegExp.Replace 时无法获取匹配号。因此，您必须使用 RegExp.Execute 方法来获取一组匹配项，然后自己处理每个匹配项。

这是一些我认为可以满足您要求的示例代码。它使用正则表达式给出匹配集合，标识输入字符串中需要替换的位置，然后使用标准 vbScript 函数 Left() 和 Mid() 在正确的位置截断字符串并插入所需的跨度.请注意，它以相反的顺序处理匹配项，因此 chop/insert 可以使用原始匹配项的索引，而不必担心输出字符串中已经被替换的内容。

另外请注意，如果这是用户输入，您可能需要预处理匹配字符串，因为用户可能会键入在正则表达式中很重要的字符。

这当然不如使用 RegExp.Replace 高效，但它确实为每个匹配项提供了相关的唯一 ID。

'// Function finds all occurrences of a string 
'// (or multiple strings separated by |) within 
'// an input string, and places a <span> tag
'// with a unique numbered id around each occurrence
Function HighlightText(strInput,sFind)

    '// Don't do anything of no string to be found
    If len(sFind) = 0 then
        HighlightText = strInput
        Exit Function
    end If

    '// Define regexp
    Dim re
    Set re = New RegExp 

    '// Pattern to be found
    re.Pattern="(?!<.*?)(" & sFind & ")(?![^<>]*?>)" 
    re.IgnoreCase = True 
    re.Global = True

    '// find all the matches >> match collection
    Dim oMatches: Set oMatches = re.Execute( strInput )

    '// Prepare to process
    Dim sMatchedText
    Dim strOutput
    Dim oMatch
    Dim ix

    '// Initialize the output
    strOutput = strInput

    '// Process each match starting at the last one
    '// - this avoids needing to recalculate indexes
    '// after each replacement
    For ix = oMatches.Count -1 to 0 Step -1

        '// get the match
        Set oMatch = oMatches(ix)

        '// get the text that was matched
        sMatchedText = oMatch.SubMatches(0)

        '//DEBUG -- CONS.print "Match #" & ix & ": " & oMatch.Value & " At:" & cStr(oMatch.FirstIndex + 1)  & " Match:" & sMatchedText

        '// Replace the match in the output with the 
        '// required span tag, with unique match number as ID
        strOutput = Left(strOutput, oMatch.FirstIndex) & _
                    "<span id='MATCH#" & ix & "'>" & sMatchedText & "</span>" _
                    & Mid(strOutput, oMatch.FirstIndex + oMatch.length + 1)
    Next

    Set re = nothing

    '// Return the processed output
    HighlightText = strOutput

End Function

将唯一的锚点添加到文本中的正则表达式匹配

add unique anchors to regexp matches in text

vbscript

asp-classic