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

  1Option Explicit
  2
  3Rem <!-- File Mod_RegExp.bas Begin -->
  4
  5'-------------------------------------------------------------
  6'File Name:     Mod_RegExp.bas
  7'Module Name:   Mod_RegExp
  8'Module Author: Fenying
  9'Time:          2009-08-22
 10'Using MicroSoft VBScript Regular Expressions Engine 5.5
 11'All CopyRight Fenying Studio 2007-2009 Reserved.
 12'To Get More...
 13'   http://fenying.blog.163.com
 14'-------------------------------------------------------------
 15
 16'MatchCollection 对象说明：
 17'MatchCollection：匹配结果集。
 18'MatchCollection.Count：表示有多少个匹配结果。
 19'MatchCollection.Item(Index)：获取指定结果（下标为 0 ～ Count - 1）。
 20'MatchCollection.Item(Index).Value：指定结果的内容。
 21'MatchCollection.Item(Index).FirstIndex：匹配结果字符串的起始位置。
 22'MatchCollection.Item(Index).Length：匹配结果字符串的长度。
 23'MatchCollection.Item(Index).SubMatches.Count：匹配结果中的括号中的结果数。
 24'MatchCollection.Item(Index).SubMatches(Index)：匹配结果中的括号中的内容。
 25
 26'STATIC_REGEXP_OBJECT：
 27
 28'说明：静态开关（建议开启）
 29'如果开启，则始终只使用一个RegExp对象，否则每个函数都会自动创建一个RegExp对象并在使用完以后删除。
 30
 31#Const STATIC_REGEXP_OBJECT = True
 32
 33#If STATIC_REGEXP_OBJECT = True Then
 34
 35Private oRegExp As Object
 36
 37'函数：ereg_Init()
 38'作用：静态模式下，必须先调用本函数初始化静态 RegExp 对象。
 39
 40Public Function ereg_Init() As Boolean
 41    On Error GoTo Failed
 42    Set oRegExp = CreateObject("VBScript.RegExp")
 43    ereg_Init = True
 44    Exit Function
 45Failed:
 46    ereg_Init = False
 47End Function
 48
 49'函数：ereg_UnInit()
 50'作用：卸载静态 RegExp 对象。
 51
 52Public Sub ereg_UnInit()
 53    Set oRegExp = Nothing
 54End Sub
 55
 56#End If
 57
 58'通用参数说明：（以下参数所有函数均可通用）
 59'NoCase As Boolean：可选，False 表示区分大小写，True 则不区分。
 60'MultiLine As Boolean：可选，False 表示只在第一行查找，True 则全串查找。
 61
 62'函数：ereg_Fit(Pattern$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
 63'返回类型：Boolean
 64'说明：用Pattern去匹配字符串sSrc，如果成功，返回True，否则返回False。
 65
 66Public Function ereg_Fit(ByVal Pattern$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False) As Boolean
 67
 68#If STATIC_REGEXP_OBJECT <> True Then
 69    Dim oRegExp As Object
 70    Set oRegExp = CreateObject("VBScript.RegExp")
 71#End If
 72
 73    oRegExp.Pattern = Pattern
 74    oRegExp.IgnoreCase = NoCase
 75    oRegExp.Global = False
 76    oRegExp.MultiLine = MultiLine
 77    ereg_Fit = oRegExp.Test(sSrc)
 78
 79#If STATIC_REGEXP_OBJECT <> True Then
 80    Set oRegExp = Nothing
 81#End If
 82
 83End Function
 84
 85'函数：ereg_Match(Pattern$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
 86'返回类型：MatchCollection
 87'说明：用Pattern去匹配字符串sSrc，仅匹配一个合适项，返回一个 MatchCollection。
 88'例子：
 89'    Dim rt As Object
 90'    Set rt = ereg_Match("[a-z]+", "fenying")
 91'    If rt.Count Then MsgBox rt(0)
 92
 93Public Function ereg_Match(ByVal Pattern$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False) As Object
 94
 95#If STATIC_REGEXP_OBJECT <> True Then
 96    Dim oRegExp As Object
 97    Set oRegExp = CreateObject("VBScript.RegExp")
 98#End If
 99
