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 
%> 

<!--#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 
%> 

<!--#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 
%>