本類部分借鏡walkmanxml資料快取類，使用更為方便歡迎各位交流進度複製程式碼碼如下:
<%
Rem xml緩存類
'------------------------------------------------- -------------------
'轉載的時候請保留版權信息
'作者:╰⑥月の雨╮
'版本:ver1.0
'本類部分借鏡walkmanxml資料快取類，使用更為方便歡迎各位交流進步
'------------------------------------------------- -------------------
Class XmlCacheCls
Private m_DataConn '資料來源,必須已經打開
Private m_CacheTime '快取時間，單位秒預設10分鐘
Private m_XmlFile 'xml路徑，用絕對位址,不需要加副檔名
Private m_Sql 'SQL語句
Private m_SQLArr '(唯讀)傳回的資料數組
Private m_ReadOn '(唯讀)回傳讀取方式1-資料庫2-xml 偵測用
'類別的屬性===========================================
'資料來源
Public Property Set Conn(v)
Set m_DataConn = v
End Property
Public Property Get Conn
Conn = m_DataConn
End Property
'快取時間
Public Property Let CacheTime(v)
m_CacheTime = v
End Property
Public Property Get CacheTime
CacheTime = m_CacheTime
End Property
'xml路徑，用絕對位址
Public Property Let XmlFile(v)
m_XmlFile = v
End Property
Public Property Get XmlFile
XmlFile = m_XmlFile
End Property
'Sql語句
Public Property Let Sql(v)
m_Sql = v
End Property
Public Property Get Sql
Sql = m_Sql
End Property
'傳回記錄數組
Public Property Get SQLArr
SQLArr = m_SQLArr
End Property
'返回讀取方式
Public Property Get ReadOn
ReadOn = m_ReadOn
End Property
'類別的析構=========================================
Private Sub Class_Initialize() '初始化類
m_CacheTime=60*10 '預設快取時間為10分鐘
End Sub
Private Sub Class_Terminate() '釋放類
End Sub
'類別的公共方法===========================================
Rem 讀取數據
Public Function ReadData
If FSOExistsFile(m_XmlFile) Then '存在xml緩存，直接從xml讀取
ReadDataFromXml
m_ReadOn=2
Else
ReadDataFromDB
m_ReadOn=1
End If
End Function
Rem 寫入XML數據
Public Function WriteDataToXml
If FSOExistsFile(m_XmlFile) Then '如果xml未過期則直接退出
If Not isXmlCacheExpired(m_XmlFile,m_CacheTime) Then Exit Function
End If
Dim rs
Dim xmlcontent
Dim k
xmlcontent =
xmlcontent = xmlcontent & <?xml version=1.0 encoding=gb2312?> & vbnewline
xmlcontent = xmlcontent & <root> & vbnewline
k=0
Set Rs = Server.CreateObject(Adodb.Recordset)
Rs.open m_sql,m_DataConn,1
While Not rs.eof
xmlcontent = xmlcontent & <item
For Each field In rs.Fields
xmlcontent = xmlcontent & field.name & = & XMLStringEnCode(field.value) &
Next
rs.movenext
k=k+1
xmlcontent = xmlcontent & ></item> & vbnewline
Wend
rs.close
Set rs = Nothing
xmlcontent = xmlcontent & </root> & vbnewline
Dim folderpath
folderpath = Trim(left(m_XmlFile,InstrRev(m_XmlFile,/)-1))
Call CreateDIR(folderpath&) '建立資料夾
WriteStringToXMLFile m_XmlFile,xmlcontent
End Function
'類別的私有方法===========================================
Rem 從Xml檔案讀取數據
Private Function ReadDataFromXml
Dim SQLARR() '陣列
Dim XmlDoc 'XmlDoc對象
Dim objNode '子節點
Dim ItemsLength '子節點的長度
Dim AttributesLength '子節點屬性的長度
Set XmlDoc=Server.CreateObject(Microsoft.XMLDOM)
XmlDoc.Async=False
XmlDoc.Load(m_XmlFile)
Set objNode=XmlDoc.documentElement '取得根節點
ItemsLength=objNode.ChildNodes.length '取得子節點的長度
For items_i=0 To ItemsLength-1
AttributesLength=objNode.childNodes(items_i).Attributes.length '取得子節點屬性的長度
For Attributes_i=0 To AttributesLength-1
ReDim Preserve SQLARR(AttributesLength-1,items_i)
SQLArr(Attributes_i,items_i) = objNode.childNodes(items_i).Attributes(Attributes_i).Nodevalue
Next
Next
Set XmlDoc = Nothing
m_SQLArr = SQLARR
End Function
Rem 從資料庫讀取數據
Private Function ReadDataFromDB
Dim rs
Dim SQLARR()
Dim k
k=0
Set Rs = Server.CreateObject(Adodb.Recordset)
Rs.open m_sql,m_DataConn,1
If Not (rs.eof and rs.bof) Then
While Not rs.eof
Dim fieldlegth
fieldlegth = rs.Fields.count
ReDim Preserve SQLARR(fieldlegth,k)
Dim fieldi
For fieldi = 0 To fieldlegth-1
SQLArr(fieldi,k) = rs.Fields(fieldi).value
Next
rs.movenext
k=k+1
Wend
End If
rs.close
Set rs = Nothing
m_SQLArr = SQLArr
End Function
'類別的輔助私有方法==========================================
Rem 寫入xml文件
Private Sub WriteStringToXMLFile(filename,str)
Dim fs,ts
Set fs= createobject(scripting.filesystemobject)
If Not IsObject(fs) Then Exit Sub
Set ts=fs.OpenTextFile(filename,2,True)
ts.writeline(str)
ts.close
Set ts=Nothing
Set fs=Nothing
End Sub
Rem 判斷xml快取是否到期
Private Function isXmlCacheExpired(file,seconds)
Dim filelasttime
filelasttime = FSOGetFileLastModifiedTime(file)
If DateAdd(s,seconds,filelasttime) < Now Then
isXmlCacheExpired = True
Else
isXmlCacheExpired = False
End If
End Function
Rem 得到文件的最後修改時間
Private Function FSOGetFileLastModifiedTime(file)
Dim fso,f,s
Set fso=CreateObject(Scripting.FileSystemObject)
Set f=fso.GetFile(file)
FSOGetFileLastModifiedTime = f.DateLastModified
Set f = Nothing
Set fso = Nothing
End Function
Rem 檔案是否存在
Public Function FSOExistsFile(file)
Dim fso
Set fso = Server.CreateObject(Scripting.FileSystemObject)
If fso.FileExists(file) Then
FSOExistsFile = true
Else
FSOExistsFile = false
End If
Set fso = nothing
End Function
Rem xml轉義字符
Private Function XMLStringEnCode(str)
If str& = Then XMLStringEnCode=:Exit Function
str = Replace(str,<,<)
str = Replace(str,>,>)
str = Replace(str,',')
str = Replace(str,,)
str = Replace(str,&,&)
XMLStringEnCode = str
End Function
Rem 建立資料夾
Private function CreateDIR(byval LocalPath)
On Error Resume Next
Dim i,FileObject,patharr,path_level,pathtmp,cpath
LocalPath = Replace(LocalPath,/,/)
Set FileObject = server.createobject(Scripting.FileSystemObject)
patharr = Split(LocalPath,/)
path_level = UBound (patharr)
For i = 0 To path_level
If i=0 Then
pathtmp=patharr(0) & /
Else
pathtmp = pathtmp & patharr(i) & /
End If
cpath = left(pathtmp,len(pathtmp)-1)
If Not FileObject.FolderExists(cpath) Then
'Response.write cpath
FileObject.CreateFolder cpath
End If
Next
Set FileObject = Nothing
If err.number<>0 Then
CreateDIR = False
err.Clear
Else
CreateDIR = True
End If
End Function
End Class
'設定緩存
Function SetCache(xmlFilePath,CacheTime,Conn,Sql)
set cache=new XmlCacheCls
Set cache.Conn=Conn
cache.XmlFile=xmlFilePath
cache.Sql=Sql
cache.CacheTime=CacheTime
cache.WriteDataToXml
Set cache = Nothing
End Function
'讀取快取
Function ReadCache(xmlFilePath,Conn,Sql,ByRef ReadOn)
set cache=new XmlCacheCls
Set cache.Conn=conn
cache.XmlFile=xmlFilePath
cache.Sql=Sql
cache.ReadData
ReadCache=cache.SQLArr
ReadOn=cache.ReadOn
End Function
%>
使用方法：
1 緩存資料到xml
代碼:
複製代碼代碼如下:
<!--#include file=Conn.asp-->
<!--#include file=Xml.asp-->
<%
set cache=new XmlCacheCls
Set cache.Conn=conn
cache.XmlFile=Server.Mappath(xmlcache/index/Top.xml)
cache.Sql=select top 15 prod_id,prod_name,prod_uptime from tblProduction
cache.WriteDataToXml
%>
2 讀取快取數據
代碼:
複製代碼代碼如下:
<!--#include file=Conn.asp-->
<!--#include file=Xml.asp-->
<%
set cache=new XmlCacheCls
Set cache.Conn=conn
cache.XmlFile=Server.Mappath(xmlcache/index/Top.xml)
cache.Sql=select top 15 prod_id,prod_name,prod_uptime from tblProduction order by prod_id asc
cache.ReadData
rsArray=cache.SQLArr
if isArray(rsArray) then
for i=0 to ubound(rsArray,2)
for j=0 to ubound(rsArray,1)
response.Write(rsArray(j,i)&<br><br>)
next
next
end if
%>快取時間，單位秒預設10分鐘；也可以自行設定cache.CacheTime=60*30 30分鐘