複製代碼 代碼如下:<%
'========================================
class EngineerSearch
'老龍:laolong9999@sina.com
':類比XML擷取http標記資源（用過之後就知道為什麼XML有用：））
'利用引擎搜尋(顯示引擎資訊或其超串連網站上的資訊或直接一個指定頁面的相關資訊，利用正則和xmlHttp,
'程式的使用需要會構造正則)
'---------------------------------------------------------------
private oReg,oxmlHttp'一個正則，一個微軟xmlhttp
'---------------------------------------------------------------
public sub class_initialize()'對象建立觸發
set oReg=new regExp
oReg.Global=true
oReg.IgnoreCase=true
set oXmlHttp=server.createobject("Microsoft.XmlHttp")
end sub
'---------------------------------------------------------------
public sub class_terminate()'對象銷毀觸發
set oReg=nothing'必須手動釋放class內的自建對象，asp只自動釋放由class定義的對象
set oXmlHttp=nothing
If typename(tempReg)<>"nothing" then'方法體內的對象釋放資源
set tempReg=nothing
end if
end sub
'---------------------------------------------------------------
'引擎級搜尋
public function engineer(url,EngineerReg)
'功能介紹：獲得url的返回資訊(通常用於引擎尋找)，提取其中的EngineerReg的特定資訊，返回matches集合到
'函數名。獲得url查詢結果,搜尋出用engineerReg正則定義的結果,產生一個matches集合,
'由於無法建立集合及操作集合個數（vbscript）,最好再自己遍曆集合，也可以考慮二維數組
dim strConent
strContent=oXmlHttp.open("get",url,false)
on error resume next
oXmlHttp.send()
if err.number<>0 then
exit function
end if
strContent=bytes2BSTR(oXmlHttp.responseBody)
if isnull(EngineerReg) then
engineer=AbsoluteURL(strContent,url)
else
oReg.Pattern=EngineerReg
set engineer=oReg.Execute(AbsoluteURL(strContent,url))
end if
end function
'---------------------------------------------------------------
'漢字編碼,(網人)
public Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr (CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
'---------------------------------------------------------------
public Function SearchReplace(strContent,ReplaceReg,ResultReg)
'替換，將strContent中的replaceReg描述的字串用resultReg描述的替換，返回到searchReplace去
'將正則的replace封裝了。
oReg.Pattern=ReplaceReg
SearchReplace=oReg.replace(strContent,ResultReg)
End Function
'---------------------------------------------------------------
public Function AbsoluteURL(strContent,byval url)
'將strContent中的相對URL變成oXmlHttp中指定的url的絕對位址(http/https/ftp/mailto:)
'正則可以修改修改。
dim tempReg
set tempReg=new RegExp
tempReg.IgnoreCase=true
tempReg.Global=true
tempReg.Pattern="(^.*\/).*$"'含檔案名稱的標準路徑http://www.wrclub.net/default.aspx
Url=tempReg.replace(url,"$1")
tempReg.Pattern="((?:src|href).*?=[\'\u0022](?!ftp|http|https|mailto))"
AbsoluteURL=tempReg.replace(strContent,"$1"+Url)
set tempReg=nothing
end Function
'---------------------------------------------------------------
end class
'========================================
%>
<%'例子
Response.CharSet = "GB2312"
dim mySearch
set mySearch=new EngineerSearch
'URL一定是包含副檔名的完整地址,結果是集合，集合中的每個項目是數組,應該這樣引用子查詢:myMatches(0).subMatches(0)
set myMatches=mySearch.engineer("http://www.wrclub.net/default.aspx","<img.*?>")
if myMatches.count=0 Then
response.write "沒有你正則的字串"
end if
if myMatches.count>0 then
response.write myMatches.count&"<br>"
for each key in myMatches
response.write key.firstindex&":"&cstr(key.value)&"<br>"
next
end if
%>
更諸多的應用，只要你會正則
