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,"<","<") 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 FunctionEnd 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=0rsArray=ReadCache(Server.Mappath("xmlcache/index/*********.xml"),Conn,strSel,ReadOn)'response.Write("###### "&ReadOn&" ######<br>") 测试数据从哪里读取的 使用时注释掉If IsArray(rsArray) then for i=0 to ubound(rsarray,2) ********* nextEnd IfstrSel=""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>
