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 Funct

上一个：解决用Access数据库建站维护不便的问题的方法
下一个：ASP操作Excel相关技术总结