ASP disk caching technology using the code _ Application Tips

This approach is appropriate for accessing a Web site that is relatively centralized on the same content page, automatically generating a cached file (equivalent to reading a static page, but increasing the file). If the access is not centralized, the server will read the file at the same time.

Note: The system needs FSO permissions, XMLHTTP permissions

The system consists of two files, which can actually be merged into one. The reason is divided into two because some anti-virus software will contain FSO, XMLHTTP operation is considered to be a script Trojan.

When called, you need to include the main file at the top of the ASP page, and then write the following code below

<% set 
mycatch=new catchfile 
mycatch.overdue=60*5    ' modify expiration time set to 5 hours 
if Mycatch.catchnow (Rev) Then 
    Response.Write mycatch.catchdata 
    Response.End End 
If 
set mycatch=nothing 
%>

Copy Code code as follows:

Master include file: filecatch.asp


<!--#include file= "filecatch-inc.asp"-->


<%


'----This file is used to check in the original file and implement a file catch on the page


'----1, cancel this feature if the file request is post mode


'----2, file request cannot contain system identification keyword


'----3, author He Zhiqing (www.wozhai.com)


Class Catchfile


Public overdue,mark,cfolder,cfile ' defines system parameters


Private scriptname,scriptpath,serverhost ' defines server/page parameter variables


Public catchdata ' output of data

        Private Sub class_initialize         ' initialization function
                ' Get server and script data
                Scriptname=request.servervariables ("Script_name") ' identifies the virtual address of the current script
                 Scriptpath=getscriptpath (False)          ' Identify the complete get address of the script
                 serverhost=request.servervariables ("SERVER_NAME") ' identifies the address of the current server

' Initialize system parameters
Overdue=30 ' default 30 minutes expired
mark= "Nocatch" ' No catch request parameter is Nocatch
Cfolder=getcfolder ' defines the default catch file save directory
Cfile=server.urlencode (ScriptPath) & ". txt" converts script paths to file paths

Catchdata= ""
End Sub

Private Function Getcfolder


Dim Fso,cfolder


Set Fso=createobject ("Scripting.FileSystemObject") ' Sets the FSO object


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) ' Convert encoded function


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) ' user specifies to start handling catch operations


