Copy Code code as follows:
<%
Rem XML Cache Class
'--------------------------------------------------------------------
' Please keep the copyright information when reprint
' Author: ╰⑥ Moon Rain
' Version: ver1.0
' This kind of part draws lessons from the Walkmanxml data cache class, the use is more convenient to welcome you to exchange the progress
'--------------------------------------------------------------------
Class Xmlcachecls
Private m_dataconn ' data source, must already be open
Private m_cachetime ' cache time, unit seconds default 10 minutes
Private m_xmlfile ' XML path, with absolute address, no need to add extension
Private M_sql ' SQL statement
Private M_sqlarr ' (read-only) array of data returned
Private M_readon ' (read only) return read mode 1-database 2-xml detection
' Properties of Class =========================================
' 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 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
' Returns an array of records
Public Property Get Sqlarr
Sqlarr = M_sqlarr
End Property
' Return read mode
Public Property Get Readon
Readon = M_readon
End Property
' The destructor of class =========================================
Private Sub class_initialize () ' Initialize class
M_cachetime=60*10 ' Default cache time is 10 minutes
End Sub
Private Sub class_terminate () ' Release class
End Sub
' The public method of the class =========================================
Rem reads data
Public Function ReadData
If fsoexistsfile (m_xmlfile) Then ' exists XML cache, 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 ' exits directly if XML is not expired
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& "") Create folder
Writestringtoxmlfile m_xmlfile,xmlcontent
End Function
' Private method of class =========================================
Rem reads data from an XML file
Private Function Readdatafromxml
Dim Sqlarr () ' Array
Dim xmldoc ' XmlDoc object
Dim Objnode ' child node
Dim itemslength ' child node length
Dim attributeslength ' child node property length
Set xmldoc=server.createobject ("Microsoft.XMLDOM")
Xmldoc.async=false
Xmldoc.load (M_xmlfile)
Set objnode=xmldoc.documentelement ' Get root node
Itemslength=objnode.childnodes.length ' Gets the length of the child node
For Items_i=0 to ItemsLength-1
Attributeslength=objnode.childnodes (items_i). Attributes.length ' Gets the length of the child node property
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 a 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
' Helper private method for class =========================================
Rem Write 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 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 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
Whether Rem files exist
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 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
%>
How to use:
1 Caching data to XML
Code:
Copy 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 prod_id,prod_name,prod_uptime from Tblproduction"
Cache. Writedatatoxml
%>
2 Reading cached data
Code:
Copy 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 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 10 minutes per second, or you can set the cache yourself. cachetime=60*30 30 minutes.
