asp磁盤(pán)緩存技術(shù)使用的代碼
這一種方法適合，訪問(wèn)相對(duì)集中在同樣內(nèi)容頁(yè)面的網(wǎng)站，會(huì)自動(dòng)生成緩存文件(相當(dāng)于讀取靜態(tài)頁(yè)面，但會(huì)增大文件)。如果訪問(wèn)不集中會(huì)造成服務(wù)器同時(shí)讀取文件當(dāng)機(jī)。
注意：系統(tǒng)需要FSO權(quán)限、XMLHTTP權(quán)限
系統(tǒng)包括兩個(gè)文件，其實(shí)可以合并為一個(gè)。之所以分為兩個(gè)是因?yàn)椴糠謿⒍拒浖?huì)因?yàn)槔镞吅蠪SO、XMLHTTP操作而被認(rèn)為是腳本木馬。
調(diào)用時(shí)，需要在ASP頁(yè)面的最上邊包含主文件，然后在下邊寫(xiě)下以下代碼
<%
Set MyCatch=new CatchFile
MyCatch.Overdue=60*5 '修改過(guò)期時(shí)間設(shè)置為5個(gè)小時(shí)
if MyCatch.CatchNow(Rev) then
response.write MyCatch.CatchData
response.end
end if
set MyCatch=nothing
%>
主包含文件：FileCatch.asp
<!--#include file="FileCatch-Inc.asp"-->
<%
'---- 本文件用于簽入原始文件，實(shí)現(xiàn)對(duì)頁(yè)面的文件Catch
'---- 1、如果文件請(qǐng)求為POST方式，則取消此功能
'---- 2、文件的請(qǐng)求不能包含系統(tǒng)的識(shí)別關(guān)鍵字
'---- 3、作者 何直群 (www.wozhai.com)
Class CatchFile
Public Overdue,Mark,CFolder,CFile '定義系統(tǒng)參數(shù)
Private ScriptName,ScriptPath,ServerHost '定義服務(wù)器/頁(yè)面參數(shù)變量
Public CatchData '輸出的數(shù)據(jù)
Private Sub Class_Initialize '初始化函數(shù)
'獲得服務(wù)器及腳本數(shù)據(jù)
ScriptName=Request.Servervariables("Script_Name") '識(shí)別出當(dāng)前腳本的虛擬地址
ScriptPath=GetScriptPath(false) '識(shí)別出腳本的完整GET地址
ServerHost=Request.Servervariables("Server_Name") '識(shí)別出當(dāng)前服務(wù)器的地址
'初始化系統(tǒng)參數(shù)
Overdue=30 '默認(rèn)30分鐘過(guò)期
Mark="NoCatch" '無(wú)Catch請(qǐng)求參數(shù)為 NoCatch
CFolder=GetCFolder '定義默認(rèn)的Catch文件保存目錄
CFile=Server.URLEncode(ScriptPath)&".txt" '將腳本路徑轉(zhuǎn)化為文件路徑
CatchData=""
end Sub
Private Function GetCFolder
dim FSO,CFolder
Set FSO=CreateObject("Scripting.FileSystemObject") '設(shè)置FSO對(duì)象
CFolder=Server.MapPath("/")&"/FileCatch/"
if not FSO.FolderExists(CFolder) then
fso.CreateFolder(CFolder)
end if
if Month(Now())<10 then
CFolder=CFolder&"/0"&Month(Now())
else
CFolder=CFolder&Month(Now())
end if
if Day(Now())<10 then
CFolder=CFolder&"0"&Day(Now())
else
CFolder=CFolder&Day(Now())
end if
CFolder=CFolder&"/"
if not FSO.FolderExists(CFolder) then
fso.CreateFolder(CFolder)
end if
GetCFolder=CFolder
set fso=nothing
End Function
Private Function bytes2BSTR(vIn) '轉(zhuǎn)換編碼的函數(shù)
dim StrReturn,ThisCharCode,i,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
Public Function CatchNow(Rev) '用戶指定開(kāi)始處理Catch操作
if UCase(request.Servervariables("Request_Method"))="POST" then
'當(dāng)是POST方法，不可使用文件Catch
Rev="使用POST方法請(qǐng)求頁(yè)面，不可以使用文件Catch功能"
CatchNow=false
else
if request.Querystring(Mark)<>"" then
'如果指定參數(shù)不為空，表示請(qǐng)求不可以使用Catch
Rev="請(qǐng)求拒絕使用Catch功能"
CatchNow=false
else
CatchNow=GetCatchData(Rev)
end if
end if
End Function
Private Function GetCatchData(Rev) '讀取Catch數(shù)據(jù)
Dim FSO,IsBuildCatch
Set FSO=CreateObject("Scripting.FileSystemObject") '設(shè)置FSO對(duì)象，訪問(wèn)CatchFile
If FSO.FileExists(CFolder&CFile) Then
Dim File,LastCatch
Set File=FSO.GetFile(CFolder&CFile) '定義CatchFile文件對(duì)象
LastCatch=CDate(File.DateLastModified)
if DateDiff("n",LastCatch,Now())>Overdue then
'如果超過(guò)了Catch時(shí)間
IsBuildCatch=true
else
IsBuildCatch=false
end if
Set File=Nothing
else
IsBuildCatch=true
End if
If IsBuildCatch then
GetCatchData=BuildCatch(Rev) '如果需要?jiǎng)?chuàng)建Catch,則創(chuàng)建Catch文件，同時(shí)設(shè)置Catch的數(shù)據(jù)
else
GetCatchData=ReadCatch(Rev) '如果不需要?jiǎng)?chuàng)建Catch，則直接讀取Catch數(shù)據(jù)
End if
Set FSO=nothing
End Function
Private Function GetScriptPath(IsGet) '創(chuàng)建一個(gè)包含所有請(qǐng)求數(shù)據(jù)的地址
dim Key,Fir
GetScriptPath=ScriptName
Fir=true
for Each key in Request.QueryString
If Fir then
GetScriptPath=GetScriptPath&"?"
Fir=false
else
GetScriptPath=GetScriptPath&"&"
end if
GetScriptPath=GetScriptPath&Server.URLEncode(Key)&"="&Server.URLEncode(Request.QueryString(Key))
Next
if IsGet then
If Fir then
GetScriptPath=GetScriptPath&"?"
Fir=false
else
GetScriptPath=GetScriptPath&"&"
end if
GetScriptPath=GetScriptPath&Server.URLEncode(Mark)&"=yes"
end if
End Function
'創(chuàng)建Catch文件
Private Function BuildCatch(Rev)
Dim HTTP,Url,OutCome
Set HTTP=CreateObject("Microsoft.XMLHTTP")
' On Error Resume Next
' response.write ServerHost&GetScriptPath(true)
HTTP.Open "get","http://"&ServerHost&GetScriptPath(true),False
HTTP.Send
if Err.number=0 then
CatchData=bytes2BSTR(HTTP.responseBody)
BuildCatch=True
else
Rev="創(chuàng)建發(fā)生錯(cuò)誤："&Err.Description
BuildCatch=False
Err.clear
end if
Call WriteCatch
set HTTP=nothing
End Function
Private Function ReadCatch(Rev)
ReadCatch=IReadCatch(CFolder&CFile,CatchData,Rev)
End Function
Private Sub WriteCatch
Dim FSO,TSO
Set FSO=CreateObject("Scripting.FileSystemObject") '設(shè)置FSO對(duì)象，訪問(wèn)CatchFile
set TSO=FSO.CreateTextFile(CFolder&CFile,true)
TSO.Write(CatchData)
Set TSO=Nothing
Set FSO=Nothing
End Sub
End Class
%>
文件二:FileCatch-Inc.asp
<%
Function IReadCatch(File,Data,Rev)
Dim FSO,TSO
Set FSO=CreateObject("Scripting.FileSystemObject") '設(shè)置FSO對(duì)象，訪問(wèn)CatchFile
' on error resume next
set TSO=FSO.OpenTextFile(File,1,false)
Data=TSO.ReadAll
if Err.number<>0 then
Rev="讀取發(fā)生錯(cuò)誤："&Err.Description
ReadCatch=False
Err.clear
else
IReadCatch=True
end if
Set TSO=Nothing
Set FSO=Nothing
End Function
%>
asp硬盤(pán)緩存代碼2
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<% Response.CodePage=65001%>
<% Response.Charset="UTF-8" %>
<%
'該程序通過(guò)使用ASP的FSO功能，減少數(shù)據(jù)庫(kù)的讀取。經(jīng)測(cè)試，可以減少90%的服務(wù)器負(fù)荷。頁(yè)面訪問(wèn)速度基本與靜態(tài)頁(yè)面相當(dāng)。
'使用方法：將該文件放在網(wǎng)站里，然后在需要引用的文件的“第一行”用include引用即可。
'=======================參數(shù)區(qū)=============================
DirName="cachenew\" '靜態(tài)文件保存的目錄，結(jié)尾應(yīng)帶"\"。無(wú)須手動(dòng)建立，程序會(huì)自動(dòng)建立。
'TimeDelay=10 '更新的時(shí)間間隔，單位為分鐘，如1440分鐘為1天。生成的靜態(tài)文件在該間隔之后會(huì)被刪除。
TimeDelay=300
'======================主程序區(qū)============================
foxrax=Request("foxrax")
if foxrax="" then
FileName=Server.URLEncode(GetStr())&".txt"
FileName=DirName&FileName
if tesfold(DirName)=false then'如果不存在文件夾則創(chuàng)建
createfold(Server.MapPath(".")&"\"&DirName)
end if
if ReportFileStatus(Server.MapPath(".")&"\"&FileName)=true then'如果存在生成的靜態(tài)文件,則直接讀取文件
Set FSO=CreateObject("Scripting.FileSystemObject")
Dim Files,LatCatch
Set Files=FSO.GetFile(Server.MapPath(FileName)) '定義CatchFile文件對(duì)象
LastCatch=CDate(Files.DateLastModified)
If DateDiff("n",LastCatch,Now())>TimeDelay Then'超過(guò)
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
'========================函數(shù)區(qū)============================
'獲取當(dāng)前頁(yè)面url
Function GetStr()
'On Error Resume Next
Dim strTemps
strTemps = strTemps & Request.ServerVariables("URL")
If Trim(Request.QueryString) <> "" Then
strTemps = strTemps & "?" & Trim(Request.QueryString)
else
strTemps = strTemps
end if
GetStr = strTemps
End Function
'獲取緩存頁(yè)面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
'抓取頁(yè)面
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)
On Error Resume Next
dim stm
set stm=Server.CreateObject("adodb.stream")
stm.Type=2 'adTypeText，文本數(shù)據(jù)
stm.Mode=3 'adModeReadWrite,讀取寫(xiě)入，此參數(shù)用2則報(bào)錯(cuò)
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，按二進(jìn)制數(shù)據(jù)讀入
stm.Mode=3 'adModeReadWrite ,這里只能用3用其他會(huì)出錯(cuò)
stm.Open
stm.LoadFromFile Server.MapPath(filePath)
stm.Position=0 '把指針移回起點(diǎn)
stm.Type=2 '文本數(shù)據(jù)
stm.Charset="utf-8"
ReadFile = stm.ReadText
stm.Close
set stm=nothing
End Function
'讀取文件
'Public Function ReadFile( xVar )
'xVar = Server.Mappath(xVar)
'Set Sys = Server.CreateObject("Scripting.FileSystemObject")
'If Sys.FileExists( xVar ) Then
'Set Txt = Sys.OpenTextFile( xVar, 1,false)
'msg = Txt.ReadAll
'Txt.Close
'Response.Write("yes")
'Else
'msg = "no"
'End If
'Set Sys = Nothing
'ReadFile = msg
'End Function
'檢測(cè)文件是否存在
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
'檢測(cè)目錄是否存在
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
%>
相關(guān)文章
關(guān)于“未指定的錯(cuò)誤”的問(wèn)題 的比較正解的解決方法
關(guān)于“未指定的錯(cuò)誤”的問(wèn)題 的比較正解的解決方法...2007-04-04
在基于瀏覽器/服務(wù)器的應(yīng)用環(huán)境中，在瀏覽器中上傳各種類(lèi)型的文件一直是困擾用戶文件管理應(yīng)用的難題之一。常用的實(shí)現(xiàn)方法是利用在RFC1867中引入的一個(gè)新類(lèi)型：File以及ADO Stream對(duì)象。本文對(duì)上述上傳方法及實(shí)現(xiàn)原理作了論述，并給出了具體解決實(shí)例。2015-09-09
ASP(Active Server Page)是Microsoft公司推出的基于PWS(Personal Web Server)&IIS(Internet Information Server)平臺(tái)的、基于ISAPI(InternetServiceAPI)原理的動(dòng)態(tài)網(wǎng)頁(yè)開(kāi)發(fā)技術(shù)，目前日趨成熟完善。在這里僅就代碼優(yōu)化進(jìn)行一些簡(jiǎn)單討論。2015-09-09
ASP類(lèi)型網(wǎng)站結(jié)合動(dòng)網(wǎng)論壇會(huì)員的方法
ASP類(lèi)型網(wǎng)站結(jié)合動(dòng)網(wǎng)論壇會(huì)員的方法...2007-11-11
asp HTTP 500錯(cuò)誤 常見(jiàn)問(wèn)題分析
這個(gè)問(wèn)題一般錯(cuò)誤不是很大，大家可以參考下面的步驟解決。2009-03-03
ASP語(yǔ)言實(shí)現(xiàn)對(duì)SQL SERVER數(shù)據(jù)庫(kù)的操作
目前有很多介紹用ASP開(kāi)發(fā)網(wǎng)絡(luò)數(shù)據(jù)庫(kù)的程序例子，但絕大部分是利用ACCESS作底層數(shù)據(jù)庫(kù)。相對(duì)于ACCESS而言，SQL SERVER數(shù)據(jù)庫(kù)系統(tǒng)要復(fù)雜得多，因此在程序開(kāi)發(fā)中需要多做一些工作。筆者結(jié)合自己開(kāi)發(fā)管理信息系統(tǒng)的經(jīng)驗(yàn)，在此試舉一例，與感興趣的朋友共同交流2015-09-09
生成EAN13標(biāo)準(zhǔn)的條形碼的ASP代碼實(shí)例
生成EAN13標(biāo)準(zhǔn)的條形碼的ASP代碼實(shí)例...2007-10-10
循環(huán)語(yǔ)句的作用就是重復(fù)執(zhí)行程序代碼，循環(huán)可分為三類(lèi)：一類(lèi)在條件變?yōu)椤凹佟敝爸貜?fù)執(zhí)行語(yǔ)句，一類(lèi)在條件變?yōu)椤罢妗敝爸貜?fù)執(zhí)行語(yǔ)句，另一類(lèi)按照指定的次數(shù)重復(fù)執(zhí)行語(yǔ)句，需要的朋友可以參考下2015-09-09
通過(guò)表單的做為二進(jìn)制文件上傳request.totalbytes提取出上傳的二級(jí)制數(shù)據(jù)
通過(guò)表單的做為二進(jìn)制文件上傳request.totalbytes提取出上傳的二級(jí)制數(shù)據(jù)的代碼說(shuō)明。2009-09-09
如何增加Referer功能--反向鏈接插件...2007-02-02