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,"'","&apos;")

　　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

　　%>