Scan.inc Private Sub Class_Terminate Public Function Scan() 开始扫描 Private Sub ScanDB() 扫描数据库。这里的路径难于判断,请在InsDb中更改(If AddNum=0 后) While Not Rs.EOF Private Sub ScanFile(PathStr) 扫描文件。递归 If fd.Count> 0 Then Private Sub RegExpTest(Patrn, Strng,PathStr) 查找图片 Private Function GetExt(FullPath) 获得文件扩展名,用于判断是否是扫描的文件类型 Private Function ChkFileName(Str) 检测文件是否是要扫描的文件类型 Private Function shb(n) 显示字节数 Private Sub InsDb(RetStr,ReBel,AddNum,PathStr) 分析图片是否有效,并添加到字典对象中 If FSO.FileExists(RetStr) Then Private Function GetPath(Str) 获得文件路径 Private Function GetFn(Str) 获得文件的相对路径名 End Class Class FileInfo Dim FileName,Belong,Exists Private Sub Class_Initialize End Class <body>
<%
说明:这是我第一次编写应用类,其中不当之处请多多指教!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
Set File=Nothing
Set FSO = Nothing
End Sub
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
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
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
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
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
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=”http://www.knowsky.com/,””)
RetStr = Replace(RetStr,””,””)
RetStr = Replace(RetStr,””””,””)
Chk = 0
ReBel=GetFn(PathStr)
InsDb RetStr,ReBel,1,PathStr
Next
End Sub
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
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
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
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
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
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
Dim Temp
Temp=Str
response.write temp&”<br>”
Temp=Replace(Str,SPath,””)
Temp=Replace(Temp,”\”,”/”)
GetFn=Temp
End Function
FileName=””
Belong=””
Exists=””
End sub
%>
应用举例
<%@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>
<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%>
网站图片扫描类_asp技巧
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com 特别注意:本站所有转载文章言论不代表本站观点! 本站所提供的图片等素材,版权归原作者所有,如需使用,请与原作者联系。未经允许不得转载:IDC资讯中心 » 网站图片扫描类_asp技巧
相关推荐
-      ASP基础教程:其它的ASP常用组件
-      ASP基础教程:学习ASP中子程序的应用
-      ASP基础教程之ASP程序对Cookie的处理
-      ASP基础教程之ASP AdRotator组件的使用
-      ADO初学者教程:ADO 通过GetString()加速脚本
-      ASP技巧实例:几行代码解决防止表单重复提交
-      ASP常见数学函数 Abs Atn Cos 等详细详解[ 来源:网页教学网 | 作者: | 时间:2007-09-12 10:57:29 | 收藏本文 ] 【大 中 小】【名称】
-      ASP基础教程之ASP AdRotator 组件的使用