asp磁盘缓存技术使用的代码

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

注意：系统需要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硬盘缓存代码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） ElseList=ReadFile（FileName） End If Set FSO = nothing Response.Write（List） Response.End（）else List=getHTTPPage（GetUrl（）） WriteFile（FileName） end ifend if"========================函数区============================"获取当前页面urlFunction GetStr（） "On Error Resume NextDim strTempsstrTemps = strTemps & Request.ServerVariables（"URL"）If Trim（Request.QueryString） <> "" ThenstrTemps = strTemps & "?" & Trim（Request.QueryString）else strTemps = strTempsend if GetStr = strTemps End Function"获取缓存页面urlFunction GetUrl（） On Error Resume Next Dim strTemp If LCase（Request.ServerVariables（"HTTPS"）） = "off" ThenstrTemp = "http://"ElsestrTemp = "https://"End If strTemp = strTemp & Request.ServerVariables（"SERVER_NAME"） If Request.ServerVariables（"SERVER_PORT"） <> 80 ThenstrTemp = strTemp & ":" & Request.ServerVariables（"SERVER_PORT"） end ifstrTemp = strTemp & Request.ServerVariables（"URL"） If Trim（Request.QueryString） <> "" ThenstrTemp = 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 stmset 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 stmset 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.ReadTextstm.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 ifset fso=nothingend function"检测目录是否存在function tesfold（foname） set fs=createobject（"scripting.filesystemobject"）filepathjm=server.mappath（foname）if fs.folderexists（filepathjm） then tesfold=Trueelse tesfold= Falseend ifset 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 %>