program code
<%
'by xilou,www.chinacms.org,20090115
'Last update: 20090115
'Modification record: none
CONST CACHEPREFIX = "CACHE_" 'Cache prefix, cannot be empty
' Description:
' 1. The cache format is Application(CACHEPREFIX & key) = array("cache key", "cache time", "cache content", "cache description", "expiration time")
'2, the cache key is not case sensitive
'Add cache without checking whether the cache exists. If it exists, it is equivalent to updating the cache.
'varAry: parameter, the format is: array("cache key", "cache time", "cache content", "cache description")
'Cache key: the same format as application()
'Cache time: unit seconds, can be a negative number, indicating immediate expiration, can be empty, empty or not a number, the default is 20 minutes expiration
'Cache content: cache data, caching of objects is not supported
'Cache description: cache description
Function AddCache(varAry)
Dim c,ary(4)
If Not IsArray(varAry) Then
Response.Write "Error: AddCache(varAry) parameter error, parameter is not an array"
Response.End()
End If
If UBound(varAry) <> 3 Then
Response.Write "Error: AddCache(varAry) parameter error, array length error"
Response.End()
End If
If varAry(0) = "" Then
Response.Write "Error: AddCache(varAry) error, key cannot be empty"
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
'Check whether a cache exists, return True if it exists, otherwise return False
'key: cache 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
'Get cache
'Return an array in the format: array("cache key", "cache time", "cache content", "cache description", "expiration time", whether it has expired True|False)
'If it does not exist, an error will occur, so check with CheckCache(key) before getting it.
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
'Clear cache
Function RemoveCache(key)
Application.Lock()
Application.Contents.Remove(CACHEPREFIX & key)
Application.UnLock()
End Function
'Update the cache. If the cache does not exist, an error will occur, so check with CheckCache(key) before updating.
'varAry: parameter, the format is: array("cache key", "cache time", "cache content", "cache description")
'Cache key: the same format as application()
'Cache time: unit seconds, can be a negative number, indicating immediate expiration, can be empty, empty or not a number, the default is 20 minutes expiration
'Cache content: cache data, caching of objects is not supported
'Cache description: cache description
'Note: If you do not update a certain value of varAry, just set the value to null.
' Such as UpdateCache(array("key",null,"content",null)), which means the expiration time and description will not be updated.
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
'Print cache for debugging
Function PrintCache(key)
Dim app,i,t
If CheckCache(key) Then
app = GetCache(key)
Response.Write "<pre>{"&chr(10)
Response.Write chr(32) & "cache name" & chr(32) & ":" & chr(32) & CACHEPREFIX & app(0) & chr(10)
Response.Write chr(32) & "cache key " & chr(32) & ":" & chr(32) & app(0) & chr(10)
Response.Write chr(32) & "cache time" & chr(32) & ":" & chr(32) & app(1) & chr(10)
Response.Write chr(32) & "Expiration time" & chr(32) & ":" & chr(32) & app(4) & chr(10)
Response.Write chr(32) & "Is it due?" & chr(32) & ":" & chr(32) & app(5) & chr(10)
Response.Write chr(32) & "cache description" & chr(32) & ":" & chr(32) & app(3) & chr(10)
'content
Response.Write chr(32) & "cached content" & 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 "The cache does not exist"
End If
End Function
'----------demo
Sub br(str)
Response.Write str & "<br />" & vbcrlf
End Sub
'RemoveCache "xilou"
'AddCache Array("xilou","",array("data content"),"cache description")
br CheckCache("xilou")
PrintCache "xilou"
Dim app
If CheckCache("xilou") Then
app = GetCache("xilou") 'Get
UpdateCache array(app(0),null,"testsfsfsf",null)'Update
Else
AddCache array("xilou","","content","description")
End If
'Dim k
'For Each k In Application.Contents
'br k
'Next
%>