不错的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 : 缓存keyFunction CheckCache(Key)    Dim k    For Each k In Application.Contents        If LCase(k) = LCase(CACHEPREFIX &
 Key) Then CheckCache = True         Exit Function    Next    CheckCache = FalseEnd 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 IfEnd Function'-----------demoSub br(Str)    Response.Write Str &
 "<
br />
" &
 vbCrLfEnd Sub'RemoveCache "xilou"'AddCache Array("xilou","",array("数据内容"),"缓存说明")br CheckCache("xilou")PrintCache "xilou"Dim appIf 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%>