| 導購 | 订阅 | 在线投稿
分享
 
 
 

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

2008-09-23 07:48:05  編輯來源:互聯網  简体版  手機版  評論  字體: ||
 
  打造一个高性能稳定的web站点一直是站长和程序员的梦想,本文用作者的一次亲身经历的来说说如何利用xml缓存技术实现站点的高性能。我是从今年开始做138手机主题网的,采用SQL2000做为数据库,开发语言用的是Asp,查询的时候都是动态查询,直接用like %的方式,那个时候反正一天的访问量小,同时在线的时候也就几十个人而已,所以服务器也就能胜任要求,随着访问量慢慢增加,当同时在线达到几百人时,此时服务器开始不堪重负,CPU常常达到100%不降,网页打开速度也超级慢,一个查询页面需要几秒钟甚至更长,于是我开始考虑优化程序和数据库,数据库建立索引,不是很理想,因为用的是like '% 这种方式,于是我想到了缓存,而xml本身的特点决定了他非常适合做数据库的缓存,好东西不敢独享,特发布出来,以便同行交流,共同进步。

  实现的思路是这样的:程序读取信息时,先判断是否缓存了xml数据,如果有,则直接从xml中读取信息,否则从数据库中读取,并将此次结果生成xml文件,以便以后调用,加快速度,同时判断xml缓存文件是否过期,如果过期则需要重新生成xml。下面是具体的代码。

  xmlcachecls.asp

  <%

  Rem xml数据缓存类

  '--------------------------------------------------

  '转载的时候请保留版权信息

  '作者:walkman

  '网址:手机主题 http://www.shouji138.com

  '版本: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路径,用绝对地址

  'http://www.knowsky.com/article.asp?typeid=2

  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

  '返回记录数组

  'http://www.devdao.com/

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

   str = Replace(str,">","&gt;")

   str = Replace(str,"'","&apos;")

   str = Replace(str,"""","&quot;")

   str = Replace(str,"&","&amp;")

   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数据的读取和存储,判断是否缓存过期决定是否需要更新缓存。按照三层构架模式的话,它处于数据访问层。

  调用这个类的代码:

  Business.asp

  <%

  Rem xml数据缓存类业务逻辑层代码

  '--------------------------------------------------

  '转载的时候请保留版权信息

  '作者:walkman

  '网址:手机主题 http://www.shouji138.com

  '版本:ver1.0

  '欢迎各位交流进步

  '--------------------------------------------------

  Rem 根据classid取列表数据

  Function GetListarr(classid,curpage,PageSize,CachePageNum,ByRef RecordCount)

  openConn

  Dim sql

  sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where win_theme.ClassID="&classid&" order by thmid desc"

  Dim cache

  Set cache = new XmlCacheCls

  cache.PageSize = PageSize '每页N条记录

  cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量

  cache.XmlFile = Server.Mappath("xmlcache/classxml/list_"&classid&".xml")

  cache.Sql = sql

  cache.CurPage = curpage

  cache.CacheType = 1

  Set cache.Conn = conn

  cache.ReadData

  Dim SqlArr

  SQLArr = cache.SQLArr

  RecordCount = cache.RecordCount

  Set cache = Nothing

  GetListarr = SqlArr

  End Function

  Rem 根据classid生成xml缓存

  Function CreateListxml(classid,curpage,PageSize,CachePageNum,CacheTime)

  Dim sql

  sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where win_theme.ClassID="&classid&" order by thmid desc"

  Dim cache

  Set cache = new XmlCacheCls

  cache.CacheTime = CacheTime '缓存时间

  cache.PageSize = PageSize '每页N条记录

  cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量

  cache.XmlFile = Server.Mappath("xmlcache/classxml/list_"&classid&".xml")

  cache.Sql = sql

  cache.CurPage = curpage

  cache.CacheType = 1

  Set cache.Conn = conn

  cache.WriteDataToXml

  Set cache = Nothing

  End Function

  Rem 根据keyword取列表数据

  Function GetSearcharr(keyword,curpage,PageSize,CachePageNum,ByRef RecordCount)

  openConn

  Dim sql

  Dim sqlkey

  sqlkey = Replace(keyword,"'","")

  sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where ThmName like '%"&sqlkey&"%' or ThmRange like '%"&sqlkey&"%' or ThmInstro like '%"&sqlkey&"%' order by thmid desc"

  Dim cache

  Set cache = new XmlCacheCls

  cache.PageSize = PageSize '每页N条记录

  cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量

  cache.XmlFile = Server.Mappath("xmlcache/searchxml/list_"&Server.URlEncode(Replace(keyword,"'",""))&".xml")

  cache.Sql = sql

  cache.CurPage = curpage

  cache.CacheType = 1

  Set cache.Conn = conn

  cache.ReadData

  Dim SqlArr

  SQLArr = cache.SQLArr

  RecordCount = cache.RecordCount

  Set cache = Nothing

  GetSearcharr = SqlArr

  End Function

  Rem 根据keyword生成xml缓存

  Function CreateSearchxml(keyword,curpage,PageSize,CachePageNum,CacheTime)

  Dim sql

  Dim sqlkey

  sqlkey = Replace(keyword,"'","")

  sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where ThmName like '%"&sqlkey&"%' or ThmRange like '%"&sqlkey&"%' or ThmInstro like '%"&sqlkey&"%' order by thmid desc"

  Dim cache

  Set cache = new XmlCacheCls

  cache.CacheTime = CacheTime '缓存时间

  cache.PageSize = PageSize '每页N条记录

  cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量

  cache.XmlFile = Server.Mappath("xmlcache/searchxml/list_"&Server.URlEncode(Replace(keyword,"'",""))&".xml")

  cache.Sql = sql

  cache.CurPage = curpage

  cache.CacheType = 1

  Set cache.Conn = conn

  cache.WriteDataToXml

  Set cache = Nothing

  End Function

  Rem 根据classid取列表数据

  Function GetDetailarr(thmid)

  openConn

  Dim sql

  sql = "select a.thmid,a.thmname,a.classid,b.classname,a.picfileurl,a.thmver,a.thmsize,a.thminstro,a.thmrange,a.thmfileurl,a.adddate from win_theme a,Win_Classify b where a.classid=b.classid and a.thmid="&thmid&""

  Dim thmidmod

  thmidmod = thmid Mod 100

  Dim cache

  Set cache = new XmlCacheCls

  cache.XmlFile = Server.Mappath("xmlcache/detailxml/"&thmidmod&"/"&thmid&".xml")

  cache.Sql = sql

  cache.CacheType = 2

  Set cache.Conn = conn

  cache.ReadData

  Dim SqlArr

  SQLArr = cache.SQLArr

  Set cache = Nothing

  GetDetailarr = SqlArr

  End Function

  Rem 根据keyword生成xml缓存

  Function CreateDetailxml(thmid,CacheTime)

  Dim sql

  sql = "select a.thmid,a.thmname,a.classid,b.classname,a.picfileurl,a.thmver,a.thmsize,a.thminstro,a.thmrange,a.thmfileurl,a.adddate from win_theme a,Win_Classify b where a.classid=b.classid and a.thmid="&thmid&""

  Dim thmidmod

  thmidmod = thmid Mod 100

  Dim cache

  Set cache = new XmlCacheCls

  cache.CacheTime = CacheTime '缓存时间

  cache.XmlFile = Server.Mappath("xmlcache/detailxml/"&thmidmod&"/"&thmid&".xml")

  cache.Sql = sql

  cache.CacheType = 2

  Set cache.Conn = conn

  cache.WriteDataToXml

  Set cache = Nothing

  End Function

  Rem 检测动态数组是否已分配

  Function ismalloc(a)

  On Error Resume Next

  Dim i

  i = UBound(a)

  If Err Then

  ismalloc = False

  Else

  ismalloc = True

  End If

  End Function

  Function showData(SQLArr)

  If Not ismalloc(SQLArr) Then Exit Function

  Dim i,k

  Dim num

  num = 0

  i = UBound(SQLArr,1)

  k = UBound(SQLArr,2)

  Dim m,n

  For m = 0 To k

   num = num+1

  %>

  <ul class="listbox" onMouseOver="overtb(this)" onMouseOut="outtb(this)">

  <li>

  <a title="<%=SQLArr(1,m)%>" href="detail.asp?id=<%=SQLArr(0,m)%>" target="_blank">

   <img height="140" alt="<%=SQLArr(1,m)%>" src="http://www.shouji138.com<%=SQLArr(2,m)%>" width="107" border="0"></a>

  </li>

  <li class="green bold">

  <a title="<%=SQLArr(1,m)%>" href="detail.asp?id=<%=SQLArr(0,m)%>" target="_blank">

  <%=walkgottopic(Trim(SQLArr(1,m)),18)%></a>

  </li>

  <li><%=DateValue(SQLArr(3,m))%></li>

  </ul>

  <%

  next

  End Function

  %>

  这个文件是业务逻辑层代码,负责根据不同的业务逻辑来实现xml数据的读取和写入,并提供接口方法给web表现层调用。

  具体的调用代码:

  list.asp

  只显示相关代码。

  <%

  。。。。。。

  Dim classid

  classid = Request("classid")

  If classid = "" Or (Not IsNumeric(classid)) Then Response.write "参数错误!":Response.End()

  classid = CLng(classid)

  Dim sPagesize,TotalPage,CurPage,TotalRec,CachePageNum

  sPagesize = 20

  CachePageNum = 10

  CurPage = Trim(Request("page"))

  IF CurPage="" Or (Not IsNumeric(CurPage)) Then

   CurPage=1

  Else

   CurPage=Clng(CurPage)

  End IF

  Dim myarr

  myarr = GetListarr(classid,CurPage,sPagesize,CachePageNum,TotalRec)

  '总页数

  TotalPage = int(clng(TotalRec)/sPagesize*-1)*-1

  If Clng(TotalRec)>0 Then

  showData myarr

  End If

  ................

  %>

  最后在页面最底部调用一个asp的script语句来更新xml缓存。

  <script type="text/javascript" src="setcache.asp?action=list&curpage=<%=curpage%>&classid=<%=classid%>"></script>

  setcache.asp

  相关代码

  <%

  openconn

  Dim action

  action = Trim(Request("action"))&""

  Dim curpage

  curpage = Request("curpage")

  Dim classid

  Dim keyword

  Dim thmid

  If action = "list" Then

  classid = Request("classid")

  If classid="" Or (Not IsNumeric(classid)) Or curpage="" Or (Not IsNumeric(curpage)) Then

  Else

   CreateListxml CLng(classid),CLng(curpage),20,10,60 * 60 * 2 '创建分类的xml

  End If

  ElseIf action = "search" Then

  keyword = Trim(Request("keyword"))

  If keyword="" Then

  Else

   CreateSearchxml keyword,CLng(curpage),20,10,60 * 60 * 2 '创建搜索的xml

  End If

  ElseIf action = "detail" Then

  thmid = Request("id")

  If thmid="" Or (Not IsNumeric(thmid)) Then

  Else

   CreateDetailxml CLng(thmid),60 * 60 * 2 '创建详情的xml

  End If

  End If

  Call Closeconn

  Response.write " "

  Response.End

  %>

  至此,核心代码都分享出来了,实践证明,通过这样的方式,我的138手机主题网的服务器的CPU占用率和内存占用率明显下降,访问速度也明显提高,从以前的需要几秒甚至10多秒,到现在只需要10几毫秒。

  为了方便大家理解其中的代码,我特地做了一个demo,供同行学习交流。地址:http://www.shouji138.com/aspnet2/demo

  此例程的完整下载包:http://www.shouji138.com/aspnet2/demo/xmlcachedemo.rar

  本人QQ:441003232 欢迎大家交流共同进步。

  也可以访问本人的小站:手机主题:http://www.shouji138.com
 
 
 
打造一个高性能稳定的web站点一直是站长和程序员的梦想,本文用作者的一次亲身经历的来说说如何利用xml缓存技术实现站点的高性能。我是从今年开始做138手机主题网的,采用SQL2000做为数据库,开发语言用的是Asp,查询的时候都是动态查询,直接用like %的方式,那个时候反正一天的访问量小,同时在线的时候也就几十个人而已,所以服务器也就能胜任要求,随着访问量慢慢增加,当同时在线达到几百人时,此时服务器开始不堪重负,CPU常常达到100%不降,网页打开速度也超级慢,一个查询页面需要几秒钟甚至更长,于是我开始考虑优化程序和数据库,数据库建立索引,不是很理想,因为用的是like '% 这种方式,于是我想到了缓存,而xml本身的特点决定了他非常适合做数据库的缓存,好东西不敢独享,特发布出来,以便同行交流,共同进步。 实现的思路是这样的:程序读取信息时,先判断是否缓存了xml数据,如果有,则直接从xml中读取信息,否则从数据库中读取,并将此次结果生成xml文件,以便以后调用,加快速度,同时判断xml缓存文件是否过期,如果过期则需要重新生成xml。下面是具体的代码。 xmlcachecls.asp <% Rem xml数据缓存类 '-------------------------------------------------- '转载的时候请保留版权信息 '作者:walkman '网址:手机主题 [url=http://www.shouji138.com/]http://www.shouji138.com[/url] '版本: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路径,用绝对地址 'http://www.knowsky.com/article.asp?typeid=2 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 '返回记录数组 'http://www.devdao.com/ 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,"<","&lt;") str = Replace(str,">","&gt;") str = Replace(str,"'","&apos;") str = Replace(str,"""","&quot;") str = Replace(str,"&","&amp;") 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数据的读取和存储,判断是否缓存过期决定是否需要更新缓存。按照三层构架模式的话,它处于数据访问层。 调用这个类的代码: Business.asp <% Rem xml数据缓存类业务逻辑层代码 '-------------------------------------------------- '转载的时候请保留版权信息 '作者:walkman '网址:手机主题 [url=http://www.shouji138.com/]http://www.shouji138.com[/url] '版本:ver1.0 '欢迎各位交流进步 '-------------------------------------------------- Rem 根据classid取列表数据 Function GetListarr(classid,curpage,PageSize,CachePageNum,ByRef RecordCount) openConn Dim sql sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where win_theme.ClassID="&classid&" order by thmid desc" Dim cache Set cache = new XmlCacheCls cache.PageSize = PageSize '每页N条记录 cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量 cache.XmlFile = Server.Mappath("xmlcache/classxml/list_"&classid&".xml") cache.Sql = sql cache.CurPage = curpage cache.CacheType = 1 Set cache.Conn = conn cache.ReadData Dim SqlArr SQLArr = cache.SQLArr RecordCount = cache.RecordCount Set cache = Nothing GetListarr = SqlArr End Function Rem 根据classid生成xml缓存 Function CreateListxml(classid,curpage,PageSize,CachePageNum,CacheTime) Dim sql sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where win_theme.ClassID="&classid&" order by thmid desc" Dim cache Set cache = new XmlCacheCls cache.CacheTime = CacheTime '缓存时间 cache.PageSize = PageSize '每页N条记录 cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量 cache.XmlFile = Server.Mappath("xmlcache/classxml/list_"&classid&".xml") cache.Sql = sql cache.CurPage = curpage cache.CacheType = 1 Set cache.Conn = conn cache.WriteDataToXml Set cache = Nothing End Function Rem 根据keyword取列表数据 Function GetSearcharr(keyword,curpage,PageSize,CachePageNum,ByRef RecordCount) openConn Dim sql Dim sqlkey sqlkey = Replace(keyword,"'","") sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where ThmName like '%"&sqlkey&"%' or ThmRange like '%"&sqlkey&"%' or ThmInstro like '%"&sqlkey&"%' order by thmid desc" Dim cache Set cache = new XmlCacheCls cache.PageSize = PageSize '每页N条记录 cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量 cache.XmlFile = Server.Mappath("xmlcache/searchxml/list_"&Server.URlEncode(Replace(keyword,"'",""))&".xml") cache.Sql = sql cache.CurPage = curpage cache.CacheType = 1 Set cache.Conn = conn cache.ReadData Dim SqlArr SQLArr = cache.SQLArr RecordCount = cache.RecordCount Set cache = Nothing GetSearcharr = SqlArr End Function Rem 根据keyword生成xml缓存 Function CreateSearchxml(keyword,curpage,PageSize,CachePageNum,CacheTime) Dim sql Dim sqlkey sqlkey = Replace(keyword,"'","") sql = "select thmid,thmname,picfileurl,win_theme.adddate from win_theme where ThmName like '%"&sqlkey&"%' or ThmRange like '%"&sqlkey&"%' or ThmInstro like '%"&sqlkey&"%' order by thmid desc" Dim cache Set cache = new XmlCacheCls cache.CacheTime = CacheTime '缓存时间 cache.PageSize = PageSize '每页N条记录 cache.CachePageNum = CachePageNum '一个xml文件缓存M页的数据量 cache.XmlFile = Server.Mappath("xmlcache/searchxml/list_"&Server.URlEncode(Replace(keyword,"'",""))&".xml") cache.Sql = sql cache.CurPage = curpage cache.CacheType = 1 Set cache.Conn = conn cache.WriteDataToXml Set cache = Nothing End Function Rem 根据classid取列表数据 Function GetDetailarr(thmid) openConn Dim sql sql = "select a.thmid,a.thmname,a.classid,b.classname,a.picfileurl,a.thmver,a.thmsize,a.thminstro,a.thmrange,a.thmfileurl,a.adddate from win_theme a,Win_Classify b where a.classid=b.classid and a.thmid="&thmid&"" Dim thmidmod thmidmod = thmid Mod 100 Dim cache Set cache = new XmlCacheCls cache.XmlFile = Server.Mappath("xmlcache/detailxml/"&thmidmod&"/"&thmid&".xml") cache.Sql = sql cache.CacheType = 2 Set cache.Conn = conn cache.ReadData Dim SqlArr SQLArr = cache.SQLArr Set cache = Nothing GetDetailarr = SqlArr End Function Rem 根据keyword生成xml缓存 Function CreateDetailxml(thmid,CacheTime) Dim sql sql = "select a.thmid,a.thmname,a.classid,b.classname,a.picfileurl,a.thmver,a.thmsize,a.thminstro,a.thmrange,a.thmfileurl,a.adddate from win_theme a,Win_Classify b where a.classid=b.classid and a.thmid="&thmid&"" Dim thmidmod thmidmod = thmid Mod 100 Dim cache Set cache = new XmlCacheCls cache.CacheTime = CacheTime '缓存时间 cache.XmlFile = Server.Mappath("xmlcache/detailxml/"&thmidmod&"/"&thmid&".xml") cache.Sql = sql cache.CacheType = 2 Set cache.Conn = conn cache.WriteDataToXml Set cache = Nothing End Function Rem 检测动态数组是否已分配 Function ismalloc(a) On Error Resume Next Dim i i = UBound(a) If Err Then ismalloc = False Else ismalloc = True End If End Function Function showData(SQLArr) If Not ismalloc(SQLArr) Then Exit Function Dim i,k Dim num num = 0 i = UBound(SQLArr,1) k = UBound(SQLArr,2) Dim m,n For m = 0 To k num = num+1 %> <ul class="listbox" onMouseOver="overtb(this)" onMouseOut="outtb(this)"> <li> <a title="<%=SQLArr(1,m)%>" href="detail.asp?id=<%=SQLArr(0,m)%>" target="_blank"> <img height="140" alt="<%=SQLArr(1,m)%>" src="[url=http://www.shouji138.com]http://www.shouji138.com<%=SQLArr(2,m)%[/url]>" width="107" border="0"></a> </li> <li class="green bold"> <a title="<%=SQLArr(1,m)%>" href="detail.asp?id=<%=SQLArr(0,m)%>" target="_blank"> <%=walkgottopic(Trim(SQLArr(1,m)),18)%></a> </li> <li><%=DateValue(SQLArr(3,m))%></li> </ul> <% next End Function %> 这个文件是业务逻辑层代码,负责根据不同的业务逻辑来实现xml数据的读取和写入,并提供接口方法给web表现层调用。 具体的调用代码: list.asp 只显示相关代码。 <% 。。。。。。 Dim classid classid = Request("classid") If classid = "" Or (Not IsNumeric(classid)) Then Response.write "参数错误!":Response.End() classid = CLng(classid) Dim sPagesize,TotalPage,CurPage,TotalRec,CachePageNum sPagesize = 20 CachePageNum = 10 CurPage = Trim(Request("page")) IF CurPage="" Or (Not IsNumeric(CurPage)) Then CurPage=1 Else CurPage=Clng(CurPage) End IF Dim myarr myarr = GetListarr(classid,CurPage,sPagesize,CachePageNum,TotalRec) '总页数 TotalPage = int(clng(TotalRec)/sPagesize*-1)*-1 If Clng(TotalRec)>0 Then showData myarr End If ................ %> 最后在页面最底部调用一个asp的script语句来更新xml缓存。 <script type="text/javascript" src="setcache.asp?action=list&curpage=<%=curpage%>&classid=<%=classid%>"></script> setcache.asp 相关代码 <% openconn Dim action action = Trim(Request("action"))&"" Dim curpage curpage = Request("curpage") Dim classid Dim keyword Dim thmid If action = "list" Then classid = Request("classid") If classid="" Or (Not IsNumeric(classid)) Or curpage="" Or (Not IsNumeric(curpage)) Then Else CreateListxml CLng(classid),CLng(curpage),20,10,60 * 60 * 2 '创建分类的xml End If ElseIf action = "search" Then keyword = Trim(Request("keyword")) If keyword="" Then Else CreateSearchxml keyword,CLng(curpage),20,10,60 * 60 * 2 '创建搜索的xml End If ElseIf action = "detail" Then thmid = Request("id") If thmid="" Or (Not IsNumeric(thmid)) Then Else CreateDetailxml CLng(thmid),60 * 60 * 2 '创建详情的xml End If End If Call Closeconn Response.write " " Response.End %> 至此,核心代码都分享出来了,实践证明,通过这样的方式,我的138手机主题网的服务器的CPU占用率和内存占用率明显下降,访问速度也明显提高,从以前的需要几秒甚至10多秒,到现在只需要10几毫秒。 为了方便大家理解其中的代码,我特地做了一个demo,供同行学习交流。地址:[url=http://www.shouji138.com/aspnet2/demo]http://www.shouji138.com/aspnet2/demo[/url] 此例程的完整下载包:[url=http://www.shouji138.com/aspnet2/demo/xmlcachedemo.rar]http://www.shouji138.com/aspnet2/demo/xmlcachedemo.rar[/url] 本人QQ:441003232 欢迎大家交流共同进步。 也可以访问本人的小站:手机主题:http://www.shouji138.com
󰈣󰈤
 
 
 
>>返回首頁<<
 
 
 
 
 
 熱帖排行
 
 
王朝网络微信公众号
微信扫码关注本站公众号 wangchaonetcn
 
  免责声明:本文仅代表作者个人观点,与王朝网络无关。王朝网络登载此文出于传递更多信息之目的,并不意味著赞同其观点或证实其描述,其原创性以及文中陈述文字和内容未经本站证实,对本文以及其中全部或者部分内容、文字的真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
© 2005- 王朝網路 版權所有