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,"0/'>http://")>0 OR Instr(RetStr,"0/'>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%>