实践xml缓存技术构建高性能web站点

2022-07-15 80酷酷网 80kuku.com

打造一个高性能稳定的web站点一直是站长和程序员的梦想，本文用作者的一次亲身经历的来说说如何利用xml缓存技术实现站点的高性能。我是从今年开始做138手机主题网的，采用SQL2000做为数据库，开发语言用的是Asp，查询的时候都是动态查询，直接用like %的方式，那个时候反正一天的访问量小，同时在线的时候也就几十个人而已，所以服务器也就能胜任要求，随着访问量慢慢增加，当同时在线达到几百人时，此时服务器开始不堪重负，CPU常常达到100%不降，网页打开速度也超级慢，一个查询页面需要几秒钟甚至更长，于是我开始考虑优化程序和数据库，数据库建立索引，不是很理想，因为用的是like '% 这种方式，于是我想到了缓存，而xml本身的特点决定了他非常适合做数据库的缓存，好东西不敢独享，特发布出来，以便同行交流，共同进步。
实现的思路是这样的：程序读取信息时，先判断是否缓存了xml数据，如果有，则直接从xml中读取信息，否则从数据库中读取，并将此次结果生成xml文件，以便以后调用，加快速度，同时判断xml缓存文件是否过期，如果过期则需要重新生成xml。下面是具体的代码。

xmlcachecls.asp
<%
Rem xml数据缓存类
'--------------------------------------------------
'转载的时候请保留版权信息
'作者:walkman
'网址:手机主题
'版本:ver1.0
'欢迎各位交流进步
'--------------------------------------------------

Class XmlCacheCls

Rem 私有变量定义
Private m_CacheTime    '缓存时间，单位秒
Private m_PageSize    '每页大小
Private m_CachePageNum 'xml缓存页大小
Private m_XmlFile    'xml路径，用绝对地址,不需要加扩展名
Private m_Sql       'SQL语句
Private m_TableName    '表名或者视图名
Private m_Columns    '列名用,隔开
Private m_CurPage    '当前页
Private m_CacheType    '缓存类型：1,列表 2,详情
Private m_DataConn    '数据源,必须已经打开
Private m_QueryType    '查询类型：1,直接用sql 2,用存储过程

Private m_SQLArr    '返回的数据数组
Private m_RecordCount

Rem 公共属性

'缓存时间
Public Property Let  CacheTime(v)
   m_CacheTime = v
End Property

Public Property Get  CacheTime
   CacheTime = m_CacheTime
End Property

'每页大小
Public Property Let  PageSize(v)
   m_PageSize = v
End Property

Public Property Get  PageSize
   PageSize = m_PageSize
End Property

'xml缓存页大小
Public Property Let  CachePageNum(v)
   m_CachePageNum = v
End Property

Public Property Get  CachePageNum
   CachePageNum = m_CachePageNum
End Property

'xml路径，用绝对地址
Public Property Let  XmlFile(v)
   m_XmlFile = v
End Property

Public Property Get  XmlFile
   XmlFile = m_XmlFile
End Property

'xml路径，用绝对地址
Public Property Let  Sql(v)
   m_Sql = v
End Property

Public Property Get  Sql
   Sql = m_Sql
End Property

'表名或者视图名
Public Property Let  TableName(v)
   m_TableName = v
End Property

Public Property Get  TableName
   TableName = m_TableName
End Property

'列名用,隔开
Public Property Let  Columns(v)
   m_Columns = v
End Property

Public Property Get  Columns
   Columns = m_Columns
End Property

'当前页
Public Property Let  CurPage(v)
   m_CurPage = v
End Property

Public Property Get  CurPage
   CurPage = m_CurPage
End Property

'缓存类型：1,列表 2,详情
Public Property Let  CacheType(v)
   m_CacheType = v
End Property

Public Property Get  CacheType
   CacheType = m_CacheType
End Property

'缓存类型：1,列表 2,详情
Public Property Set  Conn(v)
   Set m_DataConn = v
End Property

Public Property Get  Conn
   Conn = m_DataConn
End Property

'返回记录总数
Public Property Get  RecordCount
   RecordCount = m_RecordCount
End Property

'返回记录数组
Public Property Get  SQLArr
   SQLArr = m_SQLArr
End Property

Rem 公共方法读取数据
Public Function ReadData
   If m_CacheType = 1 Then
      ReadListAndSearchData
   Else
      ReadContentData
   End If
End Function

Rem 读取详情信息
Private Function ReadContentData
   Dim xmlfile
   xmlfile = m_XmlFile
   If FSOExistsFile(xmlfile) Then '存在xml缓存，直接从xml中读取
      ReadContentDataFromXml xmlfile
   Else
      ReadContentDataFromDB
   End If
End Function

