asp硬盘缓存

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

'========================函数区============================

'获取当前页面url
Function 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

'获取缓存页面url
Function 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 if
strTemp = strTemp & Request.ServerVariables("URL")
If Trim(Request.QueryString) <> "" Then
  strTemp = strTemp & "?" & Trim(Request.QueryString) & "&foxrax=foxrax"
else
  strTemp = strTemp & "?" & "foxrax=foxrax"
end if
GetUrl = 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 Function

Sub 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=nothing
end 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=nothing
end function

 '建立目录
sub createfold(foname)
   set fs=createobject("scripting.filesystemobject")
   fs.createfolder(foname)
   set fs=nothing
end 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 = nothing
end function 
%>