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 >