asp磁碟緩衝技術使用的代碼

這一種方法適合，訪問相對集中在同樣內容頁面的網站，會自動產生快取檔案(相當於讀取靜態頁面，但會增大檔案)。如果訪問不集中會造成伺服器同時讀取檔案當機。
注意：系統需要FSO許可權、XMLHTTP許可權

系統包括兩個檔案，其實可以合并為一個。之所以分為兩個是因為部分殺毒軟體會因為裡邊含有FSO、XMLHTTP操作而被認為是指令碼木馬。

調用時，需要在ASP頁面的最上邊包含主檔案，然後在下邊寫下以下代碼
<%
Set MyCatch=new CatchFile
MyCatch.Overdue=60*5 '修改到期時間設定為5個小時
if MyCatch.CatchNow(Rev) then
response.write MyCatch.CatchData
response.end
end if
set MyCatch=nothing
%>

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
主包含檔案：FileCatch.asp
<!--#include file="FileCatch-Inc.asp"-->
<%
'---- 本檔案用於簽入原始檔案，實現對頁面的檔案Catch
'---- 1、如果檔案請求為POST方式，則取消此功能
'---- 2、檔案的請求不能包含系統的識別關鍵字
'---- 3、作者 何直群 (www.wozhai.com)
Class CatchFile
Public Overdue,Mark,CFolder,CFile '定義系統參數
Private ScriptName,ScriptPath,ServerHost '定義伺服器/頁面參數變數
Public CatchData '輸出的資料

Private Sub Class_Initialize '初始化函數
'獲得伺服器及指令碼資料
ScriptName=Request.Servervariables("Script_Name") '識別出當前指令碼的虛擬位址
ScriptPath=GetScriptPath(false) '識別出指令碼的完整GET地址
ServerHost=Request.Servervariables("Server_Name") '識別出當前伺服器的地址

'初始化系統參數
Overdue=30 '預設30分鐘到期
Mark="NoCatch" '無Catch請求參數為 NoCatch
CFolder=GetCFolder '定義預設的Catch檔案儲存目錄
CFile=Server.URLEncode(ScriptPath)&".txt" '將指令碼路徑轉化為檔案路徑

CatchData=""
end Sub

Private Function GetCFolder
dim FSO,CFolder
Set FSO=CreateObject("Scripting.FileSystemObject") '設定FSO對象
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) '轉換編碼的函數
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) '使用者指定開始處理Catch操作
if UCase(request.Servervariables("Request_Method"))="POST" then
'當是POST方法，不可使用檔案Catch
Rev="使用POST方法請求頁面，不可以使用檔案Catch功能"
CatchNow=false
else
if request.Querystring(Mark)<>"" then
'如果指定參數不為空白，表示請求不可以使用Catch
Rev="請求拒絕使用Catch功能"
CatchNow=false
else
CatchNow=GetCatchData(Rev)
end if
end if
End Function

Private Function GetCatchData(Rev) '讀取Catch資料
Dim FSO,IsBuildCatch
Set FSO=CreateObject("Scripting.FileSystemObject") '設定FSO對象，訪問CatchFile

If FSO.FileExists(CFolder&CFile) Then
Dim File,LastCatch
Set File=FSO.GetFile(CFolder&CFile) '定義CatchFile檔案對象
LastCatch=CDate(File.DateLastModified)
if DateDiff("n",LastCatch,Now())>Overdue then
'如果超過了Catch時間
IsBuildCatch=true
else
IsBuildCatch=false
end if
Set File=Nothing
else
IsBuildCatch=true
End if

If IsBuildCatch then
GetCatchData=BuildCatch(Rev) '如果需要建立Catch,則建立Catch檔案，同時設定Catch的資料
else
GetCatchData=ReadCatch(Rev) '如果不需要建立Catch，則直接讀取Catch資料
End if

Set FSO=nothing
End Function

Private Function GetScriptPath(IsGet) '建立一個包含所有請求資料的地址
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

'建立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="建立發生錯誤："&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") '設定FSO對象，訪問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") '設定FSO對象，訪問CatchFile
' on error resume next
set TSO=FSO.OpenTextFile(File,1,false)
Data=TSO.ReadAll
if Err.number<>0 then
Rev="讀取發生錯誤："&Err.Description
ReadCatch=False
Err.clear
else
IReadCatch=True
end if
Set TSO=Nothing
Set FSO=Nothing
End Function
%>