主頁(yè) > 知識(shí)庫(kù) > asp磁盤緩存技術(shù)使用的代碼

asp磁盤緩存技術(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è)面的最上邊包含主文件，然后在下邊寫下以下代碼

% 
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 
%>

復(fù)制代碼代碼如下:

主包含文件：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=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)        '用戶指定開(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(CFolderCFile) Then
                        Dim File,LastCatch
                        Set File=FSO.GetFile(CFolderCFile)        '定義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=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ā)生錯(cuò)誤："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對(duì)象，訪問(wèn)CatchFile
                set TSO=FSO.CreateTextFile(CFolderCFile,true)
                TSO.Write(CatchData)
                Set TSO=Nothing
                Set FSO=Nothing
        End Sub
End Class
%>

文件二:FileCatch-Inc.asp

復(fù)制代碼代碼如下:

% 

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硬盤緩存代碼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=DirNameFileName
 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,讀取寫入，此參數(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 
%>

標(biāo)簽：衡水廣元大理蚌埠棗莊衢州江蘇萍鄉(xiāng)

巨人網(wǎng)絡(luò)通訊聲明：本文標(biāo)題《asp磁盤緩存技術(shù)使用的代碼》，本文關(guān)鍵詞；如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問(wèn)題，煩請(qǐng)?zhí)峁┫嚓P(guān)信息告之我們，我們將及時(shí)溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò)，涉及言論、版權(quán)與本站無(wú)關(guān)。