Discuz教程网

asp伪静态情况下实现的utf-8文件缓存实现代码

[复制链接]
authicon dly 发表于 2011-9-10 21:41:17 | 显示全部楼层 |阅读模式
  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
  2. <% Response.CodePage=65001%>
  3. <% Response.Charset="UTF-8" %>
  4. <%
  5. '该程序通过使用ASP的FSO功能,减少数据库的读取。经测试,可以减少90%的服务器负荷。页面访问速度基本与静态页面相当。
  6. '使用方法:将该文件放在网站里,然后在需要引用的文件的“第一行”用include引用即可。
  7. '=======================参数区=============================
  8. DirName="cachenew" '静态文件保存的目录,结尾应带""。无须手动建立,程序会自动建立。
  9. TimeDelay=30 '更新的时间间隔,单位为分钟,如1440分钟为1天。生成的静态文件在该间隔之后会被删除。
  10. '======================主程序区============================
  11. foxrax=Request("foxrax")
  12. if foxrax="" then
  13. FileName=GetStr()&".txt"
  14. FileName=DirName&FileName
  15. if tesfold(DirName)=false then'如果不存在文件夹则创建
  16. createfold(Server.MapPath(".")&""&DirName)
  17. end if
  18. if ReportFileStatus(Server.MapPath(".")&""&FileName)=true then'如果存在生成的静态文件,则直接读取文件
  19. Set FSO=CreateObject("Scripting.FileSystemObject")
  20. Dim Files,LatCatch
  21. Set Files=FSO.GetFile(Server.MapPath(FileName)) '定义CatchFile文件对象
  22. LastCatch=CDate(Files.DateLastModified)
  23. If DateDiff("n",LastCatch,Now())>TimeDelay Then'超过
  24. List=getHTTPPage(GetUrl())
  25. WriteFile(FileName)
  26. Else
  27. List=ReadFile(FileName)
  28. End If
  29. Set FSO = nothing
  30. Response.Write(List)
  31. Response.End()
  32. else
  33. List=getHTTPPage(GetUrl())
  34. WriteFile(FileName)
  35. end if

  36. end if

  37. '========================函数区============================
  38. '获取当前页面url
  39. Function GetStr()
  40. 'On Error Resume Next
  41. Dim strTemps
  42. strTemps = strTemps & Request.ServerVariables("HTTP_X_REWRITE_URL")
  43. GetStr = Server.URLEncode(strTemps)
  44. End Function
  45. '获取缓存页面url
  46. Function GetUrl()
  47. On Error Resume Next
  48. Dim strTemp
  49. If LCase(Request.ServerVariables("HTTPS")) = "off" Then
  50. strTemp = "http://"
  51. Else
  52. strTemp = "https://"
  53. End If
  54. strTemp = strTemp & Request.ServerVariables("SERVER_NAME")
  55. If Request.ServerVariables("SERVER_PORT") <> 80 Then
  56. strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT")
  57. end if
  58. strTemp = strTemp & Request.ServerVariables("URL")
  59. If Trim(Request.QueryString) <> "" Then
  60. strTemp = strTemp & "?" & Trim(Request.QueryString) & "&foxrax=foxrax"
  61. else
  62. strTemp = strTemp & "?" & "foxrax=foxrax"
  63. end if
  64. GetUrl = strTemp
  65. End Function

  66. '抓取页面
  67. Function getHTTPPage(url)
  68. Set Mail1 = Server.CreateObject("CDO.Message")
  69. Mail1.CreateMHTMLBody URL,31
  70. AA=Mail1.HTMLBody
  71. Set Mail1 = Nothing
  72. getHTTPPage=AA
  73. 'Set Retrieval = Server.CreateObject("Microsoft.Xmlhttp")
  74. 'Retrieval.Open "GET",url,false,"",""
  75. 'Retrieval.Send
  76. 'getHTTPPage = Retrieval.ResponseBody
  77. 'Set Retrieval = Nothing
  78. End Function
  79. Sub WriteFile(filePath)
  80. dim stm
  81. set stm=Server.CreateObject("adodb.stream")
  82. stm.Type=2 'adTypeText,文本数据
  83. stm.Mode=3 'adModeReadWrite,读取写入,此参数用2则报错
  84. stm.Charset="utf-8"
  85. stm.Open
  86. stm.WriteText list
  87. stm.SaveToFile Server.MapPath(filePath),2 'adSaveCreateOverWrite,文件存在则覆盖
  88. stm.Flush
  89. stm.Close
  90. set stm=nothing
  91. End Sub

  92. Function ReadFile(filePath)
  93. dim stm
  94. set stm=Server.CreateObject("adodb.stream")
  95. stm.Type=1 'adTypeBinary,按二进制数据读入
  96. stm.Mode=3 'adModeReadWrite ,这里只能用3用其他会出错
  97. stm.Open
  98. stm.LoadFromFile Server.MapPath(filePath)
  99. stm.Position=0 '把指针移回起点
  100. stm.Type=2 '文本数据
  101. stm.Charset="utf-8"
  102. ReadFile = stm.ReadText
  103. stm.Close
  104. set stm=nothing
  105. End Function
  106. '检测文件是否存在
  107. Function ReportFileStatus(FileName)
  108. set fso = server.createobject("scripting.filesystemobject")
  109. if fso.fileexists(FileName) = true then
  110. ReportFileStatus=true
  111. else
  112. ReportFileStatus=false
  113. end if
  114. set fso=nothing
  115. end function
  116. '检测目录是否存在
  117. function tesfold(foname)
  118. set fs=createobject("scripting.filesystemobject")
  119. filepathjm=server.mappath(foname)
  120. if fs.folderexists(filepathjm) then
  121. tesfold=True
  122. else
  123. tesfold= False
  124. end if
  125. set fs=nothing
  126. end function
  127. '建立目录
  128. sub createfold(foname)
  129. set fs=createobject("scripting.filesystemobject")
  130. fs.createfolder(foname)
  131. set fs=nothing
  132. end sub
  133. '删除文件
  134. function del_file(path) 'path,文件路径包含文件名
  135. set objfso = server.createobject("scripting.FileSystemObject")
  136. 'path=Server.MapPath(path)
  137. if objfso.FileExists(path) then '若存在则删除
  138. objfso.DeleteFile(path) '删除文件
  139. else
  140. 'response.write "<script language='Javascript'>alert('文件不存在')</script>"
  141. end if
  142. set objfso = nothing
  143. end function
  144. %>
复制代码



上一篇:查看ASP详细错误提示信息的图文设置方法
下一篇:asp中通过addnew添加内容后取得当前文章的自递增ID的方法
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

1314学习网 ( 浙ICP备10214163号 )

GMT+8, 2025-5-2 07:03

Powered by Discuz! X3.4

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表