减小字体
增大字体- ·上一篇文章：asp实现数字每三位加个逗号的方法
- ·下一篇文章：asp编程过程中request对象获取客户端数据的顺序
asp开发中的XML缓存类
.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,"<
","&
lt
") str = Replace(str,">
","&
gt
") str = Replace(str,"'","&
apos
") 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 FunctionEnd 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 Set cache = Nothing End Function%>
(鼠标移到代码上去，在代码的顶部会出现四个图标，第一个是查看源代码，第二个是复制代码，第三个是打印代码，第四个是帮助)
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,"<
","&
lt
") str = Replace(str,">
","&
gt
") str = Replace(str,"'","&
apos
") 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 FunctionEnd 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 Set cache = Nothing End Function%>
(鼠标移到代码上去，在代码的顶部会出现四个图标，第一个是查看源代码，第二个是复制代码，第三个是打印代码，第四个是帮助)
使用方法：
1、读取数据
<(鼠标移到代码上去，在代码的顶部会出现四个图标，第一个是查看源代码，第二个是复制代码，第三个是打印代码，第四个是帮助)
!--
#include file="include/xmlcachecls.asp" -->
<
%strSel=""ReadOn=0rsArray=ReadCache(Server.Mappath("xmlcache/index/*********.xml"),Conn,strSel,ReadOn)'response.Write("
#
#
#
#
#
# "&
ReadOn&
"
#
#
#
#
#
#<
br>
") 测试数据从哪里读取的 使用时注释掉If IsArray(rsArray) then for i=0 to ubound(rsarray,2) ********* nextEnd IfstrSel=""rsarray=""%>
2、缓存数据
cache.asp
<(鼠标移到代码上去，在代码的顶部会出现四个图标，第一个是查看源代码，第二个是复制代码，第三个是打印代码，第四个是帮助)
!--
#include file="../conn.asp" -->
<
!--
#include file="../include/xmlcachecls.asp" -->
Sql=""call SetCache(Server.Mappath("../xmlcache/index/**********.xml"),60*10,Conn,Sql) '60*10 表示缓存的时间
3、调用
在页面底部加入，这样就不会影响页面打开的速度
<(鼠标移到代码上去，在代码的顶部会出现四个图标，第一个是查看源代码，第二个是复制代码，第三个是打印代码，第四个是帮助)
script type="text/javascript" src="cache.asp">
<
/script>
asp开发中的XML缓存类
