Fenying

Angus’ Home.


22 Aug 2009

在Visual Basic 6.0中使用正则表达式

该文章迁移自作者的旧博客站点。
源地址:http://fenying.blog.163.com/blog/static/102055993200972234516326/

今天下午把微软VBS的正则表达式库写成了几个实用函数。

将以下代码保存为Mod_RegExp.bas,添加到工程中即可使用。

Option Explicit

Rem <!-- File Mod_RegExp.bas Begin -->

'-------------------------------------------------------------
'File Name:     Mod_RegExp.bas
'Module Name:   Mod_RegExp
'Module Author: Fenying
'Time:          2009-08-22
'Using MicroSoft VBScript Regular Expressions Engine 5.5
'All CopyRight Fenying Studio 2007-2009 Reserved.
'To Get More...
'   http://fenying.blog.163.com
'-------------------------------------------------------------

'MatchCollection 对象说明:
'MatchCollection:匹配结果集。
'MatchCollection.Count:表示有多少个匹配结果。
'MatchCollection.Item(Index):获取指定结果(下标为 0 ~ Count - 1)。
'MatchCollection.Item(Index).Value:指定结果的内容。
'MatchCollection.Item(Index).FirstIndex:匹配结果字符串的起始位置。
'MatchCollection.Item(Index).Length:匹配结果字符串的长度。
'MatchCollection.Item(Index).SubMatches.Count:匹配结果中的括号中的结果数。
'MatchCollection.Item(Index).SubMatches(Index):匹配结果中的括号中的内容。

'STATIC_REGEXP_OBJECT:

'说明:静态开关(建议开启)
'如果开启,则始终只使用一个RegExp对象,否则每个函数都会自动创建一个RegExp对象并在使用完以后删除。

#Const STATIC_REGEXP_OBJECT = True

#If STATIC_REGEXP_OBJECT = True Then

Private oRegExp As Object

'函数:ereg_Init()
'作用:静态模式下,必须先调用本函数初始化静态 RegExp 对象。

Public Function ereg_Init() As Boolean
    On Error GoTo Failed
    Set oRegExp = CreateObject("VBScript.RegExp")
    ereg_Init = True
    Exit Function
Failed:
    ereg_Init = False
End Function

'函数:ereg_UnInit()
'作用:卸载静态 RegExp 对象。

Public Sub ereg_UnInit()
    Set oRegExp = Nothing
End Sub

#End If

'通用参数说明:(以下参数所有函数均可通用)
'NoCase As Boolean:可选,False 表示区分大小写,True 则不区分。
'MultiLine As Boolean:可选,False 表示只在第一行查找,True 则全串查找。

'函数:ereg_Fit(Pattern$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
'返回类型:Boolean
'说明:用Pattern去匹配字符串sSrc,如果成功,返回True,否则返回False。

Public Function ereg_Fit(ByVal Pattern$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False) As Boolean

#If STATIC_REGEXP_OBJECT <> True Then
    Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
#End If

    oRegExp.Pattern = Pattern
    oRegExp.IgnoreCase = NoCase
    oRegExp.Global = False
    oRegExp.MultiLine = MultiLine
    ereg_Fit = oRegExp.Test(sSrc)

#If STATIC_REGEXP_OBJECT <> True Then
    Set oRegExp = Nothing
#End If

End Function

'函数:ereg_Match(Pattern$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
'返回类型:MatchCollection
'说明:用Pattern去匹配字符串sSrc,仅匹配一个合适项,返回一个 MatchCollection。
'例子:
'    Dim rt As Object
'    Set rt = ereg_Match("[a-z]+", "fenying")
'    If rt.Count Then MsgBox rt(0)

Public Function ereg_Match(ByVal Pattern$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False) As Object

#If STATIC_REGEXP_OBJECT <> True Then
    Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
#End If

    oRegExp.Pattern = Pattern
    oRegExp.IgnoreCase = NoCase
    oRegExp.Global = False
    oRegExp.MultiLine = MultiLine

    Set ereg_Match = oRegExp.Execute(sSrc)

#If STATIC_REGEXP_OBJECT <> True Then
    Set oRegExp = Nothing
#End If

End Function

