【下载文档:  asp伪静态情况下实现的utf-8文件缓存实现代码.txt 】

---

asp伪静态情况下实现的utf-8文件缓存实现代码
复制代码 代码如下: <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <% Response.CodePage=65001%> <% Response.Charset="UTF-8" %> <% '该程序通过使用ASP的FSO功能，减少数据库的读取。经测试，可以减少90%的服务器负荷。页面访问速度基本与静态页面相当。 '使用方法：将该文件放在网站里，然后在需要引用的文件的“第一行”用include引用即可。 '=======================参数区============================= DirName="cachenew\" '静态文件保存的目录，结尾应带"\"。无须手动建立，程序会自动建立。 TimeDelay=30 '更新的时间间隔，单位为分钟，如1440分钟为1天。生成的静态文件在该间隔之后会被删除。 '======================主程序区============================ foxrax=Request("foxrax") if foxrax="" then FileName=GetStr()&".txt" FileName=DirName&FileName if tesfold(DirName)=false then'如果不存在文件夹则创建 createfold(Server.MapPath(".")&"\"&DirName) end if if ReportFileStatus(Server.MapPath(".")&"\"&FileName)=true then'如果存在生成的静态文件,则直接读取文件 Set FSO=CreateObject("Scripting.FileSystemObject") Dim Files,LatCatch Set Files=FSO.GetFile(Server.MapPath(FileName)) '定义CatchFile文件对象 LastCatch=CDate(Files.DateLastModified) If DateDiff("n",LastCatch,Now())>TimeDelay Then'超过 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 '========================函数区============================ '获取当前页面url Function GetStr() 'On Error Resume Next Dim strTemps strTemps = strTemps & Request.ServerVariables("HTTP_X_REWRITE_URL") GetStr = Server.URLEncode(strTemps) End Function '获取缓存页面url Function GetUrl() On Error Resume Next Dim strTemp If LCase(Request.ServerVariables("HTTPS")) = "off" Then strTemp = "http://" Else strTemp = "http://" 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 '抓取页面 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，文本数据 stm.Mode=3 'adModeReadWrite,读取写入，此参数用2则报错 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，按二进制数据读入 stm.Mode=3 'adModeReadWrite ,这里只能用3用其他会出错 stm.Open stm.LoadFromFile Server.MapPath(filePath) stm.Position=0 '把指针移回起点 stm.Type=2 '文本数据 stm.Charset="utf-8" ReadFile = stm.ReadText stm.Close set stm=nothing End Function '检测文件是否存在 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 '检测目录是否存在 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 "" end if set objfso = nothing end function %>