xml缓存类[原创]

说明：最近公司网站流量增加，同时在线1000人就开始很卡，数据库服务器cpu占用经常会达到100%，于是在晚上找资料整理做出这个类，部分借鉴walkman的xml数据缓存类；
思路：使用xml作为临时数据库，存放小数量数据，来减轻数据库的压力，查询更加快捷

特点：

读取机制：自动判断有无缓存了的xml文件，当xml文件存在数据，侧从xml获取数据，反之从数据库读取；
缓存机制：根据xml文件生存时间和用户自定义的缓存时间判断缓存有无过期，过期侧生存新的xml文件；

有效减少数据库查询读取次数，缓存数据量小读取更快

修改了一下，加了两个方法，使用更方便

<%
Rem xml缓存类
'--------------------------------------------------------------------
'转载的时候请保留版权信息
'作者:╰⑥月の雨╮
'博客: http://chthp.cnblogs.com/
'版本: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,"<","&lt;")
        str = Replace(str,">","&gt;")
        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
    Set cache = Nothing 
End Function
%>

 
使用方法：

1、读取数据

<!--#include file="include/xmlcachecls.asp" -->
strSel=""
ReadOn=0
rsArray=ReadCache(Server.Mappath("xmlcache/index/*********.xml"),Conn,strSel,ReadOn)
'response.Write("###### "&ReadOn&" ######<br>") 测试数据从哪里读取的   使用时注释掉
If IsArray(rsArray) then
      for i=0 to ubound(rsarray,2)
            *********
      next
End If
strSel=""
rsarray=""

2、缓存数据
cache.asp

<!--#include file="../conn.asp" -->
<!--#include file="../include/xmlcachecls.asp" -->
Sql=""
call SetCache(Server.Mappath("../xmlcache/index/**********.xml"),60*10,Conn,Sql) '60*10 表示缓存的时间

3、调用
在页面底部加入，这样就不会影响页面打开的速度

<script type="text/javascript" src="cache.asp"></script>