<% 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
%>  

<%
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
%>

<%@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 %>