<% '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 %>(鼠标移到代码上去,在代码的顶部会出现四个图标,第一个是查看源代码,第二个是复制代码,第三个是打印代码,第四个是帮助)