100    oRegExp.Pattern = Pattern
101    oRegExp.IgnoreCase = NoCase
102    oRegExp.Global = False
103    oRegExp.MultiLine = MultiLine
104
105    Set ereg_Match = oRegExp.Execute(sSrc)
106
107#If STATIC_REGEXP_OBJECT <> True Then
108    Set oRegExp = Nothing
109#End If
110
111End Function
112
113'函数：ereg_Match_All(Pattern$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
114'返回类型：MatchCollection
115'说明：用Pattern去匹配字符串sSrc，匹配所有匹配项，返回一个 MatchCollection。
116'例子：
117'    Dim rt As Object
118'    Set rt = ereg_Match_All("([a-zA-Z]+)", "fenying Fenying")
119'    If rt.Count Then MsgBox rt(1).SubMatches(0)
120
121'//注：SubMatches包含的是每个括号里的匹配结果。在上面的例子里可以写成下面的也一样
122'    If rt.Count Then MsgBox rt(1)
123
124Public Function ereg_Match_All(ByVal Pattern$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False) As Object
125
126#If STATIC_REGEXP_OBJECT <> True Then
127    Dim oRegExp As Object
128    Set oRegExp = CreateObject("VBScript.RegExp")
129#End If
130
131    oRegExp.Pattern = Pattern
132    oRegExp.IgnoreCase = NoCase
133    oRegExp.Global = True
134    oRegExp.MultiLine = MultiLine
135    Set ereg_Match_All = oRegExp.Execute(sSrc)
136
137#If STATIC_REGEXP_OBJECT <> True Then
138    Set oRegExp = Nothing
139#End If
140
141End Function
142
143'函数：ereg_Replace_Once(Pattern$, sDst$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
144'返回类型：String
145'说明：用Pattern去匹配字符串sSrc并替换为sDst，仅替换一次，返回一个 String。
146'例子：
147'
148'    MsgBox ereg_Replace_Once("[abc]+", vbNewLine, "abc   abc")
149
150Public Function ereg_Replace_Once$(ByVal Pattern$, ByVal sDst$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False)
151
152#If STATIC_REGEXP_OBJECT <> True Then
153    Dim oRegExp As Object
154    Set oRegExp = CreateObject("VBScript.RegExp")
155#End If
156
157    oRegExp.Pattern = Pattern
158    oRegExp.IgnoreCase = NoCase
159    oRegExp.Global = False
160    oRegExp.MultiLine = MultiLine
161    ereg_Replace_Once = oRegExp.Replace(sSrc, sDst)
162
163#If STATIC_REGEXP_OBJECT <> True Then
164    Set oRegExp = Nothing
165#End If
166
167End Function
168
169'函数：ereg_Replace(Pattern$, sDst$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
170'返回类型：String
171'说明：用Pattern去匹配字符串sSrc并替换为sDst，替换全部，并返回一个 String。
172'例子：
173'
174'    MsgBox ereg_Replace("\s+\r\n", vbNewLine, "abc   " & vbNewLine & "abc")
175'//替换行尾空白
176
177Public Function ereg_Replace$(ByVal Pattern$, ByVal sDst$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False)
178
179#If STATIC_REGEXP_OBJECT <> True Then
180    Dim oRegExp As Object
181    Set oRegExp = CreateObject("VBScript.RegExp")
182#End If
183
184    oRegExp.Pattern = Pattern
185    oRegExp.IgnoreCase = NoCase
186    oRegExp.Global = True
187    oRegExp.MultiLine = MultiLine
188    ereg_Replace = oRegExp.Replace(sSrc, sDst)
189
190#If STATIC_REGEXP_OBJECT <> True Then
191    Set oRegExp = Nothing
192#End If
193
194End Function
195
196'函数：ereg_ReplaceEx(Pattern$, sDst$, sSrc$, [NoCase As Boolean = False, [MultiLine As Boolean = False]])
197'返回类型：String
198'说明：用Pattern去匹配字符串sSrc，并将sDst中的如\1,\2...替换为表达式对应括号里的内容，并返回一个 String。
199'例子：
200'
201'    MsgBox ereg_ReplaceEx("([a-z]+),\s*(\d+)", "Name: \1, Age: \2", "Fenying,   17")
202
203Public Function ereg_ReplaceEx$(ByVal Pattern$, ByVal sDst$, ByVal sSrc$, Optional NoCase As Boolean = False, Optional MultiLine As Boolean = False)
204
205#If STATIC_REGEXP_OBJECT <> True Then
206    Dim oRegExp As Object
207    Set oRegExp = CreateObject("VBScript.RegExp")
208#End If
209
210    Dim oTemp As Object, sMatchStr$, C#, i#
211
212    oRegExp.Pattern = Pattern
213    oRegExp.IgnoreCase = NoCase
214    oRegExp.Global = True
215    oRegExp.MultiLine = MultiLine
216
217    Set oTemp = ereg_Match(Pattern, sSrc, NoCase, MultiLine)
218
219    sMatchStr = sDst
220    If oTemp.Count > 0 Then
221        C = oTemp.Item(0).SubMatches.Count
222        For i = 1 To C
223            sMatchStr = ereg_Replace("(?=[^\\]?)\\" & i, oTemp.Item(0).SubMatches(i - 1), sMatchStr)
224        Next
225    End If
226
227    ereg_ReplaceEx = sMatchStr
228
229    Set oTemp = Nothing
230
231#If STATIC_REGEXP_OBJECT <> True Then
232    Set oRegExp = Nothing
233#End If
234
235End Function
236
237Rem <!-- File End -->