不错的ASP缓存函数

<%
'by xilou,www.chinacms.org,20090115
'最后更新：20090115
'修改记录：无

Const CACHEPREFIX = "CACHE_" '缓存前缀,不能为空

'说明：
'        1,缓存的格式为Application(CACHEPREFIX & key) = array("缓存key","缓存时间","缓存内容","缓存说明","到期时间")
'          2,缓存key不区分大小写



'添加缓存,不检查缓存是否存在，如果存在则相当于更新缓存
'varAry :  参数，格式为:array("缓存key","缓存时间","缓存内容","缓存说明")
'           缓存key ：application()格式相同
'           缓存时间：单位秒,可以为负数,表示立即过期,可以为空，空或不是数字则默认为20分钟过期
'          缓存内容：缓存数据，不支持对对象的缓存
'           缓存说明：缓存描述说明

Function AddCache(varAry)
    Dim c, ary(4)
    If Not IsArray(varAry) Then
        Response.Write "Error:AddCache(varAry)参数错误，参数不是数组"
        Response.End()
    End If
    If UBound(varAry) <> 3 Then
        Response.Write "Error:AddCache(varAry)参数错误，数组长度错误"
        Response.End()
    End If
    If varAry(0) = "" Then
        Response.Write "Error:AddCache(varAry)错误，key不能为空"
        Response.End()
    End If
    If varAry(1) = "" Or Not IsNumeric(varAry(1)) Then varAry(1) = 1200
    Application.Lock()
    Application(CACHEPREFIX & varAry(0)) = Array(varAry(0), varAry(1), varAry(2), varAry(3), DateAdd("s", varAry(1), Now()))
    Application.UnLock()
End Function

'检查某个缓存是否存在,存在返回True否则返回False
'key : 缓存key

Function CheckCache(Key)
    Dim k
    For Each k In Application.Contents
        If LCase(k) = LCase(CACHEPREFIX & Key) Then CheckCache = True
         Exit Function
    Next
    CheckCache = False
End Function

'获取缓存
'返回数组，格式为：array("缓存key","缓存时间","缓存内容","缓存说明","到期时间",是否过期True|False)
'如果不存在则出错，所以获取之前先用CheckCache(key)检查

Function GetCache(Key)
    Dim app, isExp
    app = Application(CACHEPREFIX & Key)
    isExp = False
    If DateDiff("s", Now(), app(4)) <= 0 Then isExp = True
    GetCache = Array(app(0), app(1), app(2), app(3), app(4), isExp)
End Function

'清除缓存

Function RemoveCache(Key)
    Application.Lock()
    Application.Contents.Remove(CACHEPREFIX & Key)
    Application.UnLock()
End Function

'更新缓存,如果缓存不存在则出错，所以更新之前先用CheckCache(key)检查
'varAry :  参数，格式为:array("缓存key","缓存时间","缓存内容","缓存说明")
'           缓存key ：application()格式相同
'           缓存时间：单位秒,可以为负数,表示立即过期,可以为空，空或不是数字则默认为20分钟过期
'          缓存内容：缓存数据，不支持对对象的缓存
'           缓存说明：缓存描述说明
'注意   ： 如果不更新varAry某个值则设置该值为null即可，
'           如UpdateCache(array("key",null,"内容",null)),就是不更新过期时间和说明

Function UpdateCache(varAry)
    Dim app
    app = GetCache(varAry(0))
    If Not IsNull(varAry(1)) Then app(1) = varAry(1)
    If Not IsNull(varAry(2)) Then app(2) = varAry(2)
    If Not IsNull(varAry(3)) Then app(3) = varAry(3)
    If app(1) = "" Or Not IsNumeric(app(1)) Then app(1) = 1200
    Application.Lock()
    Application(CACHEPREFIX & app(0)) = Array(app(0), app(1), app(2), app(3), DateAdd("s", app(1), Now()))
    Application.UnLock()
End Function

'www.knowsky.com
'打印cache，做调试用

Function PrintCache(Key)
    Dim app, i, t
    If CheckCache(Key) Then
        app = GetCache(Key)
        Response.Write "<pre>{"&Chr(10)
        Response.Write Chr(32) & "缓存名称" & Chr(32) & ":" & Chr(32) & CACHEPREFIX & app(0) & Chr(10)
        Response.Write Chr(32) & "缓存key " & Chr(32) & ":" & Chr(32) & app(0) & Chr(10)
        Response.Write Chr(32) & "缓存时间" & Chr(32) & ":" & Chr(32) & app(1) & Chr(10)
        Response.Write Chr(32) & "到期时间" & Chr(32) & ":" & Chr(32) & app(4) & Chr(10)
        Response.Write Chr(32) & "是否到期" & Chr(32) & ":" & Chr(32) & app(5) & Chr(10)
        Response.Write Chr(32) & "缓存说明" & Chr(32) & ":" & Chr(32) & app(3) & Chr(10)
        '内容
        Response.Write Chr(32) & "缓存内容" & Chr(32) & ":" & Chr(32)
        t = VarType(app(2))
        If InStr(",0,1,2,3,4,5,6,7,8,11,", ","&t&",") > 0 Then
            Response.Write app(2)
        Else
            Response.Write TypeName(app(2))
        End If
        Response.Write Chr(10)

        Response.Write "}</pre>"&Chr(10)
    Else
        Response.Write "不存在该缓存"
    End If
End Function


'-----------demo

Sub br(Str)
    Response.Write Str & "<br />" & vbCrLf
End Sub

'RemoveCache "xilou"
'AddCache Array("xilou","",array("数据内容"),"缓存说明")
br CheckCache("xilou")
PrintCache "xilou"

Dim app
If CheckCache("xilou") Then
    app = GetCache("xilou") '获取
    UpdateCache Array(app(0), null, "testsfsfsf", null)'更新
Else
    AddCache Array("xilou", "", "内容", "说明")
End If
'Dim k
'For Each k In Application.Contents
'br k
'Next
%>