当前页面位置: » 丰搜网 » 文档中心 » 详细内容
网站图片扫描类
scan.inc
<%
'说明：这是我第一次编写应用类，其中不当之处请多多指教！qq：1168064
'属性和方法
'1、scantype：扫描的类型。默认值：1。值：0 扫描文件和数据库 1 扫描文件 2 扫描数据库。
'2、conn,table,colimg,colid：当扫描数据库时用到，分别为连接字符串、表名、图片列名、图片对应的id列名
'3、list：显示类型。默认值：0。值：0 失效图片 1 网络图片 2 有效图片 3 所有
'4、scantext：扫描的图片类型。默认值：asp/html/htm。值：文件扩展名，中间用"/"分隔。
'5、path：扫描的路径：默认为网站根目录，请使用相对路径。例如"/dsj"
'6、scan()：方法。根据设置进行扫描
'7、file：保存扫描的所以信息。在scan()方法后调用
'8、folders：扫描的文件夹个数
'9、files：扫描的文件数。
'10、totalsize：目录的总计大小。自动显示g，m，b。
'11、images：扫描文件中的图片个数
'12、exists：失效个数
'13、dbimg：数据库中图片个数
'14、totalimg：扫描的所以图片个数
'15、runtime：扫描过程的时间。单位毫秒
'16、关于file的使用：
' for each fn in objname.file …… next
' fn.filename：图片名称，包含路径
' fn.belong：图片所在文件或数据库（文件用""分开）
' fn.exists：是否有效。0为失效 1 为有效 -1为非本地路径，不能判断。
option explicit
class mcscanimg
dim file,scantype,conn,table,colid,colimg,fso,path,list,scantext,spath,version
dim folders,files,totalsize,images,exists,sfiles,start,endt,runtime,dbimg,totalimg,filter
private sub class_initialize
set file = server.createobject("scripting.dictionary")
set fso = createobject("scripting.filesystemobject")
scantype=1
conn=""
table=""
colimg=""
colid=""
path ="/"
spath = server.mappath("/")
list=0
scantext="asp/htm/html"
folders=0
files=0
totalsize=0
images=0
dbimg=0
exists=0
sfiles=0
totalimg=0
start=timer
endt=timer
runtime=0
filter="src=(.[^\>^\&]*)(.gif.jpg)"
version="1.00"
end sub
private sub class_terminate
set file=nothing
set fso = nothing
end sub
public function scan() '开始扫描
if left(path,1)="/" then
path=spath&replace(path,"/","\")
else
path=spath&"\"&replace(path,"/","\")
end if
if scantype=1 then
scanfile(path)
elseif scantype=2 then
scandb()
else
scanfile(path)
scandb()
end if
endt=timer
runtime=formatnumber(endt-start)*1000
totalsize=shb(totalsize)
totalimg=dbimg+images
end function
private sub scandb() '扫描数据库。这里的路径难于判断，请在insdb中更改(if addnum=0 后)
dim rs,retstr,rebel,sql
sql="select "&colid&","&colimg&" from "&table&" order by "&colid&" desc"
'on error resume next
if conn ="" or table="" or colid="" or colimg = "" then
exit sub
else
set rs = server.createobject("adodb.recordset")
rs.open sql,conn,3,3
while not rs.eof
retstr=rs(1)
rebel="表"&table&"中的"&colimg&"列(id:"&rs(0)&")"
insdb retstr,rebel,0,""
rs.movenext
wend
rs.close
set rs=nothing
end if
end sub
private sub scanfile(pathstr) '扫描文件。递归
dim f,ff,fn,fd,fdn,realpath,fr,fc
'response.write pathstr&"<br>"
set ff = fso.getfolder(pathstr)
set f = ff.files
set fd = ff.subfolders
if f.count >0 then
for each fn in f
files=files+1
totalsize=totalsize+fn.size
if chkfilename(fn.name) then
sfiles=sfiles+1
if right(pathstr,1) <> "\" then
realpath=pathstr&"\"&fn.name
else
realpath=pathstr&fn.name
end if
set fr = fso.opentextfile(realpath,1)
fc=fr.readall
'response.write realpath&"<br>"
regexptest filter,fc,realpath
end if
next
end if
if fd.count> 0 then
for each fdn in fd
folders=folders+1
dim temp
if right (pathstr,1) <> "\" then
temp=pathstr&"\"&fdn.name
else
temp=pathstr&fdn.name
end if
scanfile(temp)
next
end if
end sub
private sub regexptest(patrn, strng,pathstr) '查找图片
dim regex, match, matches,chk,reimg,retstr,rebel,thefile
set regex = new regexp
regex.pattern = patrn
regex.ignorecase = true
regex.global = true
set matches = regex.execute(strng)
for each match in matches
retstr = replace(match.value,"src=","")
retstr = replace(retstr,"'","")
retstr = replace(retstr,"""","")
chk = 0
rebel=getfn(pathstr)
insdb retstr,rebel,1,pathstr
next
end sub
private function getext(fullpath) '获得文件扩展名，用于判断是否是扫描的文件类型
dim temp
if fullpath <> "" then
temp = mid(fullpath,instrrev(fullpath, "\")+1)
if instr(temp,".")>0 then
getext=mid(temp,instrrev(temp, ".")+1)
else
getext=temp
end if
else
getext = ""
end if
end function
private function chkfilename(str) '检测文件是否是要扫描的文件类型
dim ar,i,fn
fn=getext(str)
ar=split(scantext,"/")
chkfilename=false
for i=0 to ubound(ar)
if lcase(fn) =lcase(trim(ar(i))) then
chkfilename=true
exit function
end if
next
end function
private function shb(n) '显示字节数
if n<1024 then
shb = n&"字节"
elseif n>1024 and n<1024*1024 then
shb = formatnumber(n/1024,2)&"k"
elseif n>=1024*1024 and n <1024*1024*1024 then
shb = formatnumber(n/(1024*1024),2)&"m"
else
shb =formatnumber(n/(1024*1024*1024),2)&"g"
end if
end function
private sub insdb(retstr,rebel,addnum,pathstr) '分析图片是否有效，并添加到字典对象中
dim chk,reimg,thefile
if instr(retstr,"http://")>0 or instr(retstr,"ftp://")>0 then
reimg=retstr
chk=-1
else
retstr = replace(retstr,"/","\")
if (left(retstr,1) = "\" ) then
retstr=spath&retstr
elseif left(retstr,3) = "..\" then
dim temp
temp=getpath(pathstr)
do until left(retstr,3) <> "..\" '处理相对路径
temp=fso.getparentfoldername(temp)
retstr=mid(retstr,4,len(retstr)-3)
loop
retstr=temp&"\"&retstr
else
if addnum=0 then
if left(retstr,1)="\" then
retstr=path&"\"&retstr
else
retstr=path&retstr
end if
else
retstr=getpath(pathstr)&retstr
end if
end if
if fso.fileexists(retstr) then
chk=1
end if
reimg=getfn(retstr)
end if
if chk=0 then
exists=exists+1
end if
if file.exists(reimg) then
set thefile=file.item(reimg)
if thefile.belong <> rebel then
thefile.belong=thefile.belong&""&rebel
end if
else
if (list=0 and chk =0) or (list=1 and chk=-1) or (list=2 and chk=1 ) or list=3 then
set thefile= new fileinfo
thefile.filename=reimg
thefile.belong=rebel
thefile.exists=chk
file.add reimg,thefile
select case scantype
case 1 images=images+1
case 2 dbimg = dbimg+1
case else
if addnum = 0 then
dbimg = dbimg+1
else
images=images+1
end if
end select
end if
end if
end sub
private function getpath(str) '获得文件路径
'response.write str&"<br>"
dim temp,endb
temp=replace(str,"/","\")
endb=instrrev(temp,"\")
if endb = 0 then
getpath=spath
else
getpath=left(temp,endb)
end if
'response.write getpath&"<br>"
end function
private function getfn(str) '获得文件的相对路径名
dim temp
temp=str
'response.write temp&"<br>"
temp=replace(str,spath,"")
temp=replace(temp,"\","/")
getfn=temp
end function
end class
class fileinfo
dim filename,belong,exists
private sub class_initialize
filename=""
belong=""
exists=""
end sub
end class
%>
应用举例
<%@language="vbscript" codepage="936"%>
<!doctype html public "-//w3c//dtd html 4.01 transitional//en" "http://www.w3.org/tr/html4/loose.dtd">
<%
%>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=gb2312">
<title>无标题文档</title>
<link rel="stylesheet" href="css.css">
</head>
<body>
<form name="form1" method="post" action="scan.asp">
<table width="60%" border="0" align="center" cellspacing="1" bgcolor="#003366">
<tr bgcolor="#ffffff">
<td height="30" colspan="2" bgcolor="#00ccff"><div align="center">扫描图片</div></td>
</tr>
<tr bgcolor="#ffffff">
<td width="26%" height="20"><div align="right">扫描文件夹：</div></td>
<td width="74%" height="20"><select name="path" id="path">
<option value="/">/</option>
<%
dim fso,f,fd,p
p=server.mappath("/")
set fso=server.createobject("scripting.filesystemobject")
function showpath(str)
set f=fso.getfolder(str)
set fd=f.subfolders
for each fds in fd
response.write "<option value="&replace(replace(fds,p,""),"\","/")&">"&replace(replace(fds,p,""),"\","/")&"</option>"
set ff=fso.getfolder(fds)
set ffd=ff.subfolders
if ffd.count>0 then
showpath(fds)
end if
next
end function
showpath(p)%>
</select></td>
</tr>
<tr bgcolor="#ffffff">
<td height="20"><div align="right">扫描类型：</div></td>
<td height="20"><input type="radio" name="stype" value="0">
所有
<input name="stype" type="radio" value="1" checked>
扫描文件
<input type="radio" name="stype" value="2">
扫描数据库</td>
</tr>
<tr bgcolor="#ffffff">
<td height="20"><div align="right">显示类型：</div></td>
<td height="20"><input name="ltype" type="radio" value="0" checked>
失效
<input type="radio" name="ltype" value="1">
网络路径
<input type="radio" name="ltype" value="2">
有效
<input type="radio" name="ltype" value="3">
所有</td>
</tr>
<tr bgcolor="#ffffff">
<td height="20"><div align="right">文件类型：</div></td>
<td height="20"><input name="ext" type="checkbox" id="ext" value="asp" checked>
asp
<input name="ext" type="checkbox" id="ext" value="htm" checked>
htm
<input name="ext" type="checkbox" id="ext" value="html" checked>
html
<input name="ext" type="checkbox" id="ext" value="inc" checked>
inc</td>
</tr>
<tr bgcolor="#ffffff">
<td height="20"><div align="right">数据库：</div></td>
<td height="20">表：
<input name="tab" type="text" id="tab" size="5" class="allinput">
图片id列：
<input name="colid" type="text" id="colid" size="5" class="allinput">
图片路径列：
<input name="colimg" type="text" id="colimg" size="5" class="allinput"> </td>
</tr>
<tr bgcolor="#ffffff">
<td height="40" colspan="2"><div align="center">
<input type="submit" value=" 开始扫描 " class="allinput">
</div></td>
</tr>
</table>
</form>
</body>
</html>
scan.asp
<!--#include file="scan.inc"-->
<%
dim mcs,fn,fb
%>
<link href="css.css" rel="stylesheet">
<table width="70%" border="0" align="center" cellpadding="5" cellspacing="1" bgcolor="#003366">
<tr bgcolor="#aaaaff">
<td width="30%" height="30">图片名称</td>
<td width="39%" height="30">所在位置</td>
<td width="31%" height="30">有效</td>
</tr>
<%
function getvar(id,default)
getvar = default
if request(id) <> "" then
getvar = request(id)
end if
end function
dim stype,ltype,path,ext,conn,tab,colid,colimg
stype=getvar("stype",1)
ltype=getvar("ltype",3)
path=getvar("path","/")
ext = trim(replace(getvar("ext","htm,html,asp,inc"),", ","/"))
conn=getvar("conn","")
tab=getvar("tab","")
colid=getvar("colid","")
colimg=getvar("colimg","")
conn="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("/db1.mdb")
set mcs= new mcscanimg
mcs.scantype=stype
mcs.list=ltype
mcs.scantext=ext
mcs.conn=conn
mcs.path=path
mcs.table=tab
mcs.colid=colid
mcs.colimg=colimg
mcs.scan()
for each fn in mcs.file
set fb=mcs.file(fn)
%>
<tr bgcolor="#ffffff">
<td valign="top"><%=fb.filename%></td>
<td><%=replace(fb.belong,"","<br>")%></td>
<td><%
if fb.exists=1 then
response.write "有效的路径"
elseif fb.exists=0 then
response.write "失效的路径"
else
response.write "非本地路径"
end if
%></td>
</tr>
<%
next
%>
<tr bgcolor="#ffffff">
<td colspan="3">共扫描文件：<%=mcs.files%>；扫描文件夹：<%=mcs.folders%>；总计大小：<%=mcs.totalsize%><br>扫描图片个数：<%=mcs.images&"；数据库图片个数："&mcs.dbimg&"；图片总数："&mcs.totalimg%>；失效个数：<%=mcs.exists%>个<br>运行时间：<%=mcs.runtime%>毫秒</td>
</tr>
</table>
<%set mcs=nothing%>
