复制代码 代码如下:
<%
'========================================
classEngineerSearch
'老龙:laolong9999@sina.com
':模拟XML获取http标记资源（用过之后就知道为什么XML有用：））
'利用引擎搜索(显示引擎信息或其超连接网站上的信息或直接一个指定页面的相关信息，利用正则和xmlHttp,
'程序的使用需要会构造正则)
'---------------------------------------------------------------
privateoReg,oxmlHttp'一个正则，一个微软xmlhttp
'---------------------------------------------------------------
publicsubclass_initialize()'对象建立触发
setoReg=newregExp
oReg.Global=true
oReg.IgnoreCase=true
setoXmlHttp=server.createobject("Microsoft.XmlHttp")
endsub
'---------------------------------------------------------------
publicsubclass_terminate()'对象销毁触发
setoReg=nothing'必须手动释放class内的自建对象，asp只自动释放由class定义的对象
setoXmlHttp=nothing
Iftypename(tempReg)<>"nothing"then'方法体内的对象释放资源
settempReg=nothing
endif
endsub
'---------------------------------------------------------------
'引擎级搜索
publicfunctionengineer(url,EngineerReg)
'功能介绍：获得url的返回信息(通常用于引擎查找)，提取其中的EngineerReg的特定信息，返回matches集合到
'函数名。获得url查询结果,搜寻出用engineerReg正则定义的结果,生成一个matches集合,
'由于无法建立集合及操作集合个数（vbscript）,最好再自己遍历集合，也可以考虑二维数组
dimstrConent
strContent=oXmlHttp.open("get",url,false)
onerrorresumenext
oXmlHttp.send()
iferr.number<>0then
exitfunction
endif
strContent=bytes2BSTR(oXmlHttp.responseBody)
ifisnull(EngineerReg)then
engineer=AbsoluteURL(strContent,url)
else
oReg.Pattern=EngineerReg
setengineer=oReg.Execute(AbsoluteURL(strContent,url))
endif
endfunction
'---------------------------------------------------------------
'汉字编码,(网人)
publicFunctionbytes2BSTR(vIn)
strReturn=""
Fori=1ToLenB(vIn)
ThisCharCode=AscB(MidB(vIn,i,1))
IfThisCharCode<&H80Then
strReturn=strReturn&Chr(ThisCharCode)
Else
NextCharCode=AscB(MidB(vIn,i+1,1))
strReturn=strReturn&Chr(CLng(ThisCharCode)*&H100+CInt(NextCharCode))
i=i+1
EndIf
Next
bytes2BSTR=strReturn
EndFunction
'---------------------------------------------------------------
publicFunctionSearchReplace(strContent,ReplaceReg,ResultReg)
'替换，将strContent中的replaceReg描述的字符串用resultReg描述的替换，返回到searchReplace去
'将正则的replace封装了。
oReg.Pattern=ReplaceReg
SearchReplace=oReg.replace(strContent,ResultReg)
EndFunction
'---------------------------------------------------------------
publicFunctionAbsoluteURL(strContent,byvalurl)
'将strContent中的相对URL变成oXmlHttp中指定的url的绝对地址(http/https/ftp/mailto:)
'正则可以修改修改。
dimtempReg
settempReg=newRegExp
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)
settempReg=nothing
endFunction
'---------------------------------------------------------------
endclass
'========================================
%>
<%'例子
Response.CharSet="GB2312"
dimmySearch
setmySearch=newEngineerSearch
'URL一定是包含文件扩展名的完整地址,结果是集合，集合中的每个项目是数组,应该这样引用子查询:myMatches(0).subMatches(0)
setmyMatches=mySearch.engineer("http://www.wrclub.net/default.aspx","<img.*?>")
ifmyMatches.count=0Then
response.write"没有你正则的字符串"
endif
ifmyMatches.count>0then
response.writemyMatches.count&"<br>"
foreachkeyinmyMatches
response.writekey.firstindex&":"&cstr(key.value)&"<br>"
next
endif
%>
更诸多的应用，只要你会正则