绶存类[推存]

<%
Class Cls_Cache
 Public Reloadtime,MaxCount,CacheName
 Private LocalCacheName,CacheData,DelCount
 Private Sub Class_Initialize()
  Reloadtime=14400
  CacheName="Cache"
 End Sub
 Private Sub SetCache(SetName,NewValue)
  Application.Lock
  Application(SetName) = NewValue
  Application.unLock
 End Sub
 Public Sub MakeEmpty(MyCaheName)
  Application.Lock
  Application(CacheName&"_"&MyCaheName) = Empty
  Application.unLock
 End Sub
 Public  Property Let Name(ByVal vNewValue)
  LocalCacheName=LCase(vNewValue)
 End Property
 Public  Property Let Value(ByVal vNewValue)
  If LocalCacheName<>"" Then
   CacheData=Application(CacheName&"_"&LocalCacheName)
   If IsArray(CacheData)  Then
    CacheData(0)=vNewValue
    CacheData(1)=Now()
   Else
    ReDim CacheData(2)
    CacheData(0)=vNewValue
    CacheData(1)=Now()
   End If
   SetCache CacheName&"_"&LocalCacheName,CacheData
   
  Else
   Err.Raise vbObjectError + 1, "LvbbsCacheServer", " please change the CacheName."
  End If  
 End Property
 Public Property Get Value()
  If LocalCacheName<>"" Then
   CacheData=Application(CacheName&"_"&LocalCacheName) 
   If IsArray(CacheData) Then
    Value=CacheData(0)
   Else
    Err.Raise vbObjectError + 1, "LvbbsCacheServer", " The CacheData Is Empty."
   End If
  Else
   Err.Raise vbObjectError + 1, "LvbbsCacheServer", " please change the CacheName."
  End If
 End Property
 Public Function ObjIsEmpty()
  ObjIsEmpty=True
  CacheData=Application(CacheName&"_"&LocalCacheName)
  If Not IsArray(CacheData) Then Exit Function
  If Not IsDate(CacheData(1)) Then Exit Function
  If DateDiff("s",CDate(CacheData(1)),Now()) < 60*Reloadtime  Then
   ObjIsEmpty=False
  End If
 End Function
 Public Sub DelCache(MyCaheName)
  Application.Lock
  Application.Contents.Remove(CacheName&"_"&MyCaheName)
  Application.unLock
 End Sub
End Class
%>
使用示例:
<%
'aplication名称为: 缓存主名字_缓存副名字, 如 myCache_tempCache
'值为:测试,Wed Oct 20 11:11:30 UTC+0800 2004,
Dim myCache,content,str
Set myCache=New Cls_Cache
myCache.Reloadtime=0.05                  '设置过期时间,单位为1分钟
myCache.CacheName = "abc"         '缓存主名字.
myCache.Name="vcd"              '缓存副名字
If myCache.ObjIsEmpty() Then          '但该缓存为空时设置缓存.
    content = "测试<br>"
    myCache.value = content
End If
Response.Write myCache.value
Set myCache = Nothing

Sub DelCahe(MyCaheName)      '删除绶存
    Application.Lock
 Application.Contents.Remove(MyCaheName)
 Application.unLock
End Sub
delCahe("abc_vcdd")
Function  GetallCache()     '显示绶存名
 Dim Cacheobj
 For Each Cacheobj in Application.Contents
  response.write Cacheobj&"<br>"
 Next
End Function
%>