Code used by ASP disk cache technology

Source: Internet
Author: User
Tags servervariables

This method is suitable for websites that are relatively concentrated on pages with the same content, and cache files are automatically generated (equivalent to reading static pages but increasing files ). If the access is not concentrated, the server will read files at the same time.
Note: The system requires FSO and XMLHTTP permissions.

The system includes two files, which can be combined into one. Some anti-virus software is considered as a script trojan because it contains FSO and XMLHTTP operations.

When calling, you need to include the master file at the top of the ASP page, and then write the followingCode
<%
Set mycatch = new catchfile
Mycatch. Overdue = 60*5 'modify the expiration time to 5 hours
If mycatch. catchnow (REV) then
Response. Write mycatch. catchdata
Response. End
End if
Set mycatch = nothing
%>

======================================
Main file: filecatch. asp
<! -- # Include file = "FileCatch-Inc.asp" -->
<%
'---- This file is used to check in the original file and catch the file on the page
'---- 1. If the file request is post, this function is canceled.
'---- 2. file requests cannot contain the system's identification keywords
'---- 3. Author he zhiqun (www.wozhai.com)
Class catchfile
Public overdue, Mark, cfolder, cfile 'define System Parameters
Private scriptname, scriptpath, serverhost' defines server/Page parameter variables
Public catchdata' output 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) 'identifies the complete get address of the script
Serverhost = request. servervariables ("SERVER_NAME") 'identifies the address of the current server

'Initialize System Parameters
Overdue = 30' expired in 30 minutes by default
Mark = "nocatch" 'No catch request parameter is nocatch
Cfolder = getcfolder 'defines the default catch file storage directory
Cfile = server. urlencode (scriptpath) & ". txt" 'converts the script path to the file path

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) 'function for converting the Encoding
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 it is the POST method, file catch is not allowed
REV = "using the POST method to request pages, file catch function is not allowed"
Catchnow = false
Else
If request. querystring (Mark) <> "" then
'If the specified parameter is not null, the request cannot use catch
REV = "request rejection using the catch function"
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 and accesses the catchfile

If FSO. fileexists (cfolder & cfile) then
Dim file, lastcatch
Set file = FSO. GetFile (cfolder & cfile) 'defines the catchfile 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) 'if you do not need to create a catch, you can directly read the catch data.
End if

Set FSO = nothing
End Function

private function getscriptpath (isget) 'creates an address that contains all the request 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 a 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 = "creation 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 and accesses the catchfile
Set Tso = FSO. createtextfile (cfolder & cfile, true)
TSO. Write (catchdata)
Set Tso = nothing
Set FSO = nothing
End sub
End Class
%>

======================================
Document 2: FileCatch-Inc.asp
<%
Function ireadcatch (file, Data, rev)
Dim FSO, Tso
Set FSO = Createobject ("scripting. FileSystemObject") 'sets the FSO object and accesses 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
%>

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.