This class draws on the walkmanxml data cache class, which is more convenient to use. Welcome to communicate and make progress. Copy the code as follows:
<%
Rem xml cache class
'------------------------------------------------ -------------------
'Please retain the copyright information when reprinting
'Author: ╰⑥月の雨╮
'Version: ver1.0
'This category draws lessons from the walkmanxml data cache class, which is more convenient to use. Welcome to communicate and make progress.
'------------------------------------------------ -------------------
Class XmlCacheCls
Private m_DataConn 'Data source, must be open
Private m_CacheTime 'Cache time, in seconds, default is 10 minutes
Private m_XmlFile 'xml path, use absolute address, no extension required
Private m_Sql 'SQL statement
Private m_SQLArr '(read-only) returned data array
Private m_ReadOn '(read-only) returns reading mode 1-database 2-xml for detection
'Class attributes==========================================
'Data source
Public Property Set Conn(v)
Set m_DataConn = v
End Property
Public Property Get Conn
Conn = m_DataConn
End Property
'Cache time
Public Property Let CacheTime(v)
m_CacheTime = v
End Property
Public Property Get CacheTime
CacheTime = m_CacheTime
End Property
'xml path, use absolute address
Public Property Let XmlFile(v)
m_XmlFile = v
End Property
Public Property GetXmlFile
XmlFile = m_XmlFile
End Property
'Sql statement
Public Property Let Sql(v)
m_Sql = v
End Property
Public Property Get Sql
Sql = m_Sql
End Property
'Return record array
Public Property Get SQLArr
SQLArr = m_SQLArr
End Property
'Return to reading mode
Public Property Get ReadOn
ReadOn = m_ReadOn
End Property
'Destruction of class =========================================
Private Sub Class_Initialize() 'Initialize class
m_CacheTime=60*10 'The default cache time is 10 minutes
End Sub
Private Sub Class_Terminate() 'Release class
End Sub
'Public methods of the class =========================================
Rem reads data
Public Function ReadData
If FSOExistsFile(m_XmlFile) Then 'Xml cache exists, read directly from xml
ReadDataFromXml
m_ReadOn=2
Else
ReadDataFromDB
m_ReadOn=1
End If
End Function
Rem writes XML data
Public Function WriteDataToXml
If FSOExistsFile(m_XmlFile) Then 'Exit directly if xml has not expired
If Not isXmlCacheExpired(m_XmlFile,m_CacheTime) Then Exit Function
End If
Dimrs
Dimxmlcontent
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
Setrs=Nothing
xmlcontent = xmlcontent & </root> & vbnewline
Dim folderpath
folderpath = Trim(left(m_XmlFile,InstrRev(m_XmlFile,/)-1))
Call CreateDIR(folderpath&) 'Create folder
WriteStringToXMLFile m_XmlFile,xmlcontent
End Function
'Private methods of the class =========================================
Rem reads data from Xml file
Private Function ReadDataFromXml
Dim SQLARR() 'Array
Dim XmlDoc 'XmlDoc object
Dim objNode 'child node
Dim ItemsLength 'The length of the child node
Dim AttributesLength 'The length of the child node attributes
Set XmlDoc=Server.CreateObject(Microsoft.XMLDOM)
XmlDoc.Async=False
XmlDoc.Load(m_XmlFile)
Set objNode=XmlDoc.documentElement 'Get the root node
ItemsLength=objNode.ChildNodes.length 'Get the length of child nodes
For items_i=0 To ItemsLength-1
AttributesLength=objNode.childNodes(items_i).Attributes.length 'Get the length of child node attributes
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 reads data from database
Private Function ReadDataFromDB
Dimrs
DimSQLARR()
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
Setrs=Nothing
m_SQLArr = SQLArr
End Function
'Auxiliary private methods of the class ===========================================
Rem writes xml file
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 determines whether the xml cache has expired
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 gets the last modification time of the file
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 file exists
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 escape character
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 creates folder
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
'Set cache
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
'Read cache
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
%>
How to use:
1 cache data to xml
Code:
Copy the code code as follows:
<!--#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 Read cached data
Code:
Copy the code code as follows:
<!--#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
%>Cache time, the default unit is 10 minutes in seconds; you can also set cache.CacheTime=60*30 30 minutes by yourself