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

　　复制代码 代码如下:
<%@LANGUAGE=VBSCRIPT 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 =
Else
strTemp =
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)
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
%>