Utf-8 File Cache Implementation code-application techniques implemented in ASP pseudo-static case

Copy Code code as follows:

<% @LANGUAGE = "VBSCRIPT" codepage= "65001"%>
<% response.codepage=65001%>
<% response.charset= "UTF-8"%>
<%
' This program reduces the reading of the database 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.
timedelay=30 ' Update time interval, in minutes, such as 1440 minutes for 1 days. The generated static file is deleted after that interval.
' ====================== Main program area ============================
Foxrax=request ("Foxrax")
If foxrax= "" Then
Filename=getstr () & ". txt"
Filename=dirname&filename
If Tesfold (dirname) =false Then ' create if no folders exist
Createfold (Server.MapPath (".") & "\" &dirname)
End If
If Reportfilestatus (Server.MapPath (".") & "\ &filename) =true Then ' if there is a generated static file, read the file directly
Set fso=createobject ("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 ' over
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 current page URL
Function Getstr ()
' On Error Resume Next
Dim Strtemps
Strtemps = strtemps & Request.ServerVariables ("Http_x_rewrite_url")
Getstr = Server.URLEncode (strtemps)
End Function
' Get cached 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") <> 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

' Crawl 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 write, this parameter with 2 error
Stm. charset= "Utf-8"
Stm. Open
Stm. WRITETEXT List
Stm. SaveToFile Server.MapPath (FilePath), 2 ' adsavecreateoverwrite, file exists to overwrite
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 in binary data
Stm. Mode=3 ' adModeReadWrite, there's only 3 to use.
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
' Detects if a 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
' Detect if a 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 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 If
Set objFSO = Nothing
End Function
%>