' 設置 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 %>
