网站图片扫描类 - 王朝网络

Scan.inc

'************************************************'

'***********网站图片扫描器 1.00******************'

'***********作者：魔术师·杨*********************'

'***********日期：2004.5.6***********************'

'***********QQ：1168064**************************'

'************************************************'

'说明：这是我第一次编写应用类，其中不当之处请多多指教！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

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)

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

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

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

<title>无标题文档</title>

</head>

<body>

</tr>

<td width="26%" height="20"><div align="right">扫描文件夹：</div></td>

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

end function

showpath(p)%>

</select></td>

</tr>

所有

扫描文件

扫描数据库</td>

</tr>

失效

网络路径

有效

所有</td>

</tr>

Asp

Htm

Html

Inc</td>

</tr>

<td height="20">表：

图片ID列：

图片路径列：

</tr>

</div></td>

</tr>

</table>

</form>

</body>

</html>

scan.asp

dim mcs,fn,fb

</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)

<td><%

if fb.Exists=1 then

response.Write "有效的路径"

elseif fb.exists=0 then

response.Write "失效的路径"

else

response.Write "非本地路径"

end if

%></td>

</tr>

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