asp磁盘缓存技术使用的代码
这一种方法适合,访问相对集中在同样内容页面的网站,会自动生成缓存文件(相当于读取静态页面,但会增大文件)。如果访问不集中会造成服务器同时读取文件当机。
注意:系统需要fso权限、xmlhttp权限
系统包括两个文件,其实可以合并为一个。之所以分为两个是因为部分杀毒软件会因为里边含有fso、xmlhttp操作而被认为是脚本木马。
调用时,需要在asp页面的最上边包含主文件,然后在下边写下以下代码
<% set mycatch=new catchfile mycatch.overdue=60*5 '修改过期时间设置为5个小时 if mycatch.catchnow(rev) then response.write mycatch.catchdata response.end end if set mycatch=nothing %>
主包含文件:filecatch.asp
<!--#include file="filecatch-inc.asp"-->
<%
'---- 本文件用于签入原始文件,实现对页面的文件catch
'---- 1、如果文件请求为post方式,则取消此功能
'---- 2、文件的请求不能包含系统的识别关键字
'---- 3、作者 何直群 (www.wozhai.com)
class catchfile
public overdue,mark,cfolder,cfile '定义系统参数
private scriptname,scriptpath,serverhost '定义服务器/页面参数变量
public catchdata '输出的数据
private sub class_initialize '初始化函数
'获得服务器及脚本数据
scriptname=request.servervariables("script_name") '识别出当前脚本的虚拟地址
scriptpath=getscriptpath(false) '识别出脚本的完整get地址
serverhost=request.servervariables("server_name") '识别出当前服务器的地址
'初始化系统参数
overdue=30 '默认30分钟过期
mark="nocatch" '无catch请求参数为 nocatch
cfolder=getcfolder '定义默认的catch文件保存目录
cfile=server.urlencode(scriptpath)&".txt" '将脚本路径转化为文件路径
catchdata=""
end sub
private function getcfolder
dim fso,cfolder
set fso=createobject("scripting.filesystemobject") '设置fso对象
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) '转换编码的函数
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) '用户指定开始处理catch操作
if ucase(request.servervariables("request_method"))="post" then
'当是post方法,不可使用文件catch
rev="使用post方法请求页面,不可以使用文件catch功能"
catchnow=false
else
if request.querystring(mark)<>"" then
'如果指定参数不为空,表示请求不可以使用catch
rev="请求拒绝使用catch功能"
catchnow=false
else
catchnow=getcatchdata(rev)
end if
end if
end function
private function getcatchdata(rev) '读取catch数据
dim fso,isbuildcatch
set fso=createobject("scripting.filesystemobject") '设置fso对象,访问catchfile
if fso.fileexists(cfolder&cfile) then
dim file,lastcatch
set file=fso.getfile(cfolder&cfile) '定义catchfile文件对象
lastcatch=cdate(file.datelastmodified)
if datediff("n",lastcatch,now())>overdue then
'如果超过了catch时间
isbuildcatch=true
else
isbuildcatch=false
end if
set file=nothing
else
isbuildcatch=true
end if
if isbuildcatch then
getcatchdata=buildcatch(rev) '如果需要创建catch,则创建catch文件,同时设置catch的数据
else
getcatchdata=readcatch(rev) '如果不需要创建catch,则直接读取catch数据
end if
set fso=nothing
end function
private function getscriptpath(isget) '创建一个包含所有请求数据的地址
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
'创建catch文件
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="创建发生错误:"&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") '设置fso对象,访问catchfile
set tso=fso.createtextfile(cfolder&cfile,true)
tso.write(catchdata)
set tso=nothing
set fso=nothing
end sub
end class
%>
文件二:filecatch-inc.asp
<%
function ireadcatch(file,data,rev)
dim fso,tso
set fso=createobject("scripting.filesystemobject") '设置fso对象,访问catchfile
' on error resume next
set tso=fso.opentextfile(file,1,false)
data=tso.readall
if err.number<>0 then
rev="读取发生错误:"&err.description
readcatch=false
err.clear
else
ireadcatch=true
end if
set tso=nothing
set fso=nothing
end function
%>
asp硬盘缓存代码2
<%@language="vbscript" codepage="65001"%> <% response.codepage=65001%> <% response.charset="utf-8" %> <% '该程序通过使用asp的fso功能,减少数据库的读取。经测试,可以减少90%的服务器负荷。页面访问速度基本与静态页面相当。 '使用方法:将该文件放在网站里,然后在需要引用的文件的“第一行”用include引用即可。 '=======================参数区============================= dirname="cachenew\" '静态文件保存的目录,结尾应带"\"。无须手动建立,程序会自动建立。 'timedelay=10 '更新的时间间隔,单位为分钟,如1440分钟为1天。生成的静态文件在该间隔之后会被删除。 timedelay=300 '======================主程序区============================ foxrax=request("foxrax") if foxrax="" then filename=server.urlencode(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("url") if trim(request.querystring) <> "" then strtemps = strtemps & "?" & trim(request.querystring) else strtemps = strtemps end if getstr = strtemps end function '获取缓存页面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 '抓取页面 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) on error resume next 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 '读取文件 'public function readfile( xvar ) 'xvar = server.mappath(xvar) 'set sys = server.createobject("scripting.filesystemobject") 'if sys.fileexists( xvar ) then 'set txt = sys.opentextfile( xvar, 1,false) 'msg = txt.readall 'txt.close 'response.write("yes") 'else 'msg = "no" 'end if 'set sys = nothing 'readfile = msg '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 "<script language='javascript'>alert('文件不存在')</script>" end if set objfso = nothing end function %>