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