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分钟