'函数:ereg_Match_All(Pattern$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
'返回类型:MatchCollection
'说明:用Pattern去匹配字符串sSrc,匹配所有匹配项,返回一个 MatchCollection。
'例子:
'    Dim rt As Object
'    Set rt = ereg_Match_All("([a-zA-Z]+)", "fenying Fenying")
'    If rt.Count Then MsgBox rt(1).SubMatches(0)

'//注:SubMatches包含的是每个括号里的匹配结果。在上面的例子里可以写成下面的也一样
'    If rt.Count Then MsgBox rt(1)

Public Function ereg_Match_All(ByVal Pattern$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False) As Object

#If STATIC_REGEXP_OBJECT <> True Then
    Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
#End If

    oRegExp.Pattern = Pattern
    oRegExp.IgnoreCase = NoCase
    oRegExp.Global = True
    oRegExp.MultiLine = MultiLine
    Set ereg_Match_All = oRegExp.Execute(sSrc)

#If STATIC_REGEXP_OBJECT <> True Then
    Set oRegExp = Nothing
#End If

End Function

'函数:ereg_Replace_Once(Pattern$, sDst$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
'返回类型:String
'说明:用Pattern去匹配字符串sSrc并替换为sDst,仅替换一次,返回一个 String。
'例子:
'
'    MsgBox ereg_Replace_Once("[abc]+", vbNewLine, "abc   abc")

Public Function ereg_Replace_Once$(ByVal Pattern$, ByVal sDst$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False)

#If STATIC_REGEXP_OBJECT <> True Then
    Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
#End If

    oRegExp.Pattern = Pattern
    oRegExp.IgnoreCase = NoCase
    oRegExp.Global = False
    oRegExp.MultiLine = MultiLine
    ereg_Replace_Once = oRegExp.Replace(sSrc, sDst)

#If STATIC_REGEXP_OBJECT <> True Then
    Set oRegExp = Nothing
#End If

End Function

'函数:ereg_Replace(Pattern$, sDst$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
'返回类型:String
'说明:用Pattern去匹配字符串sSrc并替换为sDst,替换全部,并返回一个 String。
'例子:
'
'    MsgBox ereg_Replace("\s+\r\n", vbNewLine, "abc   " & vbNewLine & "abc")
'//替换行尾空白

Public Function ereg_Replace$(ByVal Pattern$, ByVal sDst$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False)

#If STATIC_REGEXP_OBJECT <> True Then
    Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
#End If

    oRegExp.Pattern = Pattern
    oRegExp.IgnoreCase = NoCase
    oRegExp.Global = True
    oRegExp.MultiLine = MultiLine
    ereg_Replace = oRegExp.Replace(sSrc, sDst)

#If STATIC_REGEXP_OBJECT <> True Then
    Set oRegExp = Nothing
#End If

End Function

'函数:ereg_ReplaceEx(Pattern$, sDst$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
'返回类型:String
'说明:用Pattern去匹配字符串sSrc,并将sDst中的如\1,\2...替换为表达式对应括号里的内容,并返回一个 String。
'例子:
'
'    MsgBox ereg_ReplaceEx("([a-z]+),\s*(\d+)", "Name: \1, Age: \2", "Fenying,   17")

Public Function ereg_ReplaceEx$(ByVal Pattern$, ByVal sDst$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False)

#If STATIC_REGEXP_OBJECT <> True Then
    Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
#End If

    Dim oTemp As Object, sMatchStr$, C#, i#

    oRegExp.Pattern = Pattern
    oRegExp.IgnoreCase = NoCase
    oRegExp.Global = True
    oRegExp.MultiLine = MultiLine

    Set oTemp = ereg_Match(Pattern, sSrc, NoCase, MultiLine)

    sMatchStr = sDst
    If oTemp.Count > 0 Then
        C = oTemp.Item(0).SubMatches.Count
        For i = 1 To C
            sMatchStr = ereg_Replace("(?=[^\\]?)\\" & i, oTemp.Item(0).SubMatches(i - 1), sMatchStr)
        Next
    End If

    ereg_ReplaceEx = sMatchStr

    Set oTemp = Nothing

#If STATIC_REGEXP_OBJECT <> True Then
    Set oRegExp = Nothing
#End If

End Function

Rem <!-- File End -->
该文章根据 CC-BY-4.0 协议发表,转载请遵循该协议。
本文地址:https://fenying.net/post/2009/08/22/regexp-in-visual-basic/

comments powered by Disqus