程式碼
<%
'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.downcodes.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
%>