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
%>