Rem 从xml文件读取详情信息
Private Function ReadContentDataFromXml(xmlfile)
   Dim SQLARR()
   Dim XmlDoc
   Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
   XmlDoc.Load xmlfile
   Dim itemslength,itemsi
   itemslength = XmlDoc.documentElement.childNodes.length

   For itemsi=0 To itemslength-1
      ReDim Preserve SQLARR(itemslength-1,0)
      SQLARR(itemsi,0) = XmlDoc.documentElement.childNodes(itemsi).text
   Next
   Set XmlDoc = Nothing
   m_SQLArr = SQLArr
End Function

Rem 从Db中读取详情信息
Private Function ReadContentDataFromDB()
   Dim rs
   Dim SQLARR
   Set rs = m_DataConn.execute(m_sql)
   IF Not Rs.eof Then
      SQLArr=Rs.GetRows(1)
      rs.close
      Set rs = Nothing
   Else
      rs.close
      Set rs = Nothing
      Exit Function
   End If
   m_SQLArr = SQLArr
End Function

Rem 读取列表数据
Private Function ReadListAndSearchData
   Dim sPagesize,TotalPage,CurPage,TotalRec
   sPagesize = m_PageSize * m_CachePageNum

   m_CurPage = CLng(m_CurPage)

   If m_CurPage Mod m_CachePageNum = 0 Then
      CurPage = m_CurPage/m_CachePageNum
   Else
      CurPage = int(clng(m_CurPage)/m_CachePageNum)+1
   End If

   Dim xmlfile
   xmlfile = getXmlFileName(CurPage)
   If FSOExistsFile(xmlfile) Then '存在xml缓存，直接从xml中读取
      ReadListAndSearchDataFromXml xmlfile
   Else
      ReadListAndSearchDataFromDB
   End If
End Function

Rem 从xml中读列表数据
Private Function ReadListAndSearchDataFromXml(xmlfile)
   Dim SQLARR()
   Dim XmlDoc
   Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument.3.0")
   XmlDoc.Load xmlfile
   Dim totalrecont
   totalrecont = XmlDoc.documentElement.selectSingleNode("totalrec").text
   m_RecordCount = totalrecont
   Dim TotalRec
   TotalRec = m_RecordCount
   If totalrecont = 0 Then
      Set XmlDoc = Nothing
      m_SQLArr = SQLARR
      Exit Function
   End If

   Dim TotalPage,curpage
   curpage = m_CurPage
   If m_CurPage Mod m_CachePageNum = 0 Then
      CurPage = m_CurPage/m_CachePageNum
   Else
      CurPage = int(clng(m_CurPage)/m_CachePageNum)+1
   End If

   If TotalRec Mod m_CachePageNum =0 Then
      TotalPage = totalrecont/m_CachePageNum
   Else
      TotalPage = int(clng(totalrecont)/m_CachePageNum)+1
   End If

   If curpage>TotalPage Then curpage=TotalPage
   Dim starti
   Dim startn
   startn = m_curpage - (curpage-1) * m_CachePageNum
   Rem 计算开始位置
   starti = (startn-1) * m_pagesize
   Dim items,item
   Set items = XmlDoc.documentElement.SelectNodes("item")
   Dim i
   Dim num
   Dim length
   length = items.length
   num = 0
   For i = starti To m_PageSize + starti -1
      If i >=length Then Exit For
      Set item = items(i)
      Dim attrlength
      attrlength = item.attributes.length
      ReDim Preserve SQLARR(attrlength,num)
      Dim Attribute
      Dim Attributei
      Attributei = 0
      For Attributei = 0 To attrlength-1
         SQLArr(Attributei,num) = item.attributes(Attributei).Nodevalue
      Next
      num = num + 1
   Next
   Set XmlDoc = Nothing
   m_SQLArr = SQLArr
End Function

Rem 从DB中读列表数据
Private Function ReadListAndSearchDataFromDB
   Dim rs,TotalRec,CurPage
   CurPage = m_CurPage
   Set Rs = Server.CreateObject("Adodb.Recordset")
   Rs.open m_sql,m_DataConn,1
   TotalRec = rs.recordcount
   m_RecordCount = TotalRec
   rs.pagesize = m_PageSize
   If  CurPage>rs.PageCount Then  CurPage = rs.PageCount
   If Not rs.eof Then rs.absolutePage=m_CurPage
   Dim SQLARR()
   Dim k
   k = 0
   While Not rs.eof and k<m_PageSize
      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
   rs.close
   Set rs = Nothing
   m_SQLArr = SQLArr
End Function

Rem 获取xml文件名称
Private Function getXmlFileName(num)
   Dim tmpstr
   tmpstr = LCase(m_XmlFile)
   If Right(tmpstr,4) = ".xml" Then
      tmpstr = Left(tmpstr,Len(tmpstr)-Len(".xml"))
   End If
   tmpstr = Replace(tmpstr,"%","_")
   tmpstr = tmpstr & "_" & num & ".xml"
   getXmlFileName = tmpstr
