Asp缓存类

'**********************************************
' vbs Cache类
'
' 属性valid，是否可用，取值前判断
' 属性name，cache名，新建对象后赋值
' 方法add(值,到期时间)，设置cache内容
' 属性value，返回cache内容
' 属性blempty，是否未设置值
' 方法makeEmpty，释放内存，测试用
' 方法equal(变量1)，判断cache值是否和变量1相同
' 方法expires(time)，修改过期时间为time
' 木鸟   2002.12.24
' http://www.aspsky.net/
'**********************************************
class Cache
private obj    'cache内容
private expireTime   '过期时间
private expireTimeName '过期时间application名
private cacheName   'cache内容application名
private path    'uri

private sub class_initialize()
   path=request.servervariables("url")
   path=left(path,instrRev(path,"/"))
end sub

private sub class_terminate()
end sub

public property get blEmpty
   '是否为空
   if isempty(obj) then
    blEmpty=true
   else
    blEmpty=false
   end if
end property

public property get valid
   '是否可用(过期)
   if isempty(obj) or not isDate(expireTime) then
    valid=false
   elseif CDate(expireTime)<now then
     valid=false
   else
    valid=true
   end if
end property

public property let name(str)
   '设置cache名
   cacheName=str & path
   obj=application(cacheName)
   expireTimeName=str & "expires" & path
   expireTime=application(expireTimeName)
end property

public property let expires(tm)
   '重设置过期时间
   expireTime=tm
   application.lock
   application(expireTimeName)=expireTime
   application.unlock
end property

public sub add(var,expire)
   '赋值
   if isempty(var) or not isDate(expire) then
    exit sub
   end if
   obj=var
   expireTime=expire
   application.lock
   application(cacheName)=obj
   application(expireTimeName)=expireTime
   application.unlock
end sub

public property get value
   '取值
   if isempty(obj) or not isDate(expireTime) then
    value=null
   elseif CDate(expireTime)<now then
    value=null
   else
    value=obj
   end if
end property

public sub makeEmpty()
   '释放application
   application.lock
   application(cacheName)=empty
   application(expireTimeName)=empty
   application.unlock
   obj=empty
   expireTime=empty
end sub

public function equal(var2)
   '比较
   if typename(obj)<>typename(var2) then
    equal=false
   elseif typename(obj)="Object" then
    if obj is var2 then
     equal=true
    else
     equal=false
    end if
   elseif typename(obj)="Variant()" then
    if join(obj,"^")=join(var2,"^") then
     equal=true
    else
     equal=false
    end if
   else
    if obj=var2 then
     equal=true
    else
     equal=false
    end if
   end if
end function
end class

'
' 属性valid，是否可用，取值前判断
' 属性name，cache名，新建对象后赋值
' 方法add(值,到期时间)，设置cache内容
' 属性value，返回cache内容
' 属性blempty，是否未设置值
' 方法makeEmpty，释放内存，
'    方法DelCahe ,删除内存
' 方法equal(变量1)，判断cache值是否和变量1相同
' 方法expires(time)，修改过期时间为time
'    用法  

set myCache=New Cache
myCache.name="BoardJumpList" '定义缓存名
if myCache.valid then　'判断是否可用(包括过期，与是否为空值)
    response.write myCache.value　'输出
else
    ................
    BoardJumpList=xxx  
    myCache.add BoardJumpList,dateadd("n",60,now)　'写入缓存 xxx.add 内容,过期时间
    response.write BoardJumpList   '输出
end if
myCache.makeEmpty() 释放内存
mycache.DelCahe()　删除缓存

Rem ==================使用说明====================
Rem = 本类模块是动网先锋原创，作者：迷城浪子。如采用本类模块，请不要去掉这个说明。这段注释不会影响执行的速度。
Rem = 作用：缓存和缓存管理类
Rem = 公有变量：Reloadtime 过期时间（单位为分钟）缺省值为14400
Rem = MaxCount 缓存对象的最大值，超过则自动删除使用次数少的对象。缺省值为300
Rem = CacheName 缓存组的总名称，缺省值为"Dvbbs",如果一个站点中有超过一个缓存组，则需要外部改变这个值。
Rem = 属性:Name 定义缓存对象名称，只写属性。
Rem = 属性:value 读取和写入缓存数据。
Rem = 函数：ObjIsEmpty()判断当前缓存是否过期。
Rem = 方法：DelCahe(MyCaheName)手工删除一个缓存对象，参数是缓存对象的名称。
Rem ========================
Public Reloadtime,MaxCount,CacheName
Private LocalCacheName,CacheData,DelCount
Private Sub Class_Initialize()
   Reloadtime=14400
   CacheName="Dvbbs"
End Sub
Private Sub SetCache(SetName,NewValue)
   Application.Lock
   Application(SetName) = NewValue
   Application.unLock
End Sub  
Private Sub makeEmpty(SetName)
   Application.Lock
   Application(SetName) = 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, "DvbbsCacheServer", " 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, "DvbbsCacheServer", " The CacheData Is Empty."
    End If
   Else
    Err.Raise vbObjectError + 1, "DvbbsCacheServer", " 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 DelCahe(MyCaheName)
   makeEmpty(CacheName&"_"&MyCaheName)
