其中的xml缓存类class.asp是百度搜索来的，代码如下
[code=vb]
<%
'=========================================
'百度来的xx类,无名无姓无作者
'=========================================
'调用说明:
'set cc = new rym_clscache 创建对象
'cc.createxmlobj "temp.xml","/royah_cache"
'cc.name = "ca" 设置缓存名
'if cc.isxmlobj() then 如果存在缓存则
'temp = cc.value 直接xml中读取值
'else 否则
'temp = "要缓存的内容，只能是字符串"
'cc.value = temp 把要缓存的值写入xml
'end if
'set cc = nothing 释放对象
'变量temp就是经过缓存后的字符串值了
'=========================================
class rym_clscache
public reloadtime
private xmldom, xmldoc, xmlnode, xmlattr, attrtime
private cachename, localcachename, xmlpath
private sub class_initialize()
'刷新时间 单位秒×60
reloadtime = 600
end sub
private sub class_terminate()
close()
end sub
'新建文本文件
private function savetofile(byval strbody,byval savepath)
set objstream = server.createobject("adodb.stream")
objstream.open
objstream.type = 2
objstream.charset = "gb2312"
objstream.writetext strbody
objstream.savetofile savepath,2
objstream.close
set objstream = nothing
end function
'创建xml对象
public sub createxmlobj(byval xmlname, byval chname)
set xmldom = server.createobject("microsoft.freethreadedxmldom")
xmlpath = server.mappath(xmlname)
cachename = chname
if not xmldom.load(xmlpath) then '如果指定的缓存文件不存在则自动新建
savetofile "
xmldom.load(xmlpath)
end if
end sub
'设置返回数据节点名
public property let name(byval vnewvalue)
localcachename = vnewvalue
if localcachename <> "" then
set xmldoc = xmldom.documentelement.selectsinglenode(cachename & "/" & localcachename)
end if
end property
'设置当前节点值
public property let value(byval vnewvalue)
if (xmldoc is nothing) then
set xmldoc = xmldom.documentelement.selectsinglenode(cachename)
set xmlnode = xmldom.createelement(localcachename)
set xmlattr = xmldom.createattribute("time")
xmlnode.text = vnewvalue
xmlattr.text = now()
xmldoc.appendchild(xmlnode)
xmlnode.setattributenode xmlattr
xmldom.save(xmlpath)
else
xmldoc.text = vnewvalue
set attrtime = xmldoc.selectsinglenode("./@time")
attrtime.text = now()
xmldom.save(xmlpath)
end if
end property
'返回当前节点值
public property get value()
if not (xmldoc is nothing) then
value = xmldoc.text
end if
end property
'移除当前节点
public sub remove()
if not (xmldoc is nothing) then
xmldoc.parentnode.removechild(xmldoc)
xmldom.save(xmlpath)
end if
end sub
'检测当前节点是否存在
public function isxmlobj()
isxmlobj = false
if not (xmldoc is nothing) then
isxmlobj = true
set attrtime = xmldoc.selectsinglenode("./@time")
if datediff("s",cdate(attrtime.text),now()) > (60*reloadtime) then isxmlobj = false
end if
end function
'释放全部对象
public sub close()
if isobject(xmldom) then set xmldom = nothing
if isobject(xmldoc) then set xmldoc = nothing
if isobject(xmlnode) then set xmlnode = nothing
if isobject(xmlattr) then set xmlattr = nothing
if isobject(attrtime) then set xmlattr = nothing
end sub
end class
%>
[/code]
调用的页面如下
[code=vb]
<%
On Error Resume Next
Server.ScriptTimeOut=9999999
dim head,bot,birdview2
head = "采集开始特征代码html"
bot = "采集结束特征代码html"
birdview2=getHTTPPage("被采集的页面地址url")
'调用说明:
dim cc8
set cc8 = new rym_clscache '创建对象
cc8.createxmlobj "temp8.xml","/royah_cache"
cc8.name = "ca8" '设置缓存名
if cc8.isxmlobj() then '如果存在缓存则
temp8 = cc8.value '直接xml中读取值
else '否则
temp8 = birdview2 '要缓存的内容，只能是字符串"
cc8.value = temp8 '把要缓存的值写入xml
end if
set cc8 = nothing '释放对象
'变量temp就是经过缓存后的字符串值了
response.write(temp8)
Function getHTTPPage(url)
dim http
set http=createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
'替换软硬回车
getHTTPPage=replace(replace(getHTTPPage, vbCr,""),vbLf,"")
'截取
getHTTPPage=mid(getHTTPPage ,instr(getHTTPPage ,head)+len(head),instr(getHTTPPage ,bot)-instr(getHTTPPage ,head)-len(head))
set http=nothing
if err.number<>0 then err.Clear
end function
Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
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
%>
[/code]
转载请注明：鸟儿博客 » asp实现简单的采集