這一種方法適合,訪問相對集中在同樣內(nèi)容頁面的網(wǎng)站,會自動生成緩存文件(相當(dāng)于讀取靜態(tài)頁面,但會增大文件)。如果訪問不集中會造成服務(wù)器同時讀取文件當(dāng)機。
注意:系統(tǒng)需要FSO權(quán)限、XMLHTTP權(quán)限
系統(tǒng)包括兩個文件,其實可以合并為一個。之所以分為兩個是因為部分殺毒軟件會因為里邊含有FSO、XMLHTTP操作而被認(rèn)為是腳本木馬。
調(diào)用時,需要在ASP頁面的最上邊包含主文件,然后在下邊寫下以下代碼
主包含文件:FileCatch.asp
!--#include file="FileCatch-Inc.asp"-->
%
'---- 本文件用于簽入原始文件,實現(xiàn)對頁面的文件Catch
'---- 1、如果文件請求為POST方式,則取消此功能
'---- 2、文件的請求不能包含系統(tǒng)的識別關(guān)鍵字
'---- 3、作者 何直群 (www.wozhai.com)
Class CatchFile
Public Overdue,Mark,CFolder,CFile '定義系統(tǒng)參數(shù)
Private ScriptName,ScriptPath,ServerHost '定義服務(wù)器/頁面參數(shù)變量
Public CatchData '輸出的數(shù)據(jù)
Private Sub Class_Initialize '初始化函數(shù)
'獲得服務(wù)器及腳本數(shù)據(jù)
ScriptName=Request.Servervariables("Script_Name") '識別出當(dāng)前腳本的虛擬地址
ScriptPath=GetScriptPath(false) '識別出腳本的完整GET地址
ServerHost=Request.Servervariables("Server_Name") '識別出當(dāng)前服務(wù)器的地址
'初始化系統(tǒng)參數(shù)
Overdue=30 '默認(rèn)30分鐘過期
Mark="NoCatch" '無Catch請求參數(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對象
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=CFolderMonth(Now())
end if
if Day(Now())10 then
CFolder=CFolder"0"Day(Now())
else
CFolder=CFolderDay(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) '用戶指定開始處理Catch操作
if UCase(request.Servervariables("Request_Method"))="POST" then
'當(dāng)是POST方法,不可使用文件Catch
Rev="使用POST方法請求頁面,不可以使用文件Catch功能"
CatchNow=false
else
if request.Querystring(Mark)>"" then
'如果指定參數(shù)不為空,表示請求不可以使用Catch
Rev="請求拒絕使用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對象,訪問CatchFile
If FSO.FileExists(CFolderCFile) Then
Dim File,LastCatch
Set File=FSO.GetFile(CFolderCFile) '定義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) '如果需要創(chuàng)建Catch,則創(chuàng)建Catch文件,同時設(shè)置Catch的數(shù)據(jù)
else
GetCatchData=ReadCatch(Rev) '如果不需要創(chuàng)建Catch,則直接讀取Catch數(shù)據(jù)
End if
Set FSO=nothing
End Function
Private Function GetScriptPath(IsGet) '創(chuà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=GetScriptPathServer.URLEncode(Key)"="Server.URLEncode(Request.QueryString(Key))
Next
if IsGet then
If Fir then
GetScriptPath=GetScriptPath"?"
Fir=false
else
GetScriptPath=GetScriptPath""
end if
GetScriptPath=GetScriptPathServer.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 ServerHostGetScriptPath(true)
HTTP.Open "get","http://"ServerHostGetScriptPath(true),False
HTTP.Send
if Err.number=0 then
CatchData=bytes2BSTR(HTTP.responseBody)
BuildCatch=True
else
Rev="創(chuàng)建發(fā)生錯誤:"Err.Description
BuildCatch=False
Err.clear
end if
Call WriteCatch
set HTTP=nothing
End Function
Private Function ReadCatch(Rev)
ReadCatch=IReadCatch(CFolderCFile,CatchData,Rev)
End Function
Private Sub WriteCatch
Dim FSO,TSO
Set FSO=CreateObject("Scripting.FileSystemObject") '設(shè)置FSO對象,訪問CatchFile
set TSO=FSO.CreateTextFile(CFolderCFile,true)
TSO.Write(CatchData)
Set TSO=Nothing
Set FSO=Nothing
End Sub
End Class
%>