Code for implementing UTF-8 file caching under asp pseudo-static conditions

Copy codeThe Code is as follows: <% @ LANGUAGE = "VBSCRIPT" CODEPAGE = "65001" %>
<% Response. CodePage = 65001%>
<% Response. Charset = "UTF-8" %>
<%
'The program uses the FSO function of ASP to reduce database reading. Tested, the server load can be reduced by 90%. The page access speed is basically the same as that of static pages.
'Usage: place the file on the website, and then use include to reference the "first line" of the file to be referenced.
'====================================== Parameter zone ================ ====================
DirName = "cachenew \" 'Directory of the static file, ending "\". You do not need to manually create the program.
TimeDelay = 30' update interval, in the unit of minutes. For example, 1440 minutes is 1 day. The generated static files will be deleted after this interval.
'================================= Main program area ==================== ====================
Foxrax = Request ("foxrax ")
If foxrax = "" then
FileName = GetStr () & ". txt"
FileName = DirName & FileName
If tesfold (DirName) = false then' is created if no folder exists.
Createfold (Server. MapPath (".") & "\" & DirName)
End if
If ReportFileStatus (Server. MapPath (".") & "\" & FileName) = true then', if a generated static file exists, the file is directly read.
Set FSO = CreateObject ("Scripting. FileSystemObject ")
Dim Files, LatCatch
Set Files = FSO. GetFile (Server. MapPath (FileName) 'defines the CatchFile object
LastCatch = CDate (Files. DateLastModified)
If DateDiff ("n", LastCatch, Now ()> TimeDelay Then 'exceeds
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

'====================================== Function area ================== ====================
'Get the url of the current page
Function GetStr ()
'On Error Resume Next
Dim strTemps
StrTemps = strTemps & Request. ServerVariables ("HTTP_X_REWRITE_URL ")
GetStr = Server. URLEncode (strTemps)
End Function
'Get cache page 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

'Capture the page
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)
Dim stm
Set stm = Server. CreateObject ("adodb. stream ")
Stm. Type = 2 'adtypetext, text data
Stm. Mode = 3'admodereadwrite, read and write. If this parameter is set to 2, an error is returned.
Stm. Charset = "UTF-8"
Stm. Open
Stm. WriteText list
Stm. SaveToFile Server. MapPath (filePath), 2 'adsavecreateoverwrite, overwrite if the file exists
Stm. Flush
Stm. Close
Set stm = nothing
End Sub

Function ReadFile (filePath)
Dim stm
Set stm = Server. CreateObject ("adodb. stream ")
Stm. Type = 1' adTypeBinary, read by binary data
Stm. Mode = 3'admodereadwrite. Here, only 3 can be used. Other errors will occur.
Stm. Open
Stm. LoadFromFile Server. MapPath (filePath)
Stm. Position = 0' move the pointer back to the starting point
Stm. Type = 2' text data
Stm. Charset = "UTF-8"
ReadFile = stm. ReadText
Stm. Close
Set stm = nothing
End Function
'Check whether the file exists
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
'Check whether the directory exists
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
'Create a directory
Sub createfold (foname)
Set fs = createobject ("scripting. filesystemobject ")
Fs. createfolder (foname)
Set fs = nothing
End sub
'Delete an object
Function del_file (path) 'path, which contains the file name
Set objfso = server. createobject ("scripting. FileSystemObject ")
'Path = Server. MapPath (path)
If objfso. FileExists (path) then' exists, delete it.
Objfso. DeleteFile (path) 'delete an object
Else
'Response. write "<script language = 'javascript '> alert ('file does not exist') </script>"
End if
Set objfso = nothing
End function
%>