asp xml 缓存类

<%
rem xml缓存类
'--------------------------------------------------------------------
'转载的时候请保留版权信息
'作者:╰⑥月の雨╮
'版本:ver1.0
'本类部分借鉴 walkmanxml数据缓存类，使用更为方便 欢迎各位交流进步
'--------------------------------------------------------------------
class xmlcachecls
private m_dataconn '数据源,必须已经打开
private m_cachetime '缓存时间，单位秒 默认10分钟
private m_xmlfile 'xml路径，用绝对地址,不需要加扩展名
private m_sql 'sql语句
private m_sqlarr '(只读)返回的数据数组
private m_readon '(只读)返回读取方式 1-数据库 2-xml 检测用

'类的属性=========================================

'数据源
public property set conn(v)
set m_dataconn = v
end property
public property get conn
conn = m_dataconn
end property

'缓存时间
public property let cachetime(v)
m_cachetime = v
end property
public property get cachetime
cachetime = m_cachetime
end property

'xml路径，用绝对地址
public property let xmlfile(v)
m_xmlfile = v
end property
public property get xmlfile
xmlfile = m_xmlfile
end property

'sql语句
public property let sql(v)
m_sql = v
end property
public property get sql
sql = m_sql
end property
'返回记录数组
public property get sqlarr
sqlarr = m_sqlarr
end property

'返回读取方式
public property get readon
readon = m_readon
end property

'类的析构=========================================

private sub class_initialize() '初始化类
m_cachetime=60*10 '默认缓存时间为10分钟
end sub

private sub class_terminate() '释放类

end sub

'类的公共方法=========================================

rem 读取数据
public function readdata
if fsoexistsfile(m_xmlfile) then '存在xml缓存，直接从xml中读取
readdatafromxml
m_readon=2
else
readdatafromdb
m_readon=1
end if
end function

rem 写入xml数据
public function writedatatoxml
if fsoexistsfile(m_xmlfile) then '如果xml未过期则直接退出
if not isxmlcacheexpired(m_xmlfile,m_cachetime) then exit function
end if
dim rs
dim xmlcontent
dim k
xmlcontent = ""
xmlcontent = xmlcontent & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline
xmlcontent = xmlcontent & " <root>" & vbnewline
k=0
set rs = server.createobject("adodb.recordset")
rs.open m_sql,m_dataconn,1
while not rs.eof
xmlcontent = xmlcontent & " <item "
for each field in rs.fields
xmlcontent = xmlcontent & field.name & "=""" & xmlstringencode(field.value) & """ "
next
rs.movenext
k=k+1
xmlcontent = xmlcontent & "></item>" & vbnewline
wend
rs.close
set rs = nothing
xmlcontent = xmlcontent & " </root>" & vbnewline

dim folderpath
folderpath = trim(left(m_xmlfile,instrrev(m_xmlfile,"\")-1))
call createdir(folderpath&"") '创建文件夹
writestringtoxmlfile m_xmlfile,xmlcontent
end function

'类的私有方法=========================================

rem 从xml文件读取数据
private function readdatafromxml
dim sqlarr() '数组
dim xmldoc 'xmldoc对象
dim objnode '子节点
dim itemslength '子节点的长度
dim attributeslength '子节点属性的长度
set xmldoc=server.createobject("microsoft.xmldom")
xmldoc.async=false
xmldoc.load(m_xmlfile)
set objnode=xmldoc.documentelement '获取根节点
itemslength=objnode.childnodes.length '获取子节点的长度
for items_i=0 to itemslength-1
attributeslength=objnode.childnodes(items_i).attributes.length '获取子节点属性的长度
for attributes_i=0 to attributeslength-1
redim preserve sqlarr(attributeslength-1,items_i)
sqlarr(attributes_i,items_i) = objnode.childnodes(items_i).attributes(attributes_i).nodevalue
next
next
set xmldoc = nothing
m_sqlarr = sqlarr
end function

rem 从数据库读取数据
private function readdatafromdb
dim rs
dim sqlarr()
dim k
k=0
set rs = server.createobject("adodb.recordset")
rs.open m_sql,m_dataconn,1
if not (rs.eof and rs.bof) then
while not rs.eof
dim fieldlegth
fieldlegth = rs.fields.count
redim preserve sqlarr(fieldlegth,k)
dim fieldi
for fieldi = 0 to fieldlegth-1
sqlarr(fieldi,k) = rs.fields(fieldi).value
next
rs.movenext
k=k+1
wend
end if
rs.close
set rs = nothing
m_sqlarr = sqlarr
end function

'类的辅助私有方法=========================================

rem 写xml文件
private sub writestringtoxmlfile(filename,str)
dim fs,ts
set fs= createobject("scripting.filesystemobject")
if not isobject(fs) then exit sub
set ts=fs.opentextfile(filename,2,true)
ts.writeline(str)
ts.close
set ts=nothing
set fs=nothing
end sub

rem 判断xml缓存是否到期
private function isxmlcacheexpired(file,seconds)
dim filelasttime
filelasttime = fsogetfilelastmodifiedtime(file)
if dateadd("s",seconds,filelasttime) < now then
isxmlcacheexpired = true
else
isxmlcacheexpired = false
end if
end function

rem 得到文件的最后修改时间
private function fsogetfilelastmodifiedtime(file)
dim fso,f,s
set fso=createobject("scripting.filesystemobject")
set f=fso.getfile(file)
fsogetfilelastmodifiedtime = f.datelastmodified
set f = nothing
set fso = nothing
end function

rem 文件是否存在
public function fsoexistsfile(file)
dim fso
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(file) then
fsoexistsfile = true
else
fsoexistsfile = false
end if
set fso = nothing
end function

rem xml转义字符
private function xmlstringencode(str)
if str&"" = "" then xmlstringencode="":exit function
str = replace(str,"<","<")
str = replace(str,">",">")
str = replace(str,"'","'")
str = replace(str,"""",""")
str = replace(str,"&","&")
xmlstringencode = str
end function

