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

（编辑：银川站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!