Asp xml cache class

CopyCode The Code is as follows: <%
Rem XML cache class
'--------------------------------------------------------------------
'Reserve the copyright information during reprinting.
'Prepared by: Mmm.
'Version: ver1.0
'The usage of this category draws on the metadata manxml data cache class, which is more convenient for you to exchange and progress.
'--------------------------------------------------------------------
Class xmlcachecls
Private m_dataconn' data source, which must already be enabled
Private m_cachetime 'cache time. Unit: seconds. Default Value: 10 minutes.
Private m_xmlfile 'xml path, with an absolute address, no extension required
Private m_ SQL 'SQL statement
Private m_sqlarr '(read-only) returned data array
Private m_readon '(read-only) return read method 1-database 2-xml 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, with an absolute address
Public property let xmlfile (V)
M_xmlfile = V
End Property
Public property get xmlfile
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 read Method
Public property get readon
Readon = m_readon
End Property

'Class destructor ============================================== ======

Private sub class_initialize () 'initialization class
M_cachetime = 60*10 'the default cache time is 10 minutes.
End sub

Private sub class_terminate () 'release class

End sub

'Public method of the class ====================================================== ======

Rem reads data
Public Function readdata
If fsoexistsfile (m_xmlfile) then 'is in the XML cache and can be directly read 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 the XML has not expired
if not isxmlcacheexpired (m_xmlfile, m_cachetime) then exit function
end if
dim RS
dim xmlcontent
dim k
xmlcontent = ""
xmlcontent = xmlcontent & " "& Vbnewline
xmlcontent = xmlcontent &" "& vbnewline
K = 0
set rs = server. createobject ("ADODB. recordset ")
Rs. open m_ SQL, m_dataconn, 1
while not Rs. EOF
xmlcontent = xmlcontent & " for each field in RS. fields
xmlcontent = xmlcontent & field. name & "=" "& xmlstringencode (field. value) & "
next
Rs. movenext
K = k + 1
xmlcontent = xmlcontent & "> " & vbnewline
Wend
Rs. close
set rs = nothing
xmlcontent = xmlcontent & " " & vbnewline

Dim folderpath
Folderpath = trim (left (m_xmlfile, limit Rev (m_xmlfile, "\")-1 ))
Call createdir (folderpath & "") 'to create a folder
Writestringtoxmlfile m_xmlfile, xmlcontent
End Function

'Private method of the class ====================================================== ======

REM reads data from an XML file
private function readdatafromxml
dim sqlarr () 'array
dim xmldoc 'xmldoc object
dim objnode' sub-node
dim itemslength 'sub-node length
dim attributeslength' sub-node attribute length
set xmldoc = server. createobject ("Microsoft. xmldom ")
xmldoc. async = false
xmldoc. load (m_xmlfile)
set objnode1_xmldoc.doc umentelement 'get the root node
itemslength = objnode. childnodes. length 'get the length of the subnode
for items_ I = 0 to ItemsLength-1
attributeslength = objnode. childnodes (items_ I ). attributes. length 'get the length of the subnode attribute
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
set xmldoc = nothing
m_sqlarr = sqlarr
end function

Rem reads data from the database
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

'Auxiliary private method of the class ======================================================= ========

Rem writes XML files
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 expires
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 obtains 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

Whether the 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 characters
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 create 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
%>

Usage:
1. cache data to XML
Code:Copy codeThe Code is 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 cache data
Code:Copy codeThe Code is 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> ")
Next
Next
End if
%>

Cache Time. The default unit is 10 minutes. You can also set cache. cachetime to 60*30 minutes.