中文XML论坛--ASP中Cache技术的应用

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

出处：CSDN
作者：qihboy

********************************************
Code
　　ASP：default.asp
--------------------
　 <%@Language=VBScript%>
　　<%Option Explicit%>
　　<%Response.Buffer=True%>
　　
　　
　　<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
--------------------
　 
　　<%
　　dim strConn
　　strConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Northwind"
　　%>

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

这样的缓存不太好，对于减轻服务器负担没起多大作用

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

我贴两个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
%>

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

<%
Class clsClass
Private Conn
Private i
Private outPut

'-----------------------------------------------------------------------------------
'初始化当前页的值
Private Sub Class_Initialize
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 & ("  ")
   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;""> <img src=""/images/treeview/page.gif"" border=""0"" " & shutEvent & " style=""cursor:default;""> "
  else
   istail = "<img src=""/images/treeview/plus.gif"" border=""0"" " & shutEvent & " style=""cursor:default;""> <img src=""/images/treeview/folder.gif"" border=""0"" " & shutEvent & " style=""cursor:default;""> "
  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
%>

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

呵呵!!
謝謝你的指教!!!!

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)


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