asp伪静态情况下实现的utf-8文件缓存实现代码

<%@language="vbscript" codepage="65001"%>
<% response.codepage=65001%>
<% response.charset="utf-8" %>
<%
'该程序通过使用asp的fso功能，减少数据库的读取。经测试，可以减少90%的服务器负荷。页面访问速度基本与静态页面相当。
'使用方法：将该文件放在网站里，然后在需要引用的文件的“第一行”用include引用即可。
'=======================参数区=============================
dirname="cachenew\" '静态文件保存的目录，结尾应带"\"。无须手动建立，程序会自动建立。
timedelay=30 '更新的时间间隔，单位为分钟，如1440分钟为1天。生成的静态文件在该间隔之后会被删除。
'======================主程序区============================
foxrax=request("foxrax")
if foxrax="" then
filename=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("http_x_rewrite_url")
getstr = server.urlencode(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)
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
'检测文件是否存在
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
%>