<%
Class HTMLParse
' 设置 Initialize 事件。
Private Sub Class_Initialize
myGlobal = True
myIgnoreCase = True
End Sub
Property Let Global(g)
Dim regEx ' 建立变量。
Set regEx = New RegExp ' 建立正则表达式。
regEx.Pattern = "True|False|1|0" ' 设置模式。
regEx.IgnoreCase = True ' 设置是否区分大小写。
If regEx.Test(CStr(g)) Then
myGlobal = g
Else
Call Halt("无效Global参数配置")
End If
End Property
Property Get Global()
Global = myGlobal
End Property
Property Let IgnoreCase(c)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "True|False|1|0"
regEx.IgnoreCase = True
If regEx.Test(CStr(c)) Then
myIgnoreCase = c
Else
Call Halt("无效IgnoreCase参数配置")
End If
End Property
Property Get IgnoreCase()
IgnoreCase = myIgnoreCase
End Property
'解析所有HTML标记的函数
Public Function Parse(input)
Parse = "
" & vbCrLf
Dim regEx , regVal , match , i
Set regEx = New RegExp
regEx.Pattern = "<([a-z]w*)(?:.*?)>(.*)"
regEx.Global = myGlobal
regEx.IgnoreCase = myIgnoreCase
Set regVal = regEx.Execute(Trim(input))
If regVal.Count > 0 Then '如果发现匹配元素
Parse = Parse & "
发现" & regVal.Count & "个HTML标记
" & vbCrLf
Parse = Parse & "
编号
匹配标记
匹配显示
" & vbCrLf
For i=0 To regVal.Count-1
Set match = regVal(i)
Parse = Parse & "
" & vbCrLf
Parse = Parse & "
" & i+1 & "
" & match.SubMatches(0) & "
" & match
& "
" & vbCrLf
Parse = Parse & "
" & vbCrLf
Next
Else Parse = Parse & "
没有发现HTML标记
" & vbCrLf
End If
Parse = Parse & "
" & vbCrLf
End Function
'解析指定HTML标记的函数
Public Function ParseTag(input,tag)
ParseTag = "
" & vbCrLf
Dim regEx , regVal , match , i
Set regEx = New RegExp
regEx.Pattern = "<(" & tag & ")(?:.*?)>(.*?)"
regEx.Global = myGlobal
regEx.IgnoreCase = myIgnoreCase
Set regVal = regEx.Execute(Trim(input))
If regVal.Count > 0 Then '如果发现匹配元素
ParseTag = ParseTag & "
发现" & regVal.Count & "个" & UCase(tag) & "标记
" &
vbCrLf
ParseTag = ParseTag & "
编号
发现位置
包含内容
" &
vbCrLf
For i=0 To regVal.Count-1
Set match = regVal(i)
ParseTag = ParseTag & "
" & vbCrLf
ParseTag = ParseTag & "
" & i+1 & "
" & match.FirstIndex & "
" &
match.SubMatches(1) & "
" & vbCrLf
ParseTag = ParseTag & "
" & vbCrLf
Next
Else ParseTag = ParseTag & "
没有发现" & UCase(tag) & "标记
" & vbCrLf
End If
ParseTag = ParseTag & "
" & vbCrLf
End Function
'打印错误
Private Sub Halt(errstr)
Response.Write("" & errstr & "" & vbCrLf)
Call Class_Terminate
End Sub
Private Sub Class_Terminate ' 设置 Terminate 事件。
End Sub
'定义两个内部变量
Private myGlobal
Private myIgnoreCase
End Class
%>
范例1
<%
'范例1
Dim input , result
input = "这是一个VBScript的正则表达式范例。"
Set hp = New HTMLParse
hp.Global = 1
hp.IgnoreCase = False
result = hp.Parse(input)
Response.Write(result)
%>
范例2
<%
'范例2
'hp.Global = 1
'hp.IgnoreCase = False
result2 = hp.ParseTag(input,"i")
Response.Write(result2)
Set hp = Nothing
%>