asp偽靜態情況下實現的utf-8文件緩存實現代碼
2024-05-04 10:59:57
供稿:網友
復制代碼 代碼如下:
<%@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