查看: 15  |  回复: 0
  VB6 使用正则表达式(使用搜索/替换、匹配集合、子匹配集合)
楼主
发表于 2025年8月31日 14:08

本文将向您展示如何使用正则表达式执行一些复杂的搜索和正则表达式替换任务。此演示将向您展示如何使用 Matches 和 SubMatches 集合来获取输入字符串中的所有匹配项和单个匹配中的 SubMatches。    

'/////////////////////////////////////////////////
'//RegX Demo
'/////////////////////////////////////////////////

Private Sub Form_Load()
  '// Search and Replace Demo. This demo will make keyword link for Google
  MsgBox (SearchReplaceRegX("This is RegX demo. <span>VB Stuff is kool VC also kool and ASP dam Kool</span>. Try it" _
      , "\b(VB|VC|ASP)\b" _
      , "<A HREF='http://www.google.com/q=$1'>$1</A>"))

  '//Match Collection Demo
  MsgBox (RegExpTest("is.", "IS1 is2 IS3 is4"))

  '//Sub Match Collection Demo
  MsgBox (SubMatchTest("Please send mail to 123@abc.com. Thanks!"))
End Sub

Function SearchReplaceRegX(inputStr, SearchPattern, ReplacePattern) As String
  Dim str, objRegExp
  str = inputStr
  Set objRegExp = CreateObject("VBScript.RegExp")

  '//Change All Occurances ?
  objRegExp.Global = True

  '//this pattern makes sure it does not modify phrases that are already in <A> tags
  objRegExp.Pattern = SearchPattern

  '//Use following code to get all matches
  'Set objMatches = objRegExp.Execute(str)
  'For Each match In objMatches
  '  Debug.Print match
  'Next

  '//You can use following to test your RegEx --It will return True if Match
  'Debug.Print objRegExp.Test(str)

  str = objRegExp.Replace(str, ReplacePattern)
  SearchReplaceRegX = str

End Function

'//Example to find all Sub matches in a match
Function SubMatchTest(inpStr)
  Dim oRe, oMatch, oMatches
  'Set oRe = New RegExp
  Set oRe = CreateObject("VBScript.RegExp")

  ' Look for an e-mail address (not a perfect RegExp)
  oRe.Pattern = "(\w+)@(\w+)\.(\w+)"
  ' Get the Matches collection
  Set oMatches = oRe.Execute(inpStr)

  ' Get the first item in the Matches collection
  Set oMatch = oMatches(0)
  ' Create the results string.
  ' The Match object is the entire match - dragon@xyzzy.com
  retStr = "Email address is: " & oMatch & vbNewLine
  ' Get the sub-matched parts of the address.
  retStr = retStr & "Email alias is: " & oMatch.SubMatches(0)  ' dragon
  retStr = retStr & vbNewLine
  retStr = retStr & "Organization is: " & oMatch.SubMatches(1)  ' xyzzy
  SubMatchTest = retStr
End Function

Function RegExpTest(patrn, strng)
  Dim regEx, Match, Matches, I              ' Create variable.
  'Set regEx = New RegExp  ' Create regular expression.
  Set regEx = CreateObject("VBScript.RegExp")

  regEx.Pattern = patrn                 ' Set pattern.
  regEx.IgnoreCase = True                ' Set case insensitivity.
  regEx.Global = True                  ' Set global applicability.

  Set Matches = regEx.Execute(strng)           ' Execute search.
  For Each Match In Matches               ' Iterate Matches collection.
    I = I + 1
    retStr = retStr & "Match " & I & " found at position "
    retStr = retStr & Match.FirstIndex & ". Match Value is "  '
    retStr = retStr & Match.Value & "'." & vbCrLf
  Next
  RegExpTest = retStr
End Function


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2025 MaNongKu.com