rem 创建文件夹
private function createdir(byval localpath)
on error resume next
dim i,fileobject,patharr,path_level,pathtmp,cpath
localpath = replace(localpath,"\","/")
set fileobject = server.createobject("scripting.filesystemobject")
patharr = split(localpath,"/")
path_level = ubound (patharr)
for i = 0 to path_level
if i=0 then
pathtmp=patharr(0) & "/"
else
pathtmp = pathtmp & patharr(i) & "/"
end if
cpath = left(pathtmp,len(pathtmp)-1)
if not fileobject.folderexists(cpath) then
'response.write cpath
fileobject.createfolder cpath
end if
next
set fileobject = nothing
if err.number<>0 then
createdir = false
err.clear
else
createdir = true
end if
end function
end class
'设置缓存
function setcache(xmlfilepath,cachetime,conn,sql)
set cache=new xmlcachecls
set cache.conn=conn
cache.xmlfile=xmlfilepath
cache.sql=sql
cache.cachetime=cachetime
cache.writedatatoxml
set cache = nothing
end function
'读取缓存
function readcache(xmlfilepath,conn,sql,byref readon)
set cache=new xmlcachecls
set cache.conn=conn
cache.xmlfile=xmlfilepath
cache.sql=sql
cache.readdata
readcache=cache.sqlarr
readon=cache.readon
end function
%>

使用方法：
1 缓存数据到xml
代码:

<!--#include file="conn.asp"-->
<!--#include file="xml.asp"-->
<%
set cache=new xmlcachecls
set cache.conn=conn
cache.xmlfile=server.mappath("xmlcache/index/top.xml")
cache.sql="select top 15 prod_id,prod_name,prod_uptime from tblproduction"
cache.writedatatoxml
%>

2 读取缓存数据
代码:

<!--#include file="conn.asp"-->
<!--#include file="xml.asp"-->
<%
set cache=new xmlcachecls
set cache.conn=conn
cache.xmlfile=server.mappath("xmlcache/index/top.xml")
cache.sql="select top 15 prod_id,prod_name,prod_uptime from tblproduction order by prod_id asc"
cache.readdata
rsarray=cache.sqlarr
if isarray(rsarray) then
for i=0 to ubound(rsarray,2)
for j=0 to ubound(rsarray,1)
response.write(rsarray(j,i)&"<br><br>")
next
next
end if
%>

缓存时间，单位秒 默认10分钟；也可以自己设定 cache.cachetime=60*30 30分钟