这一种方法适合，访问相对集中在同样内容页面的网站，会自动生成缓存文件(相当于读取静态页面，但会增大文件)。如果访问不集中会造成服务器同时读取文件当机。

注意：系统需要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、作者 何直群 (e
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硬盘缓存代码2

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%><% Response.CodePage=65001%> <% Response.Charset="UTF-8" %> <%'该程序通过使用ASP的FSO功能，减少数据库的读取。经测试，可以减少90%的服务器负荷。页面访问速度基本与静态页面相当。'使用方法：将该文件放在网站里，然后在需要引用的文件的“第一行”用include引用即可。'=======================参数区=============================DirName="cachenew\" '静态文件保存的目录，结尾应带"\"。无须手动建立，程序会自动建立。'TimeDelay=10 '更新的时间间隔，单位为分钟，如1440分钟为1天。生成的静态文件在该间隔之后会被删除。TimeDelay=300'======================主程序区============================foxrax=Request("foxrax")if foxrax="" then FileName=Server.URLEncode(GetStr())&".txt" FileName=DirName&FileName if tesfold(DirName)=false then'如果不存在文件夹则创建 createfold(Server.MapPath(".")&"\"&DirName) end if if ReportFileStatus(Server.MapPath(".")&"\"&FileName)=true then'如果存在生成的静态文件,则直接读取文件 Set FSO=CreateObject("Scripting.FileSystemObject") Dim Files,LatCatch Set Files=FSO.GetFile(Server.MapPath(FileName)) '定义CatchFile文件对象 LastCatch=CDate(Files.DateLastModified) If DateDiff("n",LastCatch,Now())>TimeDelay Then'超过 List=getHTTPPage(GetUrl()) WriteFile(FileName) Else List=ReadFile(FileName) End If Set FSO = nothing Response.Write(List) Response.End() else List=getHTTPPage(GetUrl()) WriteFile(FileName) end if end if'========================函数区============================'获取当前页面urlFunction GetStr() 'On Error Resume Next Dim strTemps strTemps = strTemps & Request.ServerVariables("URL") If Trim(Request.QueryString) <> "" Then strTemps = strTemps & "?" & Trim(Request.QueryString) else strTemps = strTemps end if GetStr = strTemps End Function'获取缓存页面urlFunction GetUrl() On Error Resume Next Dim strTemp If LCase(Request.ServerVariables("HTTPS")) = "off" Then strTemp = "http://"Else strTemp = "https://"End If strTemp = strTemp & Request.ServerVariables("SERVER_NAME") If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT") end ifstrTemp = strTemp & Request.ServerVariables("URL") If Trim(Request.QueryString) <> "" Then strTemp = strTemp & "?" & Trim(Request.QueryString) & "&foxrax=foxrax"else strTemp = strTemp & "?" & "foxrax=foxrax"end ifGetUrl = strTemp End Function'抓取页面Function getHTTPPage(url) Set Mail1 = Server.CreateObject("CDO.Message") Mail1.CreateMHTMLBody URL,31 AA=Mail1.HTMLBody Set Mail1 = Nothing getHTTPPage=AA 'Set Retrieval = Server.CreateObject("Microsoft.Xmlhttp") 'Retrieval.Open "GET",url,false,"","" 'Retrieval.Send 'getHTTPPage = Retrieval.ResponseBody 'Set Retrieval = Nothing End FunctionSub WriteFile(filePath) On Error Resume Next dim stm set stm=Server.CreateObject("adodb.stream") stm.Type=2 'adTypeText，文本数据 stm.Mode=3 'adModeReadWrite,读取写入，此参数用2则报错 stm.Charset="utf-8" stm.Open stm.WriteText list stm.SaveToFile Server.MapPath(filePath),2 'adSaveCreateOverWrite，文件存在则覆盖 stm.Flush stm.Close set stm=nothing End Sub Function ReadFile(filePath) dim stm set stm=Server.CreateObject("adodb.stream") stm.Type=1 'adTypeBinary，按二进制数据读入 stm.Mode=3 'adModeReadWrite ,这里只能用3用其他会出错 stm.Open stm.LoadFromFile Server.MapPath(filePath) stm.Position=0 '把指针移回起点 stm.Type=2 '文本数据 stm.Charset="utf-8" ReadFile = stm.ReadText stm.Close set stm=nothing End Function'读取文件'Public Function ReadFile( xVar ) 'xVar = Server.Mappath(xVar) 'Set Sys = Server.CreateObject("Scripting.FileSystemObject") 'If Sys.FileExists( xVar ) Then 'Set Txt = Sys.OpenTextFile( xVar, 1,false) 'msg = Txt.ReadAll 'Txt.Close 'Response.Write("yes") 'Else 'msg = "no" 'End If 'Set Sys = Nothing 'ReadFile = msg'End Function'检测文件是否存在Function ReportFileStatus(FileName) set fso = server.createobject("scripting.filesystemobject") if fso.fileexists(FileName) = true then ReportFileStatus=true else ReportFileStatus=false end if set fso=nothingend function'检测目录是否存在function tesfold(foname) set fs=createobject("scripting.filesystemobject") filepathjm=server.mappath(foname) if fs.folderexists(filepathjm) then tesfold=True else tesfold= False end if set fs=nothingend function '建立目录sub createfold(foname) set fs=createobject("scripting.filesystemobject") fs.createfolder(foname) set fs=nothingend sub'删除文件function del_file(path) 'path，文件路径包含文件名set objfso = server.createobject("scripting.FileSystemObject")'path=Server.MapPath(path)if objfso.FileExists(path) then '若存在则删除 objfso.DeleteFile(path) '删除文件else 'response.write "<script language='Javascript'>alert('文件不存在')</script>"end if set objfso = nothingend function %>