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="&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)
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) <> "" 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)
1<tr bgcolor="#FFFFFF">
2<td valign="top">```
3=fb.filename
4```</td>
5<td>```
6=Replace(fb.Belong,"|","<br/>")
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;mcs.dbimg&amp;";图片总数:"&amp;mcs.TotalImg
10```;失效个数:```
11=mcs.exists
12```个<br/>运行时间:```
13=mcs.runtime
14```毫秒</td>
15</tr>
16</table>
1set mcs=nothing