本文主要为广大网友提供“asp伪静态情况下实现的utf-8文件缓存实现代码”,希望对需要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