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