以文本方式查看主题

-  中文XML论坛 - 专业的XML技术讨论区  (http://bbs.xml.org.cn/index.asp)
--  『 Dot NET,C#,ASP,VB 』  (http://bbs.xml.org.cn/list.asp?boardid=43)
----  ASP中Cache技术的应用  (http://bbs.xml.org.cn/dispbbs.asp?boardid=43&rootid=&id=13399)

--  作者：愚者
--  发布时间：1/9/2005 8:19:00 PM

--  ASP中Cache技术的应用
出处：CSDN
作者：qihboy  

********************************************
Code
　　ASP：default.asp
    --------------------
　 <%@Language=VBScript%>
　　<%Option  Explicit%>
　　<%Response.Buffer=True%>
　　<!--#include file = "conn.asp"-->
　　<!--#include file = "GetCache.asp"-->
　　<HTML>
　　<HEAD>
　　<TITLE>ASP Cache演示</TITLE>
　　<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=gb2312">
　　</HEAD>
　　<BODY>
　　<h4>每隔10秒刷新Cache：</h4>
　　<%
　　response.Flush
　　GetHTMLStream
　　response.Write
　　HTMLStream
　　%>
　　</body>
　　</html>

    ASP：getcache.asp
    --------------------
　 <%
　　Const CACHE_DEFAULT_INTERVAL = 30 '每隔30秒刷新一次cache
　　Dim HTMLStream
　　Dim IsExpires
　　IsExpires = CacheExpires
　　Function CacheExpires
　　Dim strLastUpdate
　　Dim result strLastUpdate = Application("LastUpdate")
　　If (strLastUpdate = "") Or (CACHE_DEFAULT_INTERVAL < DateDiff("s", strLastUpdate, Now)) Then
　　result = true
　　SetLastUpdateTime
　　Else
　　result = false
　　End If
　　CacheExpires = result
　　End Function
    Sub SetLastUpdateTime
　　Application.Lock
　　Application("LastUpdate") = CStr(now())
　　Application.UnLock
　　End Sub
　　Sub GetHTMLStream
　　If IsExpires Then
　　UpdateHTMLStream
　　End If
　　HTMLStream=Application("CACHE_HTMLStream")
　　End Sub

　　Sub UpdateHTMLStream
　　dim d
　　d = FetchHTMLStream
　　Application.Lock
　　Application("CACHE_HTMLStream") = d
　　Application.UnLock
　　End Sub

　　Function FetchHTMLStream  
　　Dim rs ,strSQL, strHTML
　　Set rs = CreateObject("ADODB.Recordset")
　　strSQL = "select categoryID , categoryname from categories"
　　rs.Open strSQL, strConn,adOpenForwardOnly,adLockReadOnly
　　strHTML = strHTML & "<select name=""slt_search"">"
　　while (not rs.EOF)
　　strHTML = strHTML & "<option>"
　　strHTML = strHTML & rs.Fields("categoryname")
　　strHTML = strHTML & "</option>" rs.MoveNext
　　wend
　　strHTML = strHTML & "</select>"
　　rs.Close
　　Set rs = Nothing
　　FetchHTMLStream = strHTML
　　End Function
　　%>

    ASP：conn.asp
    --------------------
　 <!--METADATA NAME="Microsoft ActiveX Data Objects 2.5 Library" TYPE="TypeLib" UUID="{00000205-0000-0010-8000-00AA006D2EA4}"-->
　　<%
　　dim strConn
　　strConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Northwind"
　　%>

--  作者：上水道的
--  发布时间：1/26/2005 9:59:00 PM

--  
这样的缓存不太好，对于减轻服务器负担没起多大作用
--  作者：上水道的
--  发布时间：1/26/2005 10:02:00 PM

--  
我贴两个CLASS文件吧，缓存递归出来的数据，这样的缓存才有意义

写得比较复杂，两个类是互为调用的

<%
Class clsCache
 Private Conn,cheName,CacheType
 
 '-----------------------------------------------------------------------------------
 '初始化当前页的值
 Private Sub Class_Initialize
 End Sub
 '-----------------------------------------------------------------------------------

 '-----------------------------------------------------------------------------------
 '设置 Terminate 事件。
 Private Sub Class_Terminate
 End Sub
 '-----------------------------------------------------------------------------------

 '###################################################################################
 '# 属性设置
 '###################################################################################
 
 '-----------------------------------------------------------------------------------
 '属性,设置数据库连接对象
 Public Property Let Connection(Obj_Conn)
  Set Conn = Obj_Conn
 End Property
 '-----------------------------------------------------------------------------------

 '-----------------------------------------------------------------------------------
 '属性,设置Application对象
 Public Property Let Name(str_cheName)
  cheName = str_cheName
 End Property
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '属性,设置Application对象存储对象
 Public Property Let cheType(str_cheType)
  CacheType = str_cheType
 End Property
 '-----------------------------------------------------------------------------------

 '###################################################################################
 '# 函数
 '###################################################################################

 '-----------------------------------------------------------------------------------
 '得到Application对象存储内容
 Public Function Value()
  If Application(cheName) = "" Then
   Select Case CacheType
    Case "Class"
    Application(cheName) = getClass()
   End Select
  End If
  Value = Application(cheName)
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 'Class的Cache
 Private Function getClass()
  Dim BlogClass
  Set BlogClass = New clsClass
  BlogClass.Connection = Conn
  BlogClass.nodeUser(0)
  getClass = BlogClass.Value
  Set BlogClass = Nothing
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '更新Cache
 Public Sub Update()
  Select Case CacheType
   Case "Class"
   Application(cheName) = getClass()
  End Select
 End Sub
 '-----------------------------------------------------------------------------------
End Class
%>

--  作者：上水道的
--  发布时间：1/26/2005 10:02:00 PM

--  
<%
Class clsClass
 Private Conn
 Private i
 Private outPut
 
 '-----------------------------------------------------------------------------------
 '初始化当前页的值
 Private Sub Class_Initialize
 End Sub
 '-----------------------------------------------------------------------------------

 '-----------------------------------------------------------------------------------
 '设置 Terminate 事件。
 Private Sub Class_Terminate
 End Sub
 '-----------------------------------------------------------------------------------

 '###################################################################################
 '# 属性设置
 '###################################################################################

 '-----------------------------------------------------------------------------------
 '属性,设置数据库连接对象
 Public Property Let Connection(Obj_Conn)
  Set Conn = Obj_Conn
 End Property
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '属性,得到输出的树目录
 Public Property Get Value()
  Value = outPut
 End Property
 '-----------------------------------------------------------------------------------

 '###################################################################################
 '# 函数
 '###################################################################################

 '-----------------------------------------------------------------------------------
 '增加新分类
 Public Function newClass(Pid,Name)
  Dim CMD,Rs
  Set CMD = Server.CreateObject("ADODB.COMMAND")
  CMD.ActiveConnection = Conn
  CMD.CommandType = 4
  CMD.CommandText = "Blog_NewClass"
  On Error Resume Next
  Set Rs = CMD.Execute ( ,Array(Pid,Name))
  Set CMD = Nothing
  If Err.number <> 0 Then
   newClass = -1
  Else
   newClass = 0
  End If
  Set Rs = Nothing
  Call refresh()
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '修改分类
 Public Function modiClass(Name,Id)
  Dim CMD,Rs
  Set CMD = Server.CreateObject("ADODB.COMMAND")
  CMD.ActiveConnection = Conn
  CMD.CommandType = 4
  CMD.CommandText = "Blog_ModiClass"
  On Error Resume Next
  Set Rs = CMD.Execute ( ,Array(Name,Id))
  Set CMD = Nothing
  If Err.number <> 0 Then
   modiClass = -1
  Else
   modiClass = 0
  End If
  Set Rs = Nothing
  Call refresh()
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '删除分类
 Public Function delClass(Id)
  Dim tempRs
  set tempRs = listClass(cint(Id))
  do while not tempRs.Eof
   '递归删除子目录
   delClass(CInt(tempRs(0)))
  tempRs.MoveNext
  loop
  Dim CMD,Rs
  Set CMD = Server.CreateObject("ADODB.COMMAND")
  CMD.ActiveConnection = Conn
  CMD.CommandType = 4
  CMD.CommandText = "Blog_DelClass"
  On Error Resume Next
  Set Rs = CMD.Execute ( ,Array(Id))
  Set CMD = Nothing
  If Err.number <> 0 Then
   delClass = -1
  Else
   delClass = 0
  End If
  Set Rs = Nothing
  tempRs.close
  set tempRs = nothing
  Call refresh()
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '修改分类排序
 Public Function orderClass(Order,Id)
  Dim CMD,Rs
  Set CMD = Server.CreateObject("ADODB.COMMAND")
  CMD.ActiveConnection = Conn
  CMD.CommandType = 4
  CMD.CommandText = "Blog_OrderClass"
  On Error Resume Next
  Set Rs = CMD.Execute ( ,Array(Order,Id))
  Set CMD = Nothing
  If Err.number <> 0 Then
   orderClass = -1
  Else
   orderClass = 0
  End If
  Set Rs = Nothing
  Call refresh()
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '分类列表
 Public Function listClass(Pid)
  Dim CMD,Rs
  Set CMD=Server.CreateObject("ADODB.COMMAND")
  CMD.ActiveConnection = Conn
  CMD.CommandType = 4
  CMD.CommandText = "Blog_ClassList"
  Set Rs = CMD.Execute ( ,Array(Pid))
  Set CMD = Nothing
  Set listClass = Rs
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '根据C_Id得到C_Name
 Public Function getCName(Id)
  Dim CMD,Rs
  Set CMD = Server.CreateObject("ADODB.COMMAND")
  CMD.ActiveConnection = Conn
  CMD.CommandType = 4
  CMD.CommandText = "Blog_getCName"
  Set Rs = CMD.Execute ( ,Array(Id))
  Set CMD = Nothing
  getCName = Rs(0)
 End Function
 '-----------------------------------------------------------------------------------

 '-----------------------------------------------------------------------------------
 '生成树目录
 Public Function nodeUser(parent)
  dim rs,j,innerPic,eventCancel,shutEvent
  shutEvent = " onclick=""javascript:event.cancelBubble = true;"" onmouseover=""javascript:event.cancelBubble = true;"" onmouseout=""javascript:event.cancelBubble = true;"""
  set rs = listClass(parent)
  do while not rs.Eof
   i=i+1
   innerPic = istail(cint(rs(0)))
   if instr(innerPic,"nochild") <> 0 then
    eventCancel = "getPID(" & rs(0) & ")"
   else
    eventCancel = "changeshow(" & rs(0) & ")"
   end if
   outPut = outPut & "<table bgcolor=""#FFFBFF"" border=""0"" width=""100%"" style=""cursor:hand"" cellpadding=""0"" cellspacing=""0"">"
   outPut = outPut & "<tr onclick=""" & eventCancel  & """ onmouseover=""overtree()"" onmouseout=""outtree()""><td id=""node"" name=""node"">"
   for j=1 to i
    outPut = outPut & ("&nbsp;&nbsp;")
   next
   outPut = outPut & innerPic
   outPut = outPut & getCName(cint(rs(0)))
   outPut = outPut & "</td></tr>"
   outPut = outPut & "<tr style=""display:none""><td id=""node"" name=""node"">"
   '递归来显示出为根的树型结构
   nodeUser(rs(0))
   outPut = outPut & "</td></tr></table>"
   rs.MoveNext
  loop
  i=i-1
  rs.close
  set rs=nothing
 End Function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '是否末端
 Private function istail(parentID)
  Dim rs,shutEvent
  shutEvent = " onclick=""javascript:event.cancelBubble = true;"" onmouseover=""javascript:event.cancelBubble = true;"" onmouseout=""javascript:event.cancelBubble = true;"""
  set rs = listClass(parentID)
  if rs.Eof then
   istail = "<img src=""/images/treeview/nochild.gif"" border=""0"" " & shutEvent & " style=""cursor:default;"">&nbsp;<img src=""/images/treeview/page.gif"" border=""0"" " & shutEvent & " style=""cursor:default;"">&nbsp;"
  else
   istail = "<img src=""/images/treeview/plus.gif"" border=""0"" " & shutEvent & " style=""cursor:default;"">&nbsp;<img src=""/images/treeview/folder.gif"" border=""0"" " & shutEvent & " style=""cursor:default;"">&nbsp;"
  end if
 end function
 '-----------------------------------------------------------------------------------
 
 '-----------------------------------------------------------------------------------
 '刷新Cache
 Private Sub refresh()
  Dim BlogCache
  Set BlogCache = New clsCache
  With BlogCache
   .Connection = Conn
   .Name = "Blog_Class"
   .cheType = "Class"
   .Update()
  End With
  Set BlogCache = Nothing
 end Sub
 '-----------------------------------------------------------------------------------
End Class
%>

--  作者：愚者
--  发布时间：1/30/2005 3:36:00 AM

--  
呵呵!!
謝謝你的指教!!!!
--  作者：npuhetao
--  发布时间：3/24/2005 8:46:00 PM

--  
不错不错。
W 3 C h i n a ( since 2003 ) 旗 下 站 点
苏ICP备05006046号《全国人大常委会关于维护互联网安全的决定》《计算机信息网络国际联网安全保护管理办法》
 109.375ms