网站图片扫描类

Scan.inc

  1   
  2'说明:这是我第一次编写应用类,其中不当之处请多多指教!QQ:1168064   
  3'属性和方法   
  4'1、ScanType:扫描的类型。默认值:1。值:0 扫描文件和数据库 1 扫描文件 2 扫描数据库。   
  5'2、Conn,Table,ColImg,ColID:当扫描数据库时用到,分别为连接字符串、表名、图片列名、图片对应的ID列名   
  6'3、List:显示类型。默认值:0。值:0 失效图片 1 网络图片 2 有效图片 3 所有   
  7'4、ScanText:扫描的图片类型。默认值:Asp/html/htm。值:文件扩展名,中间用"/"分隔。   
  8'5、Path:扫描的路径:默认为网站根目录,请使用相对路径。例如"/dsj"   
  9'6、Scan():方法。根据设置进行扫描   
 10'7、File:保存扫描的所以信息。在Scan()方法后调用   
 11'8、Folders:扫描的文件夹个数   
 12'9、Files:扫描的文件数。   
 13'10、TotalSize:目录的总计大小。自动显示G,M,B。   
 14'11、Images:扫描文件中的图片个数   
 15'12、Exists:失效个数   
 16'13、DbImg:数据库中图片个数   
 17'14、TotalImg:扫描的所以图片个数   
 18'15、RunTime:扫描过程的时间。单位毫秒   
 19'16、关于File的使用:   
 20' For Each Fn In ObjName.file …… Next   
 21' Fn.FileName:图片名称,包含路径   
 22' Fn.Belong:图片所在文件或数据库(文件用"|"分开)   
 23' Fn.Exists:是否有效。0为失效 1 为有效 -1为非本地路径,不能判断。   
 24Option Explicit   
 25Class MCScanImg   
 26dim File,ScanType,Conn,Table,ColId,ColImg,FSO,Path,List,ScanText,Spath,Version   
 27dim Folders,Files,TotalSize,Images,Exists,sFiles,Start,EndT,RunTime,DbImg,TotalImg,Filter   
 28Private Sub Class_Initialize   
 29Set File = Server.Createobject("Scripting.Dictionary")   
 30Set FSO = CreateObject("Scripting.FileSystemObject")   
 31ScanType=1   
 32Conn=""   
 33Table=""   
 34ColImg=""   
 35ColId=""   
 36Path ="/"   
 37sPath = Server.MapPath("/")   
 38List=0   
 39ScanText="asp/htm/html"   
 40Folders=0   
 41Files=0   
 42TotalSize=0   
 43Images=0   
 44DbImg=0   
 45Exists=0   
 46sFiles=0   
 47TotalImg=0   
 48Start=Timer   
 49Endt=Timer   
 50Runtime=0   
 51Filter="src=(.[^\>^\&]*)(.gif|.jpg)"   
 52Version="1.00"   
 53End Sub 
 54
 55Private Sub Class_Terminate   
 56Set File=Nothing   
 57Set FSO = Nothing   
 58End Sub 
 59
 60Public Function Scan() '开始扫描   
 61if left(path,1)="/" then   
 62path=Spath&Replace(path,"/","\")   
 63else   
 64Path=Spath&"\"&Replace(path,"/","\")   
 65end if   
 66If ScanType=1 then   
 67Scanfile(Path)   
 68ElseIf ScanType=2 Then   
 69ScanDb()   
 70Else   
 71ScanFile(Path)   
 72ScanDb()   
 73End If   
 74EndT=timer   
 75RunTime=FormatNumber(EndT-Start)*1000   
 76TotalSize=shb(TotalSize)   
 77TotalImg=DbImg+Images   
 78End Function 
 79
 80Private Sub ScanDB() '扫描数据库。这里的路径难于判断,请在InsDb中更改(If AddNum=0 后)   
 81Dim Rs,RetStr,ReBel,SQL   
 82SQL="Select "&ColID&","&ColIMG&" From "&Table&" Order by "&ColID&" DESC"   
 83'On Error Resume Next   
 84If Conn ="" OR Table="" OR ColID="" OR ColIMG = "" Then   
 85Exit Sub   
 86Else   
 87Set Rs = Server.CreateObject("ADODB.RecordSet")   
 88Rs.Open SQL,conn,3,3 
 89
 90While Not Rs.EOF   
 91RetStr=Rs(1)   
 92ReBel="表"&Table&"中的"&ColImg&"列(ID:"&Rs(0)&")"   
 93InsDb RetStr,ReBel,0,""   
 94Rs.MoveNext   
 95Wend   
 96Rs.Close   
 97Set Rs=Nothing   
 98End If   
 99End Sub 
100
101Private Sub ScanFile(PathStr) '扫描文件。递归   
102Dim f,ff,fn,fd,fdn,RealPath,fr,fc   
103'Response.write PathStr&"

<br/>

 1"   
 2Set ff = fso.getfolder(pathstr)   
 3Set f = ff.files   
 4Set fd = ff.subfolders   
 5If f.Count >0 Then   
 6For Each fn In f   
 7Files=Files+1   
 8TotalSize=TotalSize+fn.Size   
 9If ChkFileName(fn.Name) Then   
10sFiles=sFiles+1   
11If Right(PathStr,1) <> "\" Then   
12RealPath=PathStr&"\"&fn.Name   
13Else   
14RealPath=PathStr&fn.Name   
15End If   
16Set fr = FSO.OpenTextFile(RealPath,1)   
17fc=fr.ReadAll   
18'response.write RealPath&"

<br/>

  1"   
  2RegExpTest filter,fc,RealPath   
  3End If   
  4Next   
  5End If 
  6
  7If fd.Count> 0 Then   
  8For Each fdn In fd   
  9Folders=Folders+1   
 10dim temp   
 11if right (PathStr,1) <> "\" then   
 12temp=PathStr&"\"&fdn.Name   
 13else   
 14temp=PathStr&fdn.Name   
 15end if   
 16ScanFile(temp)   
 17Next   
 18End If   
 19End Sub 
 20
 21Private Sub RegExpTest(Patrn, Strng,PathStr) '查找图片   
 22Dim RegEx, Match, Matches,Chk,ReImg,RetStr,ReBel,TheFile   
 23Set RegEx = New RegExp   
 24RegEx.Pattern = Patrn   
 25RegEx.IgnoreCase = True   
 26RegEx.Global = True   
 27Set Matches = RegEx.Execute(Strng)   
 28For Each Match in Matches   
 29RetStr = Replace(Match.Value,"src=","")   
 30RetStr = Replace(RetStr,"'","")   
 31RetStr = Replace(RetStr,"""","")   
 32Chk = 0   
 33  
 34ReBel=GetFn(PathStr)   
 35InsDb RetStr,ReBel,1,PathStr   
 36Next   
 37End Sub 
 38
 39Private Function GetExt(FullPath) '获得文件扩展名,用于判断是否是扫描的文件类型   
 40Dim Temp   
 41If FullPath <> "" Then   
 42Temp = Mid(FullPath,InStrRev(FullPath, "\")+1)   
 43If InStr(Temp,".")>0 Then   
 44GetExt=Mid(Temp,InStrRev(Temp, ".")+1)   
 45Else   
 46GetExt=Temp   
 47End If   
 48Else   
 49GetExt = ""   
 50End If   
 51End Function 
 52
 53Private Function ChkFileName(Str) '检测文件是否是要扫描的文件类型   
 54Dim ar,i,fn   
 55fn=GetExt(str)   
 56ar=Split(ScanText,"/")   
 57ChkFileName=False   
 58For i=0 To ubound(ar)   
 59If lCase(fn) =lCase(Trim(ar(i))) Then   
 60ChkFileName=True   
 61Exit Function   
 62End If   
 63Next   
 64End Function 
 65
 66Private Function shb(n) '显示字节数   
 67If n<1024 Then   
 68shb = n&"字节"   
 69ElseIf n>1024 and n<1024*1024 Then   
 70shb = formatnumber(n/1024,2)&"K"   
 71ElseIf n>=1024*1024 and n <1024*1024*1024 Then   
 72shb = formatnumber(n/(1024*1024),2)&"M"   
 73Else   
 74shb =formatnumber(n/(1024*1024*1024),2)&"G"   
 75End If   
 76End Function 
 77
 78Private Sub InsDb(RetStr,ReBel,AddNum,PathStr) '分析图片是否有效,并添加到字典对象中   
 79dim chk,ReImg,TheFile   
 80If InStr(RetStr," http://")>0 OR Instr(RetStr," ftp://")>0 Then   
 81ReImg=RetStr   
 82Chk=-1   
 83Else   
 84RetStr = Replace(RetStr,"/","\")   
 85If (Left(RetStr,1) = "\" ) Then   
 86RetStr=SPath&Retstr   
 87ElseIf Left(RetStr,3) = "..\" Then   
 88dim temp   
 89temp=GetPath(PathStr)   
 90Do Until Left(RetStr,3) <> "..\" '处理相对路径   
 91Temp=Fso.GetParentFolderName(Temp)   
 92RetStr=Mid(RetStr,4,len(RetStr)-3)   
 93Loop   
 94RetStr=Temp&"\"&RetStr   
 95Else   
 96If AddNum=0 Then   
 97if left(RetStr,1)="\" then   
 98RetStr=Path&"\"&Retstr   
 99Else   
100RetStr=path&Retstr   
101End If   
102else   
103RetStr=getpath(Pathstr)&RetStr   
104End IF   
105End If 
106
107If FSO.FileExists(RetStr) Then   
108Chk=1   
109End If   
110ReImg=GetFn(RetStr)   
111End If   
112If Chk=0 Then   
113Exists=Exists+1   
114End if   
115If File.Exists(ReImg) then   
116Set TheFile=File.Item(ReImg)   
117If TheFile.Belong <> ReBel Then   
118TheFile.Belong=TheFile.Belong&"|"&Rebel   
119End If   
120Else   
121If (List=0 AND Chk =0) OR (List=1 And Chk=-1) Or (List=2 And Chk=1 ) Or List=3 Then   
122Set TheFile= New FileInfo   
123TheFile.FileName=ReImg   
124TheFile.Belong=ReBel   
125TheFile.Exists=Chk   
126File.Add ReImg,TheFile   
127Select Case ScanType   
128Case 1 Images=Images+1   
129Case 2 DbImg = DbImg+1   
130Case Else   
131If AddNum = 0 Then   
132DbImg = DbImg+1   
133Else   
134Images=Images+1   
135End If   
136End Select   
137End If   
138End If   
139End Sub 
140
141Private Function GetPath(Str) '获得文件路径   
142'response.write str&"

<br/>

 1"   
 2Dim Temp,EndB   
 3Temp=Replace(Str,"/","\")   
 4EndB=InstrRev(Temp,"\")   
 5If EndB = 0 Then   
 6GetPath=SPath   
 7Else   
 8GetPath=Left(Temp,EndB)   
 9End If   
10'response.write GetPath&"

<br/>

1"   
2End Function 
3
4Private Function GetFn(Str) '获得文件的相对路径名   
5Dim Temp   
6Temp=Str   
7'response.write temp&"

<br/>

 1"   
 2Temp=Replace(Str,SPath,"")   
 3Temp=Replace(Temp,"\","/")   
 4GetFn=Temp   
 5End Function 
 6
 7End Class 
 8
 9Class FileInfo 
10
11Dim FileName,Belong,Exists 
12
13Private Sub Class_Initialize   
14FileName=""   
15Belong=""   
16Exists=""   
17End sub 
18
19End Class   

应用举例
< %@LANGUAGE="VBSCRIPT " CODEPAGE="936"%>

1   
2  
 1<html>
 2<head>
 3<meta content="text/html; charset=utf-8" http-equiv="Content-Type"/>
 4<title>无标题文档</title>
 5<link href="css.css" rel="stylesheet"/>
 6</head>
 7<body>
 8<form action="scan.asp" method="post" name="form1">
 9<table align="center" bgcolor="#003366" border="0" cellspacing="1" width="60%">
10<tr bgcolor="#FFFFFF">
11<td bgcolor="#00CCFF" colspan="2" height="30"><div align="center">扫描图片</div></td>
12</tr>
13<tr bgcolor="#FFFFFF">
14<td height="20" width="26%"><div align="right">扫描文件夹:</div></td>
15<td height="20" width="74%"><select id="Path" name="Path">
16<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="&amp;Replace(Replace(fds,p,">"&amp;Replace(Replace(fds,p,""),"","/")&amp;"</option>"
set ff=fso.getfolder(fds)
set ffd=ff.subfolders
if ffd.count&gt;0 then
showpath(fds)
end if
next
end function
showpath(p)

 1</select></td>
 2</tr>
 3<tr bgcolor="#FFFFFF">
 4<td height="20"><div align="right">扫描类型:</div></td>
 5<td height="20"><input name="SType" type="radio" value="0"/>   
 6所有   
 7<input checked="" name="SType" type="radio" value="1"/>   
 8扫描文件   
 9<input name="SType" type="radio" value="2"/>   
10扫描数据库</td>
11</tr>
12<tr bgcolor="#FFFFFF">
13<td height="20"><div align="right">显示类型:</div></td>
14<td height="20"><input checked="" name="LType" type="radio" value="0"/>   
15失效   
16<input name="LType" type="radio" value="1"/>   
17网络路径   
18<input name="LType" type="radio" value="2"/>   
19有效   
20<input name="LType" type="radio" value="3"/>   
21所有</td>
22</tr>
23<tr bgcolor="#FFFFFF">
24<td height="20"><div align="right">文件类型:</div></td>
25<td height="20"><input checked="" id="Ext" name="Ext" type="checkbox" value="asp"/>   
26Asp   
27<input checked="" id="Ext" name="Ext" type="checkbox" value="htm"/>   
28Htm   
29<input checked="" id="Ext" name="Ext" type="checkbox" value="html"/>   
30Html   
31<input checked="" id="Ext" name="Ext" type="checkbox" value="inc"/>   
32Inc</td>
33</tr>
34<tr bgcolor="#FFFFFF">
35<td height="20"><div align="right">数据库:</div></td>
36<td height="20">表:   
37<input class="allinput" id="Tab" name="Tab" size="5" type="text"/>   
38图片ID列:   
39<input class="allinput" id="ColID" name="ColID" size="5" type="text"/>   
40图片路径列:   
41<input class="allinput" id="ColImg" name="ColImg" size="5" type="text"/> </td>
42</tr>
43<tr bgcolor="#FFFFFF">
44<td colspan="2" height="40"><div align="center">
45<input class="allinput" type="submit" value=" 开始扫描 "/>
46</div></td>
47</tr>
48</table>
49</form>
50</body>
51</html>

scan.asp

1   
2dim mcs,fn,fb   
1<link href="css.css" rel="stylesheet"/>
1<table align="center" bgcolor="#003366" border="0" cellpadding="5" cellspacing="1" width="70%">
2<tr bgcolor="#AAAAFF">
3<td height="30" width="30%">图片名称</td>
4<td height="30" width="39%">所在位置</td>
5<td height="30" width="31%">有效</td>
6</tr>   

Function GetVar(ID,Default)
GetVar = Default
If Request(ID) &lt;&gt; "" 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="&amp;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)

 1<tr bgcolor="#FFFFFF">
 2<td valign="top">```
 3=fb.filename
 4```</td>
 5<td>```
 6=Replace(fb.Belong,"|","&lt;br/&gt;")
 7```</td>
 8<td>```
 9   
10if fb.Exists=1 then   
11response.Write "有效的路径"   
12elseif fb.exists=0 then   
13response.Write "失效的路径"   
14else   
15response.Write "非本地路径"   
16end if   
17
18```</td>
19</tr>   

next

 1<tr bgcolor="#FFFFFF">
 2<td colspan="3">共扫描文件:```
 3=mcs.files
 4```;扫描文件夹:```
 5=mcs.folders
 6```;总计大小:```
 7=mcs.totalsize
 8```<br/>扫描图片个数:```
 9=mcs.images&amp;amp;";数据库图片个数:"&amp;amp;mcs.dbimg&amp;amp;";图片总数:"&amp;amp;mcs.TotalImg
10```;失效个数:```
11=mcs.exists
12```个<br/>运行时间:```
13=mcs.runtime
14```毫秒</td>
15</tr>
16</table>
1set mcs=nothing
Published At
Categories with Web编程
Tagged with
comments powered by Disqus