End Sub
End Class

Set WydCache=New Cls_Cache
WydCache.Reloadtime=0.5 '定义过期时间 (以分钟为单会)
WydCache.CacheName="pages"　'定义缓存名
IF WydCache.ObjIsEmpty() Then ''判断是否可用(包括过期，与是否为空值)
    Response.write WydCache.Value
Else
    ..................
    BoardJumpList=xxx
    WydCache.Value=BoardJumpList '写入内容
    Response.write BoardJumpList
End if

mycache.DelCahe("缓存名")　删除缓存

'========================
'clsCache.asp
'========================
'== begin     : 2004-6-26 21:51:47
'== copyright    : slightboy (C)1998-2004
'== email     : slightboy@msn.com
'========================
'========================
' Dim Application(2)
' Application(0) Counter 计数器
' Application(1) dateTime 放置时间
' Application(2) Content 缓存内容

Public PREFIX
Public PREFIX_LENGTH

   Private Sub Class_Initialize()
     PREFIX = "Cached:"
     PREFIX_LENGTH = 7
   End Sub
   Private Sub Class_Terminate
   End Sub
' 设置变量
   Public Property Let Cache(ByRef Key, ByRef Content)
     Dim Item(2)
     Item(0) = 0
     Item(1) = Now()
     IF (IsObject(Content)) Then
       Set Item(2) = Content
     Else
       Item(2) = Content
     End IF
     Application.Unlock
     Application(PREFIX & Key) = Item
     Application.Lock
   End Property
' 取出变量 计数器++
   Public Property Get Cache(ByRef Key)
     Dim Item
     Item = Application(PREFIX & Key)
     IF (IsArray(Item)) Then
       IF (IsObject(Item)) Then
         Set Cache = Item(2)
       Else
         Cache = Item(2)
       End IF
       Application(PREFIX & Key)(0) = Application(PREFIX & Key)(0) + 1
     Else
       Cache = Empty
     End IF
   End Property
' 检查缓存对象是否存在
   Public Property Get Exists(ByRef Key)
     Dim Item
     Item = Application(PREFIX & Key)
     IF (IsArray(Item)) Then
       Exists = True
     Else
       Exists = False
     End IF
   End Property
' 得到计数器数值
   Public Property Get Counter(ByRef Key)
     Dim Item
     Item = Application(PREFIX & Key)
     IF (IsArray(Item)) Then
       Counter = Item(0)
     End IF
   End Property

' 设置计数器时间
   Public Property Let dateTime(ByRef Key, ByRef SetdateTime)
     Dim Item
     Item = Application(PREFIX & Key)
     IF (IsArray(Item)) Then
       Item(1) = SetdateTime
     End IF
   End Property
' 得到计数器时间
   Public Property Get dateTime(ByRef Key)
     Dim Item
     Item = Application(PREFIX & Key)
     IF (IsArray(Item)) Then
       dateTime = Item(1)
     End IF
   End Property

' 重置计数器
   Public Sub ResetCounter()
     Dim Key
     Dim Item
     Application.Unlock
     For Each Key in Application.Contents
       IF (Left(Key, PREFIX_LENGTH) = PREFIX) Then
         Item = Application(Key)
         Item(0) = 0
         Application(Key) = Item
       End IF
     Next
     Application.Lock
   End Sub
' 删除某以缓存
   Public Sub Clear(ByRef Key)
     Application.Contents.Remove(PREFIX & Key)
   End Sub
' 清空没有使用的缓存
   Public Sub ClearUnused()
     Dim Key, Keys, KeyLength, KeyIndex
     For Each Key in Application.Contents
       IF (Left(Key, PREFIX_LENGTH) = PREFIX) Then  
         IF (Application(Key)(0) = 0) Then
    Keys = Keys & VBNewLine & Key
End IF
       End IF
     Next
     Keys = Split(Keys, VBNewLine)
     KeyLength = UBound(Keys)
     Application.Unlock  
     For KeyIndex = 1 To KeyLength
       Application.Contents.Remove(Keys(KeyIndex))
     Next
     Application.Lock
   End Sub
' 清空所有缓存
   Public Sub ClearAll()
     Dim Key, Keys, KeyLength, KeyIndex
     For Each Key in Application.Contents
       IF (Left(Key, PREFIX_LENGTH) = PREFIX) Then  
         Keys = Keys & VBNewLine & Key
       End IF
     Next
     Keys = Split(Keys, VBNewLine)
     KeyLength = UBound(Keys)
     Application.Unlock  
     For KeyIndex = 1 To KeyLength
       Application.Contents.Remove(Keys(KeyIndex))
     Next
     Application.Lock
   End Sub
   
End Class

Set Wyd=New JayCache
Wyd.dateTime("Page")=时 间
If Wyd.Exists("Page") Then
    Response.write   Wyd.Cache("Page") '输出
Else
    Wyd.Cache("Page")=xxx　写入
    Responxe.write xxx
End IF
Wyd.Clear("page")'删除缓存