在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