快捷導(dǎo)航

用正則xmlHttp實(shí)現(xiàn)的偷(轉(zhuǎn))

更新時(shí)間：2007年01月22日 00:00:00 作者：

<%  
'========================================  
class EngineerSearch  
'老龍:laolong9999@sina.com  
':模擬XML獲取http標(biāo)記資源（用過之后就知道為什么XML有用：））  
'利用引擎搜索(顯示引擎信息或其超連接網(wǎng)站上的信息或直接一個(gè)指定頁面的相關(guān)信息，利用正則和xmlHttp,  
'程序的使用需要會(huì)構(gòu)造正則)  
'---------------------------------------------------------------  
private oReg,oxmlHttp'一個(gè)正則，一個(gè)微軟xmlhttp  
'---------------------------------------------------------------  
public sub class_initialize()'對(duì)象建立觸發(fā)  
set oReg=new regExp  
oReg.Global=true  
oReg.IgnoreCase=true  
set oXmlHttp=server.createobject("Microsoft.XmlHttp")  
end sub  
'---------------------------------------------------------------  
public sub class_terminate()'對(duì)象銷毀觸發(fā)  
set oReg=nothing'必須手動(dòng)釋放class內(nèi)的自建對(duì)象，asp只自動(dòng)釋放由class定義的對(duì)象  
set oXmlHttp=nothing  
If typename(tempReg)<>"nothing" then'方法體內(nèi)的對(duì)象釋放資源  
set tempReg=nothing  
end if  
end sub  
'---------------------------------------------------------------  
'引擎級(jí)搜索  
public function engineer(url,EngineerReg)  
'功能介紹：獲得url的返回信息(通常用于引擎查找)，提取其中的EngineerReg的特定信息，返回matches集合到  
'函數(shù)名。獲得url查詢結(jié)果,搜尋出用engineerReg正則定義的結(jié)果,生成一個(gè)matches集合,  
'由于無法建立集合及操作集合個(gè)數(shù)（vbscript）,最好再自己遍歷集合，也可以考慮二維數(shù)組  
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  
'---------------------------------------------------------------  
'漢字編碼,(網(wǎng)人)  
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中的相對(duì)URL變成oXmlHttp中指定的url的絕對(duì)地址(http/https/ftp/mailto:)  
'正則可以修改修改。  
dim tempReg  
set tempReg=new RegExp  
tempReg.IgnoreCase=true  
tempReg.Global=true  
tempReg.Pattern="(^.*\/).*$"'含文件名的標(biāo)準(zhǔn)路徑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一定是包含文件擴(kuò)展名的完整地址,結(jié)果是集合，集合中的每個(gè)項(xiàng)目是數(shù)組,應(yīng)該這樣引用子查詢: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  
%>  

<br><b>更諸多的應(yīng)用，只要你會(huì)正則</b> 