这一种方法适合，访问相对集中在同样内容页面的网站，会自动生成缓存文件(相当于读取静态页面，但会增大文件)。如果访问不集中会造成服务器同时读取文件当机。 注意：系统需要FSO权限、XMLHTTP权限 系统包括两个文件，其实可以合并为一个。之所以分为两个是因为部分杀毒软件会因为里边含有FSO、XMLHTTP操作而被认为是脚本木马。 调用时，需要在ASP页面的最上边包含主文件，然后在下边写下以下代码 <% Set MyCatch=new CatchFile MyCatch.Overdue=60*5 '修改过期时间设置为5个小时 if MyCatch.CatchNow(Rev) then response.write MyCatch.CatchData response.end end if set MyCatch=nothing %> ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ 主包含文件：FileCatch.asp <!--#include file="FileCatch-Inc.asp"--> <% '---- 本文件用于签入原始文件，实现对页面的文件Catch '---- 1、如果文件请求为POST方式，则取消此功能 '---- 2、文件的请求不能包含系统的识别关键字 '---- 3、作者 何直群 (www.wozhai.com) Class CatchFile Public Overdue,Mark,CFolder,CFile '定义系统参数 Private ScriptName,ScriptPath,ServerHost '定义服务器/页面参数变量 Public CatchData '输出的数据 Private Sub Class_Initialize '初始化函数 '获得服务器及脚本数据 ScriptName=Request.Servervariables("Script_Name") '识别出当前脚本的虚拟地址 ScriptPath=GetScriptPath(false) '识别出脚本的完整GET地址 ServerHost=Request.Servervariables("Server_Name") '识别出当前服务器的地址 '初始化系统参数 Overdue=30 '默认30分钟过期 Mark="NoCatch" '无Catch请求参数为 NoCatch CFolder=GetCFolder '定义默认的Catch文件保存目录 CFile=Server.URLEncode(ScriptPath)&".txt" '将脚本路径转化为文件路径 CatchData="" end Sub Private Function GetCFolder dim FSO,CFolder Set FSO=CreateObject("Scripting.FileSystemObject") '设置FSO对象 CFolder=Server.MapPath("/")&"/FileCatch/" if not FSO.FolderExists(CFolder) then fso.CreateFolder(CFolder) end if if Month(Now())<10 then CFolder=CFolder&"/0"&Month(Now()) else CFolder=CFolder&Month(Now()) end if if Day(Now())<10 then CFolder=CFolder&"0"&Day(Now()) else CFolder=CFolder&Day(Now()) end if CFolder=CFolder&"/" if not FSO.FolderExists(CFolder) then fso.CreateFolder(CFolder) end if GetCFolder=CFolder set fso=nothing End Function Private Function bytes2BSTR(vIn) '转换编码的函数 dim StrReturn,ThisCharCode,i,NextCharCode strReturn = "" For i = 1 To LenB(vIn) ThisCharCode = AscB(MidB(vIn,i,1)) If ThisCharCode < &H80 Then strReturn = strReturn & Chr(ThisCharCode) Else NextCharCode = AscB(MidB(vIn,i+1,1)) strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) i = i + 1 End If Next bytes2BSTR = strReturn End Function Public Function CatchNow(Rev) '用户指定开始处理Catch操作 if UCase(request.Servervariables("Request_Method"))="POST" then '当是POST方法，不可使用文件Catch Rev="使用POST方法请求页面，不可以使用文件Catch功能" CatchNow=false else if request.Querystring(Mark)<>"" then '如果指定参数不为空，表示请求不可以使用Catch Rev="请求拒绝使用Catch功能" CatchNow=false else CatchNow=GetCatchData(Rev) end if end if End Function Private Function GetCatchData(Rev) '读取Catch数据 Dim FSO,IsBuildCatch Set FSO=CreateObject("Scripting.FileSystemObject") '设置FSO对象，访问CatchFile If FSO.FileExists(CFolder&CFile) Then Dim File,LastCatch Set File=FSO.GetFile(CFolder&CFile) '定义CatchFile文件对象 LastCatch=CDate(File.DateLastModified) if DateDiff("n",LastCatch,Now())>Overdue then '如果超过了Catch时间 IsBuildCatch=true else IsBuildCatch=false end if Set File=Nothing else IsBuildCatch=true End if If IsBuildCatch then GetCatchData=BuildCatch(Rev) '如果需要创建Catch,则创建Catch文件，同时设置Catch的数据 else GetCatchData=ReadCatch(Rev) '如果不需要创建Catch，则直接读取Catch数据 End if Set FSO=nothing End Function Private Function GetScriptPath(IsGet) '创建一个包含所有请求数据的地址 dim Key,Fir GetScriptPath=ScriptName Fir=true for Each key in Request.QueryString If Fir then GetScriptPath=GetScriptPath&"?" Fir=false else GetScriptPath=GetScriptPath&"&" end if GetScriptPath=GetScriptPath&Server.URLEncode(Key)&"="&Server.URLEncode(Request.QueryString(Key)) Next if IsGet then If Fir then GetScriptPath=GetScriptPath&"?" Fir=false else GetScriptPath=GetScriptPath&"&" end if GetScriptPath=GetScriptPath&Server.URLEncode(Mark)&"=yes" end if End Function '创建Catch文件 Private Function BuildCatch(Rev) Dim HTTP,Url,OutCome Set HTTP=CreateObject("Microsoft.XMLHTTP") ' On Error Resume Next ' response.write ServerHost&GetScriptPath(true) HTTP.Open "get","http://"&ServerHost&GetScriptPath(true),False HTTP.Send if Err.number=0 then CatchData=bytes2BSTR(HTTP.responseBody) BuildCatch=True else Rev="创建发生错误："&Err.Description BuildCatch=False Err.clear end if Call WriteCatch set HTTP=nothing End Function Private Function ReadCatch(Rev) ReadCatch=IReadCatch(CFolder&CFile,CatchData,Rev) End Function Private Sub WriteCatch Dim FSO,TSO Set FSO=CreateObject("Scripting.FileSystemObject") '设置FSO对象，访问CatchFile set TSO=FSO.CreateTextFile(CFolder&CFile,true) TSO.Write(CatchData) Set TSO=Nothing Set FSO=Nothing End Sub End Class %> ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ 文件二:FileCatch-Inc.asp <% Function IReadCatch(File,Data,Rev) Dim FSO,TSO Set FSO=CreateObject("Scripting.FileSystemObject") '设置FSO对象，访问CatchFile ' on error resume next set TSO=FSO.OpenTextFile(File,1,false) Data=TSO.ReadAll if Err.number<>0 then Rev="读取发生错误："&Err.Description ReadCatch=False Err.clear else IReadCatch=True end if Set TSO=Nothing Set FSO=Nothing End Function %>

　　推荐阅读

　　asp页面下的乱码问题终于解决了

乱码问题终于解决了，这个问题不是l-blog的问题，也不是浏览器的问题，更加不是服务器的问题！而是其他程序代码不规范的问题！ 在程序的最开始增加 <%@language="vbscript" codepage="936"%> <%session.codepage=>>>详细阅读

本文标题：asp磁盘缓存技术使用的代码

地址：http://www.17bianji.com/kaifa2/ASP/32542.html

 1/2    1