ASP数据缓存类(自动判断缓存过期，模拟Recordset类)
应用场景：对于某些读取数据次数较多，sql性能不太好或网络延迟影响较大的页面.
使用方法：包含入本类库文件，初始化并设定好参数，之后的sql查询都通过本类执行，并对每个查询指定不同的缓存名称
缓存原理：调用查询时先根据缓存名称判断Application中是否有指定的缓存，数据是否合法，是否过期，没有过期就读取Application中的缓存内容，并模拟成Rs对象返回
如果缓存不存在或已过期，则使用指定的Connection链接查询，并将结果作为二维数组写入缓存，待下次查询使用，将当次查询的数据模拟为Rs对象返回。
示例代码:
Dim Data, rs
Set Data=new xDataCache
Data.ActiveConnection=conn
Data.CacheTime=100
Set rs=Data.Ｅxec("SELECT TOP 10 * FROM NEWS","news")
Do Until rs.EOF
Response.Write rs("ID")&":"& rs("title")&"<br />"
rs.MoveNext
Loop
类原码(里面包含两个类，一个缓存类，一个将二维数组模拟为Rs的类)：
'+++++++++++++++++++++++++++++++++++
'ASP数据缓存
'可按设定直接执行SQL语句,并将结果以二维数组存保存到application
'返回一个类Recordset对象
'shirne@126.com
'http://www.shirne.com
'+++++++++++++++++++++++++++++++++++
Class xDataCache
Public PRE '缓存前缀
Private PARAM '缓存参数后缀
'缓存单位
'建议使用 h, m, s,默认 s
Public Unit
'默认缓存时间,默认500
Public CacheTime
'使用默认缓存时间时为了避免多个缓存同时过期,加入一个时间误差,默认.1
Public Ratio
Private conn
Private Sub Class_Initialize
PRE = "data_"
PARAM = "_param"
CacheTime = 500
Unit = "s"
Ratio = .1
End Sub
Private Sub Class_Terminate
End Sub
'指定数据库链接
Public Property Let ActiveConnection(con)
Set conn = con
End Property
'使用默认时间缓存
Public Function Ｅxec(sql, cName)
Set Ｅxec = Ｅxecute(sql, cName, Null)
End Function
'执行sql,指定缓存时间,指定Null将使用默认缓存时间
Public Function [Ｅxecute](sql, cName, cTime)
'存储辅助参数,Array(缓存时间,超时时间,字段数组)
Dim pam, rs, arrData
pam = Application(PRE & cName & PARAM)
arrData = Application(PRE & cName)
Set rs=New ArrayToRs
If IsArray(pam) And IsArray(arrData) Then
If UBound(pam)=2 Then
If IsNumeric(cTime) And cTime<>"" Then pam(1)=Int(cTime)
If IsDate(pam(0)) And ( IsNumeric(pam(1)) And pam(1)<>"" ) Then
If DateDiff(Unit, pam(0), Now)<pam(1) Then
rs.Fields = pam(2)
rs.Data = arrData
Set Ｅxecute = rs
Exit Function
End If
End If
End If
End If
'读取数据
Dim flds, ERs, Field
Set ERs=conn.Ｅxecute(sql)
If ERs.EOF Then
'不操作
Else
'从结果中取字段
flds = ""
For Each Field In ERs.Fields
flds = flds &","&Field.Name
Next
flds = Mid(flds,2)
rs.Fields = flds
rs.Data = ERs.getRows()
Application.Lock()
Application(PRE & cName & PARAM)=Array(Now,getCacheTime(cTime),flds)
Application(PRE & cName )=rs.Data
Application.UnLock()
End If
Set Ｅxecute = rs
End Function
Private Function getCacheTime( dTime)
If IsNumeric(dTime) Then
getCacheTime = Int(dTime)
Else
Randomize
getCacheTime = CacheTime + CacheTime * Ratio * (FormatNumber(Rnd,2)+.01)
End If
End Function
'清除缓存,是否清除全部,还是只清除带前缀的
Public Sub Clear(bol)
If bol Then
Application.Contents.RemoveAll()
Else
Dim key, l
l = Len(PRE)
Application.Lock()
For Each key In Application.Contents
If Left(key,l)=PRE Then
Application.Contents.Remove(key)
End If
Next
Application.UnLock()
End If
End Sub
End Class
'将Recordset返回的二维数组重新模拟为Rs
Class ArrayToRs
Private dicFld
Private arrData
Private Count
Private Position
Private pEOF
Private pBOF
Private Sub Class_Initialize
Set dicFld=Server.ＣreateObject("Scripting.Dictionary")
dicFld.CompareMode=1
Count = 0
Position= 0
pEOF = True
pBOF = True
End Sub
'设定字段名称
Public Property Let Fields( f)
Dim i, j
dicFld.RemoveAll
If IsObject(f) Then
i=0
For Each j In f
dicFld.Add j, i
i = i + 1
Next
Else
If TypeName(f) = "String" Then
If InStr(f," ")>0 Then f = Replace(f," ","")
If InStr(f,"[")>0 Then f = Replace(Replace(f,"[",""),"]","")
f = Split(f,",")
End If
If IsArray(f) Then
For i=0 To UBound(f)
dicFld.Add f(i),i
Next
End If
End If
End Property
Public Property Get Fields( )
Set Fields = dicFld
End Property
Public Property Let Data( d)
If IsArray(d) Then
arrData = d
Count = UBound(d,2)+1
Position = 1
pEOF = False
pBOF = False
End If
End Property
Public Property Get Data()
Data = arrData
End Property
Public Default Property Get Item( ByVal key)
If pBOF Or pEOF Then
Exit Property
End If
If IsNumeric(key) Then
key = Int(key)
Else
If dicFld.Exists(key) Then
key = dicFld(key)
Else
Exit Property
End If
End If
Item = arrData(key,Position-1)
End Property
Public Property Let Item( key, val)
If pBOF Or pEOF Then
Exit Property
End If
If IsNumeric(key) Then
key = Int(key)
Else
If dicFld.Exists(key) Then
key = dicFld(key)
Else
Exit Property
End If
End If
arrData(key,Position-1) = val
End Property
Public Property Get BOF
BOF = pBOF
End Property
Public Property Get EOF
EOF = pEOF
End Property
Public Property Get RecordCount
RecordCount = Count
End Property
Public Property Let AbsolutePosition( p)
If p>0 And p<=Count Then
Position = p
Else
'错误,超出记录集
End If
End Property
Public Property Get AbsolutePosition( )
AbsolutePosition = Position
End Property
'移动记录位置
Public Sub Move( c)
If Count>0 Then
pEOF = False
pBOF = False
Position = Position + c
If Position<1 Then
Position = 0
pBOF = True
ElseIf Position>Count Then
Position = Count + 1
pEOF = True
End If
End If
End Sub
Public Sub MovePrevious
If Not pBOF Then
Position = Position-1
If Position<1 Then
pBOF = True
End If
End If
End Sub
Public Sub MoveNext
If Not pEOF Then
Position = Position+1
If Position>Count Then
pEOF = True
End If
End If
End Sub
Public Sub MoveFirst
If Count>0 Then
Position = 1
If pEOF = True Then
pEOF = False
End If
If pBOF=True Then
pBOF = False
End If
End If
End Sub
Public Sub MoveLast
Position = Count
If Count>0 Then
If pBOF=True Then
pBOF = False
End If
If pEOF = True Then
pEOF = False
End If
End If
End Sub
End Class 
豫公网安备 41112102000155号