End Function

Rem 公共方法将数据写入xml文件
Public Function WriteDataToXml
   If m_CacheType = 1 Then
      WriteListAndSearchDataToXml
   Else
      WriteContentDataToXml
   End If
End Function

Rem 写具体某条信息的详情xml
Private Function WriteContentDataToXml
   Rem xml未过期则直接退出
   Dim xmlfile
   xmlfile = m_XmlFile
   If FSOExistsFile(xmlfile) Then
      If Not isXmlCacheExpired(xmlfile,m_CacheTime) Then  Exit Function
   End If
   Dim rs
   Set rs = Server.CreateObject("Adodb.Recordset")

   Rs.open m_sql,m_DataConn
   CreateContentXmlFile xmlfile,Rs
End Function

Rem 列表和搜索xml数据
Private Function WriteListAndSearchDataToXml

   Dim sPagesize,TotalPage,CurPage,TotalRec
   sPagesize = m_PageSize * m_CachePageNum

   m_CurPage = CLng(m_CurPage)

   If m_CurPage Mod m_CachePageNum = 0 Then
      CurPage = m_CurPage/m_CachePageNum
   Else
      CurPage = int(clng(m_CurPage)/m_CachePageNum)+1
   End If

   Dim xmlfile
   xmlfile = getXmlFileName(CurPage)

   Rem 如果xml未过期则直接退出
   If FSOExistsFile(xmlfile) Then
      If Not isXmlCacheExpired(xmlfile,m_CacheTime) Then  Exit Function
   End If
   Dim rs
   Set Rs = Server.CreateObject("Adodb.Recordset")
   Rs.open m_sql,m_DataConn,1
   TotalRec = rs.recordcount
   rs.pagesize = sPagesize
   If  CurPage>rs.PageCount Then  CurPage = rs.PageCount
   CreateListAndSearchXMLFile xmlfile,TotalRec,Rs,sPagesize
End Function

Rem 私有方法
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 判断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 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 CreateContentXmlFile(xmlfile,Rs)
   Dim xmlcontent
   xmlcontent = "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline
   xmlcontent = xmlcontent & "<root>" & vbnewline

   Dim field
   For Each field In rs.Fields
      xmlcontent = xmlcontent & "<"&field.name&">"
      Dim value
      value = field.value
      If TypeName(value) = "String" Then
         xmlcontent = xmlcontent & "<![CDATA[" & Trim(value) & "]]>"
      Else
         xmlcontent = xmlcontent &  Trim(value)
      End If
      xmlcontent = xmlcontent & "</"&field.name&">" & vbnewline
   Next
   rs.close
   Set rs = Nothing
   xmlcontent = xmlcontent & "</root>" & vbnewline

   Dim folderpath
   folderpath = Trim(left(xmlfile,InstrRev(xmlfile,"\")-1))
   Call CreateDIR(folderpath&"") '创建文件夹
   WriteStringToXMLFile xmlfile,xmlcontent
End Function

Rem 生成列表的xml
Private Function CreateListAndSearchXMLFile(xmlfile,TotalRec,Rs,sPagesize)
   Dim xmlcontent
   xmlcontent = ""
   xmlcontent = xmlcontent & "<?xml version=""1.0"" encoding=""gb2312""?>" & vbnewline
   xmlcontent = xmlcontent & " <root>" & vbnewline
   xmlcontent = xmlcontent & "  <totalrec>" & TotalRec & "</totalrec>" & vbnewline

   Dim k
   k = 0
   Dim field
   While Not rs.eof and k<sPagesize
      xmlcontent = xmlcontent & "  <item "
      For Each field In rs.Fields
         xmlcontent = xmlcontent & field.name & "=""" & XMLStringEnCode(field.value) & """ "
      Next
      xmlcontent = xmlcontent &  "></item>" & vbnewline
      rs.movenext
      k=k+1
   Wend
   rs.close
   Set rs = Nothing
   xmlcontent = xmlcontent & " </root>" & vbnewline
   Dim folderpath
   folderpath = Trim(left(xmlfile,InstrRev(xmlfile,"\")-1))
   Call CreateDIR(folderpath&"") '创建文件夹
   WriteStringToXMLFile xmlfile,xmlcontent
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 Sub WriteStringToXMLFile(filename,str)
   'On Error Resume Next
   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 创建文件夹
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
%>

此类包含两种缓存方式：一种是基于列表方式的，如按照某个类别显示信息、搜索某个关键词进行显示；另外一种是详细页面的缓存，如显示具体的某篇文章。
此类与具体的业务逻辑无关，只负责xml数据的读取和存储，判断是否缓存过期决定是否需要更新缓存。按照三层构架模式的话，它处于数据访问层。