asp的xml缓存类案例

发布时间：2023-07-29 14:54:28 所属栏目：Asp教程来源：

导读：<%

Rem xml缓存类

'--------------------------------------------------------------------

'转载的时候请保留版权信息

'作者:╰⑥月の雨╮

'版本:ver1.0

'本类部分借

<%

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

代码:

程序代码





<%

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 读取缓存数据

代码:

程序代码





<%

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分钟

（编辑：聊城站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!