|
源代码网推荐
Scan.inc
<%
"说明：这是我第一次编写应用类，其中不当之处请多多指教！QQ：1168064
"属性和方法
"1、ScanType：扫描的类型。默认值：1。值：0 扫描文件和数据库 1 扫描文件 2 扫描数据库。
"2、Connhttp://www.zzchn.com/edu/20070914/,Tablehttp://www.zzchn.com/edu/20070914/,ColImghttp://www.zzchn.com/edu/20070914/,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 Filehttp://www.zzchn.com/edu/20070914/,ScanTypehttp://www.zzchn.com/edu/20070914/,Connhttp://www.zzchn.com/edu/20070914/,Tablehttp://www.zzchn.com/edu/20070914/,ColIdhttp://www.zzchn.com/edu/20070914/,ColImghttp://www.zzchn.com/edu/20070914/,FSOhttp://www.zzchn.com/edu/20070914/,Pathhttp://www.zzchn.com/edu/20070914/,Listhttp://www.zzchn.com/edu/20070914/,ScanTexthttp://www.zzchn.com/edu/20070914/,Spathhttp://www.zzchn.com/edu/20070914/,Version
dim Foldershttp://www.zzchn.com/edu/20070914/,Fileshttp://www.zzchn.com/edu/20070914/,TotalSizehttp://www.zzchn.com/edu/20070914/,Imageshttp://www.zzchn.com/edu/20070914/,Existshttp://www.zzchn.com/edu/20070914/,sFileshttp://www.zzchn.com/edu/20070914/,Starthttp://www.zzchn.com/edu/20070914/,EndThttp://www.zzchn.com/edu/20070914/,RunTimehttp://www.zzchn.com/edu/20070914/,DbImghttp://www.zzchn.com/edu/20070914/,TotalImghttp://www.zzchn.com/edu/20070914/,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(pathhttp://www.zzchn.com/edu/20070914/,1)="/" then
path=Spath&Replace(pathhttp://www.zzchn.com/edu/20070914/,"/"http://www.zzchn.com/edu/20070914/,"")
else
Path=Spath&""&Replace(pathhttp://www.zzchn.com/edu/20070914/,"/"http://www.zzchn.com/edu/20070914/,"")
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 Rshttp://www.zzchn.com/edu/20070914/,RetStrhttp://www.zzchn.com/edu/20070914/,ReBelhttp://www.zzchn.com/edu/20070914/,SQL
SQL="Select "&ColID&"http://www.zzchn.com/edu/20070914/,"&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 SQLhttp://www.zzchn.com/edu/20070914/,connhttp://www.zzchn.com/edu/20070914/,3http://www.zzchn.com/edu/20070914/,3
While Not Rs.EOF
RetStr=Rs(1)
ReBel="表"&Table&"中的"&ColImg&"列(ID:"&Rs(0)&")"
InsDb RetStrhttp://www.zzchn.com/edu/20070914/,ReBelhttp://www.zzchn.com/edu/20070914/,0http://www.zzchn.com/edu/20070914/,""
Rs.MoveNext
Wend
Rs.Close
Set Rs=Nothing
End If
End Sub
Private Sub ScanFile(PathStr) "扫描文件。递归
Dim fhttp://www.zzchn.com/edu/20070914/,ffhttp://www.zzchn.com/edu/20070914/,fnhttp://www.zzchn.com/edu/20070914/,fdhttp://www.zzchn.com/edu/20070914/,fdnhttp://www.zzchn.com/edu/20070914/,RealPathhttp://www.zzchn.com/edu/20070914/,frhttp://www.zzchn.com/edu/20070914/,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(PathStrhttp://www.zzchn.com/edu/20070914/,1) <> "" Then
RealPath=PathStr&""&fn.Name
Else
RealPath=PathStr&fn.Name
End If
Set fr = FSO.OpenTextFile(RealPathhttp://www.zzchn.com/edu/20070914/,1)
fc=fr.ReadAll
"response.write RealPath&"<br>"
RegExpTest filterhttp://www.zzchn.com/edu/20070914/,fchttp://www.zzchn.com/edu/20070914/,RealPath
End If
Next
End If
If fd.Count> 0 Then
For Each fdn In fd
Folders=Folders+1
dim temp
if right (PathStrhttp://www.zzchn.com/edu/20070914/,1) <> "" then
temp=PathStr&""&fdn.Name
else
temp=PathStr&fdn.Name
end if
ScanFile(temp)
Next
End If
End Sub
Private Sub RegExpTest(Patrnhttp://www.zzchn.com/edu/20070914/, Strnghttp://www.zzchn.com/edu/20070914/,PathStr) "查找图片
Dim RegExhttp://www.zzchn.com/edu/20070914/, Matchhttp://www.zzchn.com/edu/20070914/, Matcheshttp://www.zzchn.com/edu/20070914/,Chkhttp://www.zzchn.com/edu/20070914/,ReImghttp://www.zzchn.com/edu/20070914/,RetStrhttp://www.zzchn.com/edu/20070914/,ReBelhttp://www.zzchn.com/edu/20070914/,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.Valuehttp://www.zzchn.com/edu/20070914/,"src="http://www.zzchn.com/edu/20070914/,"")
RetStr = Replace(RetStrhttp://www.zzchn.com/edu/20070914/,"""http://www.zzchn.com/edu/20070914/,"")
RetStr = Replace(RetStrhttp://www.zzchn.com/edu/20070914/,""""http://www.zzchn.com/edu/20070914/,"")
Chk = 0
ReBel=GetFn(PathStr)
InsDb RetStrhttp://www.zzchn.com/edu/20070914/,ReBelhttp://www.zzchn.com/edu/20070914/,1http://www.zzchn.com/edu/20070914/,PathStr
Next
End Sub
Private Function GetExt(FullPath) "获得文件扩展名，用于判断是否是扫描的文件类型
Dim Temp
If FullPath <> "" Then
Temp = Mid(FullPathhttp://www.zzchn.com/edu/20070914/,InStrRev(FullPathhttp://www.zzchn.com/edu/20070914/, "")+1)
If InStr(Temphttp://www.zzchn.com/edu/20070914/,".")>0 Then
GetExt=Mid(Temphttp://www.zzchn.com/edu/20070914/,InStrRev(Temphttp://www.zzchn.com/edu/20070914/, ".")+1)
Else
GetExt=Temp
End If
Else
GetExt = ""
End If
End Function
Private Function ChkFileName(Str) "检测文件是否是要扫描的文件类型
Dim arhttp://www.zzchn.com/edu/20070914/,ihttp://www.zzchn.com/edu/20070914/,fn
fn=GetExt(str)
ar=Split(ScanTexthttp://www.zzchn.com/edu/20070914/,"/")
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/1024http://www.zzchn.com/edu/20070914/,2)&"K"
ElseIf n>=1024*1024 and n <1024*1024*1024 Then
shb = formatnumber(n/(1024*1024)http://www.zzchn.com/edu/20070914/,2)&"M"
Else
shb =formatnumber(n/(1024*1024*1024)http://www.zzchn.com/edu/20070914/,2)&"G"
End If
End Function
Private Sub InsDb(RetStrhttp://www.zzchn.com/edu/20070914/,ReBelhttp://www.zzchn.com/edu/20070914/,AddNumhttp://www.zzchn.com/edu/20070914/,PathStr) "分析图片是否有效，并添加到字典对象中
dim chkhttp://www.zzchn.com/edu/20070914/,ReImghttp://www.zzchn.com/edu/20070914/,TheFile
If InStr(RetStrhttp://www.zzchn.com/edu/20070914/,"0/">http://")>0 OR Instr(RetStrhttp://www.zzchn.com/edu/20070914/,"0/">ftp://")>0 Then
ReImg=RetStr
Chk=-1
Else
RetStr = Replace(RetStrhttp://www.zzchn.com/edu/20070914/,"/"http://www.zzchn.com/edu/20070914/,"")
If (Left(RetStrhttp://www.zzchn.com/edu/20070914/,1) = "" ) Then
RetStr=SPath&Retstr
ElseIf Left(RetStrhttp://www.zzchn.com/edu/20070914/,3) = ".." Then
dim temp
temp=GetPath(PathStr)
Do Until Left(RetStrhttp://www.zzchn.com/edu/20070914/,3) <> ".." "处理相对路径
Temp=Fso.GetParentFolderName(Temp)
RetStr=Mid(RetStrhttp://www.zzchn.com/edu/20070914/,4http://www.zzchn.com/edu/20070914/,len(RetStr)-3)
Loop
RetStr=Temp&""&RetStr
Else
If AddNum=0 Then
if left(RetStrhttp://www.zzchn.com/edu/20070914/,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 ReImghttp://www.zzchn.com/edu/20070914/,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 Temphttp://www.zzchn.com/edu/20070914/,EndB
Temp=Replace(Strhttp://www.zzchn.com/edu/20070914/,"/"http://www.zzchn.com/edu/20070914/,"")
EndB=InstrRev(Temphttp://www.zzchn.com/edu/20070914/,"")
If EndB = 0 Then
GetPath=SPath
Else
GetPath=Left(Temphttp://www.zzchn.com/edu/20070914/,EndB)
End If
"response.write GetPath&"<BR>"
End Function
Private Function GetFn(Str) "获得文件的相对路径名
Dim Temp
Temp=Str
"response.write temp&"<br>"
Temp=Replace(Strhttp://www.zzchn.com/edu/20070914/,SPathhttp://www.zzchn.com/edu/20070914/,"")
Temp=Replace(Temphttp://www.zzchn.com/edu/20070914/,""http://www.zzchn.com/edu/20070914/,"/")
GetFn=Temp
End Function
End Class
Class FileInfo
Dim FileNamehttp://www.zzchn.com/edu/20070914/,Belonghttp://www.zzchn.com/edu/20070914/,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 fsohttp://www.zzchn.com/edu/20070914/,fhttp://www.zzchn.com/edu/20070914/,fdhttp://www.zzchn.com/edu/20070914/,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(fdshttp://www.zzchn.com/edu/20070914/,phttp://www.zzchn.com/edu/20070914/,"")http://www.zzchn.com/edu/20070914/,""http://www.zzchn.com/edu/20070914/,"/")&">"&Replace(Replace(fdshttp://www.zzchn.com/edu/20070914/,phttp://www.zzchn.com/edu/20070914/,"")http://www.zzchn.com/edu/20070914/,""http://www.zzchn.com/edu/20070914/,"/")&"</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 mcshttp://www.zzchn.com/edu/20070914/,fnhttp://www.zzchn.com/edu/20070914/,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(IDhttp://www.zzchn.com/edu/20070914/,Default)
GetVar = Default
If Request(ID) <> "" Then
GetVar = Request(ID)
End IF
End Function
Dim STypehttp://www.zzchn.com/edu/20070914/,LTypehttp://www.zzchn.com/edu/20070914/,Pathhttp://www.zzchn.com/edu/20070914/,Exthttp://www.zzchn.com/edu/20070914/,Connhttp://www.zzchn.com/edu/20070914/,Tabhttp://www.zzchn.com/edu/20070914/,ColIDhttp://www.zzchn.com/edu/20070914/,ColImg
SType=GetVar("SType"http://www.zzchn.com/edu/20070914/,1)
LType=GetVar("LType"http://www.zzchn.com/edu/20070914/,3)
Path=GetVar("Path"http://www.zzchn.com/edu/20070914/,"/")
Ext = Trim(Replace(GetVar("Ext"http://www.zzchn.com/edu/20070914/,"htmhttp://www.zzchn.com/edu/20070914/,htmlhttp://www.zzchn.com/edu/20070914/,asphttp://www.zzchn.com/edu/20070914/,inc")http://www.zzchn.com/edu/20070914/,"http://www.zzchn.com/edu/20070914/, "http://www.zzchn.com/edu/20070914/,"/"))
Conn=GetVar("Conn"http://www.zzchn.com/edu/20070914/,"")
Tab=GetVar("Tab"http://www.zzchn.com/edu/20070914/,"")
ColID=GetVar("ColID"http://www.zzchn.com/edu/20070914/,"")
ColImg=GetVar("ColImg"http://www.zzchn.com/edu/20070914/,"")
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.Belonghttp://www.zzchn.com/edu/20070914/,"|"http://www.zzchn.com/edu/20070914/,"<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%>
源代码网供稿. |
