XML替代APPLICATION实现服务器缓存

XML替代APPLICATION实现服务器缓存2009-12-15 asp.org.cn 海豹在ASP开发程序的时候,为了提高ASP运行性能往往会使用APPLICATION作为服务器缓存,APPLICATION缓存占用的是服务器内存空间,如果在ASP程序中大量使用APPLICATION缓存或者缓存大量的内容将会造成服务器内存吃紧,反而影响服务器运行性能.

海豹在偶然一次上网时,看见有网友提出使用XML作为缓存,XML占用的是硬盘空间,速度性能随然比APPLICATION差些,但是比读取数据要快得多.笔者在原他人的XML缓存类的基础上进行改进, 用XML作为缓存要避勉XML文件过大,避勉多人同时写XML而报错.

以下是XML缓存类:

Class ClsCache
        Private cache           "缓存内容
        Private cacheName       "缓存名称
        Private vaild           "ansir添加
        Public Reloadtime
        Private XmlDom, XmlDoc, XmlNode, XmlAttr, AttrTime
        Private LocalCacheName, XmlPath

   Private Sub Class_Initialize（）
      tempfilename=Replace（Split（request.servervariables（"url"）,"/"）（1）,".","_"） "每个文件对应一个XML文件避勉文件过大
      filename="/temp/"&tempfilename&".xml"     "保存在TEMP目录下
      CreateXmlObj filename,"/ROYAH_CACHE"
   End Sub

   Private Sub Class_Terminate（）
      Close（）
   End Sub

   Private Function SaveToFile（ByVal strBody,ByVal SavePath）
      Set ObjStream = Server.CreateObject（"ADODB.Stream"）
          ObjStream.Open
          ObjStream.Type = 2
          ObjStream.Charset = "GB2312"
          ObjStream.WriteText strBody
          ObjStream.SaveToFile SavePath,2
          ObjStream.Close
      Set ObjStream = Nothing
  End Function
          "创建Xml对象
  Public Sub CreateXmlObj（ByVal XmlName, ByVal ChName）
     Set XmlDom = Server.CreateObject（"Microsoft.FreeThreadedXMLDOM"）
         XmlPath = Server.MapPath（XmlName）
         CacheName = ChName
        If Not XmlDom.Load（XmlPath） Then "如果指定的缓存文件不存在则自动新建
         SaveToFile "<？xml version=""1.0"" encoding=""GB2312""？><ROYAH_CACHE></ROYAH_CACHE>",XmlPath
         XmlDom.Load（XmlPath）
        End If
  End Sub

  Property Get Version（）
       Version = "bendibao Cache"
  End Property

  Property Get valid（）
          valid = False
          If Not （XmlDoc Is Nothing） Then
           valid = True
           Set AttrTime = XmlDoc.selectSingleNode（"./@Time"）
           If CDate（AttrTime.text） < Now  Then
              valid = False
      Else
       If XmlDoc.Text="" Then valid = False
      end if
         End If
  End Property

  Public Property Let Name（ByVal vNewValue）
         LocalCacheName = server.htmlencode（replace（vNewValue," ",""））
         LocalCacheName=replace（replace（LocalCacheName,"“",""）,"”",""）
      If LocalCacheName <> "" Then
          "Response.write CacheName & "<br>"
          "response.write LocalCacheName & "<br>"
          Set XmlDoc = XmlDom.documentElement.selectSingleNode（CacheName & "/" & LocalCacheName）
      End If
  End Property
  "判断是否锁定  
  Function   IsLock（）
      Dim   blnRet
      blnRet   =   application（"IsLock"&LocalCacheName）
    If   blnRet&""=""   Then
      blnRet   =   False
      application.lock
      application（"IsLock"&LocalCacheName）=   blnRet
      application.unlock
    End   If
      IsLock   =   blnRet
  End   Function
  "设置锁定状态
  Function   SetLock   （byval   va）
      Dim   blnRet
      blnRet   =   False
    If   not  IsLock（）   Then
      application.lock
      application（"IsLock"&LocalCacheName）=   va
      application.unlock
      blnRet   =   True
    End   If
     SetLock   =   blnRet
  End   Function
  "设置解锁定状态
  Function   SetunLock   （byval   va）
      Dim   blnRet
      blnRet   =   False
    If  IsLock（）   Then
      application.lock
      application（"IsLock"&LocalCacheName）=   va
      application.unlock
      blnRet   =   True
    End   If
     SetunLock   =   blnRet
  End   Function


   Public Sub add（varCache, varExpireTime）
          if isnull（varcache） then exit sub
          If （XmlDoc Is Nothing）  Then
             Set XmlDoc = XmlDom.documentElement.selectSingleNode（CacheName）
             Set XmlNode = XmlDom.createElement（LocalCacheName）
             Set XmlAttr = XmlDom.createAttribute（"Time"）
                 XmlNode.Text = varCache
                 XmlAttr.Text = varExpireTime
                 XmlDoc.AppendChild（XmlNode）
                 XmlNode.setAttributeNode XmlAttr
                 If   IsLock（）=False   then "没有人在写文件，则
                  If   SetLock（True） Then "申请锁住
                      XmlDom.Save（XmlPath）
                      SetunLock（False） "读写完后解锁
                   else
                      response.write   "..." "申请锁定失败
                  End   If
                 End   if
             Else
                 XmlDoc.Text = varCache
                 Set AttrTime = XmlDoc.selectSingleNode（"./@Time"）
                 AttrTime.Text = varExpireTime
                 If   IsLock（）=False   then "没有人在写文件，则
                 If   SetLock（True） Then "申请锁住
                        XmlDom.Save（XmlPath）
                        SetunLock（False） "读写完后解锁
                     else
                       response.write   "..." "申请锁定失败
                 End   If
                 End   if
             End If
  End Sub

          "设置当前节点值
  Public Property Let Value（ByVal vNewValue）
      If （XmlDoc Is Nothing） Then
         Set XmlDoc = XmlDom.documentElement.selectSingleNode（CacheName）
         Set XmlNode = XmlDom.createElement（LocalCacheName）
         Set XmlAttr = XmlDom.createAttribute（"Time"）
             XmlNode.Text = vNewValue
             XmlAttr.Text = Now（）
             XmlDoc.AppendChild（XmlNode）
             XmlNode.setAttributeNode XmlAttr
           If   IsLock（）   then "没有人在写文件，则
           If   SetLock（True） Then "申请锁住
             XmlDom.Save（XmlPath）
             SetLock（False） "读写完后解锁
            else
             "response.write   "无法操作..." "申请锁定失败
           End   If
           End   if

       Else
             XmlDoc.Text = vNewValue
          Set AttrTime = XmlDoc.selectSingleNode（"./@Time"）
            AttrTime.Text = Now（）
           If   IsLock（）   then "没有人在写文件，则
           If   SetLock（True） Then "申请锁住
            XmlDom.Save（XmlPath）
             SetLock（False） "读写完后解锁
            else
             "response.write   "无法操作..." "申请锁定失败
           End   If
           End   if
      End If
     End Property
       "返回当前节点值
     Public Property Get Value（）
      If Not （XmlDoc Is Nothing） Then
         Value = XmlDoc.Text
      End If
     End Property
         "移除当前节点
     Public Sub Remove（）
       If Not （XmlDoc Is Nothing） Then
          XmlDoc.ParentNode.RemoveChild（XmlDoc）
          XmlDom.Save（XmlPath）
       End If
   End Sub
       "检测当前节点是否存在



              "释放全部对象
    Public Sub Close（）
          If IsObject（XmlDom） Then Set XmlDom = Nothing
          If IsObject（XmlDoc） Then Set XmlDoc = Nothing
          If IsObject（XmlNode） Then Set XmlNode = Nothing
          If IsObject（XmlAttr） Then Set XmlAttr = Nothing
          If IsObject（AttrTime） Then Set XmlAttr = Nothing
    End Sub
End Class

引用方法:

set mycache=new clscache
myCache.name="content"&classid "定义缓存名称
if myCache.valid   then "如果缓存有效
content=myCache.value "读取缓存内容
else

content="将内容赋值给缓存，并设置缓存"

myCache.add content,dateadd（"n",10,now（）） "将内容赋值给缓存，并设置缓存有效期是当前时间＋1000分钟
end if "if 缓存无效
set mycache=nothing