學php的，語法有不習慣的地方，請大家多包含。
<%
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 = "<table border=1 width=50% align=center>" & vbCrLf
Dim regEx , regVal , match , i
Set regEx = New RegExp
regEx.Pattern = "<([a-z]w*)(?:.*?)>(.*)</1>"
regEx.Global = myGlobal
regEx.IgnoreCase = myIgnoreCase
Set regVal = regEx.Execute(Trim(input))
If regVal.Count > 0 Then '如果發現匹配元素
Parse = Parse & "<caption>發現" & regVal.Count & "個HTML標記</caption>" & vbCrLf
Parse = Parse & "<tr align=center><th>編號</th><th>匹配標記<th>匹配顯示</th></tr>" & vbCrLf
For i=0 To regVal.Count-1
Set match = regVal(i)
Parse = Parse & "<tr align=center>" & vbCrLf
Parse = Parse & "<td>" & i+1 & "</td><td>" & match.SubMatches(0) & "</td><td>" & match
& "</td>" & vbCrLf
Parse = Parse & "</tr>" & vbCrLf
Next
Else Parse = Parse & "<caption>沒有發現HTML標記</caption>" & vbCrLf
End If
Parse = Parse & "</table>" & vbCrLf
End Function
'解析指定HTML標記的函數
Public Function ParseTag(input,tag)
ParseTag = "<table border=1 width=50% align=center>" & vbCrLf
Dim regEx , regVal , match , i
Set regEx = New RegExp
regEx.Pattern = "<(" & tag & ")(?:.*?)>(.*?)</1>"
regEx.Global = myGlobal
regEx.IgnoreCase = myIgnoreCase
Set regVal = regEx.Execute(Trim(input))
If regVal.Count > 0 Then '如果發現匹配元素
ParseTag = ParseTag & "<caption>發現" & regVal.Count & "個" & UCase(tag) & "標記</caption>" &
vbCrLf
ParseTag = ParseTag & "<tr align=center><th>編號</th><th>發現位置<th>包含內容</th></tr>" &
vbCrLf
For i=0 To regVal.Count-1
Set match = regVal(i)
ParseTag = ParseTag & "<tr align=center>" & vbCrLf
ParseTag = ParseTag & "<td>" & i+1 & "</td><td>" & match.FirstIndex & "</td><td>" &
match.SubMatches(1) & "</td>" & vbCrLf
ParseTag = ParseTag & "</tr>" & vbCrLf
Next
Else ParseTag = ParseTag & "<caption>沒有發現" & UCase(tag) & "標記</caption>" & vbCrLf
End If
ParseTag = ParseTag & "</table>" & vbCrLf
End Function
'打印錯誤
Private Sub Halt(errstr)
Response.Write("<font color=red size=3>" & errstr & "</font>" & vbCrLf)
Call Class_Terminate
End Sub
Private Sub Class_Terminate ' 設置 Terminate 事件。
End Sub
'定義兩個內部變量
Private myGlobal
Private myIgnoreCase
End Class
%>
<html>
<body>
<div align=center><h2>范例1</h2></div>
<%
'范例1
Dim input , result
input = "<i>這是</i>一個<font color=green>VBScript</font>的<b>正則<i>表達式</i>范例</b>。"
Set hp = New HTMLParse
hp.Global = 1
hp.IgnoreCase = False
result = hp.Parse(input)
Response.Write(result)
%>
<br>
<div align=center><h2>范例2</h2></div>
<%
'范例2
'hp.Global = 1
'hp.IgnoreCase = False
result2 = hp.ParseTag(input,"i")
Response.Write(result2)
Set hp = Nothing
%>
</body>
</html>
大家應該注意到了，VBScript的正則表達式和Jscript的解析是一樣的，只是語法不同。關于最新的VBScript的文檔，大家
可以到微軟中國的腳本技術主頁去下載，網址：http://www.microsoft.com/china/scripting