If UCase (request. ServerVariables ("request_method") = "POST" Then


' When is the post method, you cannot use file catch


rev= "Use the Post method to request a page, you cannot use the file Catch feature"


Catchnow=false


Else


If request. QueryString (Mark) <> "Then


' If the specified parameter is not NULL, the request is not allowed to use catch


rev= "Request deny use of Catch feature"


Catchnow=false


Else


Catchnow=getcatchdata (Rev)


End If


End If


End Function

Private Function getcatchdata (Rev) ' reads catch data
Dim Fso,isbuildcatch
Set Fso=createobject ("Scripting.FileSystemObject") ' Sets the FSO object to access the Catchfile

If FSO. FileExists (Cfolder&cfile) Then


Dim File,lastcatch


Set File=fso. GetFile (cfolder&cfile) ' Define Catchfile file object


Lastcatch=cdate (file.datelastmodified)


If DateDiff ("N", Lastcatch,now ()) >overdue Then


' If the catch time is exceeded


Isbuildcatch=true


Else


Isbuildcatch=false


End If


Set file=nothing


Else


Isbuildcatch=true


End If

                If Isbuildcatch Then
                         Getcatchdata=buildcatch (Rev)         ' If you need to create a catch, create a catch file and set the catch data
                 Else
                         Getcatchdata=readcatch (Rev)          ' read the catch data directly
          If you do not need to create a catch        End If

Set fso=nothing
End Function

Private Function Getscriptpath (isget) ' Creates an address that contains all the requested data


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

        ' Create catch file
        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= "Create error:" &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") ' Sets the FSO object to access the Catchfile
Set TSO=FSO. CreateTextFile (Cfolder&cfile,true)
TSO. Write (Catchdata)
Set tso=nothing
Set fso=nothing
End Sub
End Class
%>

Document II: filecatch-inc.asp

Copy Code code as follows:

<%


Function Ireadcatch (File,data,rev)


Dim Fso,tso


Set Fso=createobject ("Scripting.FileSystemObject") ' Sets the FSO object to access the Catchfile


' On Error Resume Next


Set TSO=FSO. OpenTextFile (File,1,false)


Data=tso. ReadAll


If Err.number<>0 Then


rev= "Read error:" &err.description


Readcatch=false


Err.Clear


Else


Ireadcatch=true


End If


Set tso=nothing


Set fso=nothing


End Function


%>

ASP hard disk Cache code 2

<% @LANGUAGE = "VBSCRIPT" codepage= "65001"%> <% response.codepage=65001%> <% response.charset= "UTF-8"% > <% ' This program reduces database reading by using the FSO function of ASP. After testing, you can reduce the server load by 90%.
Page access speed is basically equivalent to static pages.

' How to: Place the file in a Web site, and then use the include reference in the first line of the file you want to refer to. ' ======================= parameter area ============================= dirname= ' cachenew\ ' static file-saved directory, ending with "\".
The program is automatically created without the need for manual setup. The time interval for ' timedelay=10 ' updates, in minutes, such as 1440 minutes for 1 days.
The generated static file is deleted after that interval.
 Timedelay=300 ' ====================== main program area ============================ foxrax=request ("Foxrax") if foxrax= "" Then Filename=server.urlencode (Getstr ()) & ". txt" filename=dirname&filename if Tesfold (dirname) =false Then ' Create Createfold if no folder exists (Server.MapPath (".") & "\" &dirname) End If Reportfilestatus (Server.MapPath (".") & "\ &filename) =true Then ' if there is a generated static file, read the file Set Fso=createobject directly (" Scripting.FileSystemObject ") Dim files, Latcatch Set Files=fso. GetFile (Server.MapPath (FileName)) ' defines Catchfile file Object Lastcatch=cdate (files.datelastmodified) If DatEdiff ("n", Lastcatch,now ()) >timedelay Then ' more than List=gethttppage (GETURL ()) WriteFile (FileName) Else List=readfile (F Ilename) End If Set FSO = Nothing Response.Write (List) Response.End () Else List=gethttppage (GETURL ()) WriteFile (F Ilename) End If ' ======================== function area ============================ ' Get current page 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 Ge TSTR = Strtemps End Function ' gets cache page URL function GetUrl () on Error Resume Next Dim strtemp If LCase (request.servervar Iables ("HTTPS") = "Off" Then strtemp = "http://" Else strtemp = "https://" end If strtemp = strtemp & request.se Rvervariables ("SERVER_NAME") If Request.ServerVariables ("Server_port") <> Then strtemp = strtemp & ":" &am P 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 &am P "?" & "Foxrax=foxrax" End If GetUrl = strtemp End Function ' Crawl page function gethttppage (URL) Set Mail1 = Server.crea Teobject ("CDO.") Message "] Mail1.createmhtmlbody url,31 aa=mail1.htmlbody Set Mail1 = Nothing Gethttppage=aa ' Set retrieval = SERVER.C Reateobject ("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 s TM Set Stm=server.createobject ("ADODB.stream") stm. type=2 ' adTypeText, text data stm. Mode=3 ' adModeReadWrite, read write, this parameter is an error STM with 2. charset= "Utf-8" STM. Open STM. WRITETEXT list STM. SaveToFile Server.MapPath (FilePath), 2 ' adsavecreateoverwrite, file existence is coveredCover STM. Flush STM. Close Set stm=nothing end Sub Function ReadFile (filePath) Dim stm Set Stm=server.createobject ("Adodb.str Eam ") STM. Type=1 ' adTypeBinary, read into STM by binary data. Mode=3 ' adModeReadWrite, this can only be used with 3 other error STM. Open STM. LoadFromFile Server.MapPath (FilePath) STM. Position=0 ' Move the pointer back to the start STM. type=2 ' text data stm. charset= "utf-8" ReadFile = stm. ReadText STM.  Close Set stm=nothing End Function ' Read file ' 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 ' R Eadfile = Msg ' End Function ' detects whether the file exists a Function reportfilestatus (FileName) Set fso = Server.CreateObject ("Scripting.files Ystemobject ") if fso.fileexists (FileName) = True Then Reportfilestatus=true else other ReportfilestatUs=false End If Set fso=nothing End Function ' detects whether the directory exists a function tesfold (foname) Set Fs=createobject ("Scripting.file SystemObject ") Filepathjm=server.mappath (Foname) if Fs.folderexists (FILEPATHJM) then tesfold=true else tesfold = False End If set fs=nothing End Function ' establishes directory sub Createfold (foname) Set Fs=createobject ("Scripting.filesystem Object ") Fs.createfolder (foname) Set fs=nothing End Sub ' delete file function del_file (path) ' Path, file path contains file name set objFSO = Server.CreateObject ("Scripting.") FileSystemObject ") ' Path=server.mappath (path) if objFSO. FileExists (path) Then ' if present, delete objFSO. DeleteFile (path) ' Delete file Else ' Response.Write ' <script language= ' Javascript ' >alert (' file does not exist ') </script> "End I F Set objFSO = Nothing End Function%>