asp文件缓存代码，使程序从缓存读数据代码,ASP代码库,德仔网

代码语言
代码分类
【ASP】 asp文件缓存代码，使程序从缓存读数据
作者:Dezai.CN / 发布于2011/2/9/ 1920
<div><font face="Courier New">'---- 本文件用于签入原始文件，实现对页面的文件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</font>
</div>
试试其它关键字
　缓存　
同语言下
可能有用的
Dezai.CN贡献的其它代码(4037)