网站图片扫描类.doc

网站图片扫描类Scan.inc&*)(.gif|.jpg)Version=1.00End SubPrivate Sub Class_Terminate Set File=NothingSet FSO = NothingEnd SubPublic Function Scan() 开始扫描if left(path,1)=/ thenpath=Spath&Replace(path,/,)elsePath=Spath&Replace(path,/,)end ifIf ScanType=1 thenScanfile(Path)ElseIf ScanType=2 ThenScanDb()ElseScanFile(Path)ScanDb()End IfEndT=timerRunTime=FormatNumber(EndT-Start)*1000TotalSize=shb(TotalSize)TotalImg=DbImg+ImagesEnd FunctionPrivate Sub ScanDB() 扫描数据库。这里的路径难于判断，请在InsDb中更改(If AddNum=0 后)Dim Rs,RetStr,ReBel,SQLSQL=Select &ColID&,&ColIMG& From &Table& Order by &ColID& DESCOn Error Resume NextIf Conn = OR Table= OR ColID= OR ColIMG = ThenExit SubElseSet Rs = Server.CreateObject(ADODB.RecordSet)Rs.Open SQL,conn,3,3While Not Rs.EOFRetStr=Rs(1)ReBel=表&Table&中的&ColImg&列(ID:&Rs(0)&)InsDb RetStr,ReBel,0,Rs.MoveNextWendRs.CloseSet Rs=NothingEnd IfEnd SubPrivate Sub ScanFile(PathStr) 扫描文件。递归Dim f,ff,fn,fd,fdn,RealPath,fr,fcResponse.write PathStr&Set ff = fso.getfolder(pathstr)Set f = ff.filesSet fd = ff.subfoldersIf f.Count 0 ThenFor Each fn In fFiles=Files+1TotalSize=TotalSize+fn.SizeIf ChkFileName(fn.Name) ThensFiles=sFiles+1If Right(PathStr,1) ThenRealPath=PathStr&fn.NameElseRealPath=PathStr&fn.NameEnd IfSet fr = FSO.OpenTextFile(RealPath,1)fc=fr.ReadAllresponse.write RealPath&RegExpTest filter,fc,RealPathEnd IfNextEnd IfIf fd.Count 0 ThenFor Each fdn In fdFolders=Folders+1dim tempif right (PathStr,1) thentemp=PathStr&fdn.Nameelsetemp=PathStr&fdn.Nameend ifScanFile(temp)NextEnd IfEnd SubPrivate 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 = 0ReBel=GetFn(PathStr)InsDb RetStr,ReBel,1,PathStr NextEnd SubPrivate Function GetExt(FullPath) 获得文件扩展名，用于判断是否是扫描的文件类型Dim TempIf FullPath ThenTemp = Mid(FullPath,InStrRev(FullPath, )+1)If InStr(Temp,.)0 ThenGetExt=Mid(Temp,InStrRev(Temp, .)+1)ElseGetExt=TempEnd IfElseGetExt = End IfEnd FunctionPrivate Function ChkFileName(Str) 检测文件是否是要扫描的文件类型Dim ar,i,fnfn=GetExt(str)ar=Split(ScanText,/)ChkFileName=FalseFor i=0 To ubound(ar) If lCase(fn) =lCase(Trim(ar(i) ThenChkFileName=TrueExit FunctionEnd IfNextEnd FunctionPrivate Function shb(n) 显示字节数If n1024 and n=1024*1024 and n 0 OR Instr(RetStr,ftp:/)0 Then ReImg=RetStrChk=-1ElseRetStr = Replace(RetStr,/,)If (Left(RetStr,1) = ) ThenRetStr=SPath&RetstrElseIf Left(RetStr,3) = . Thendim temptemp=GetPath(PathStr)Do Until Left(RetStr,3) . 处理相对路径Temp=Fso.GetParentFolderName(Temp)RetStr=Mid(RetStr,4,len(RetStr)-3)LoopRetStr=Temp&RetStrElseIf AddNum=0 Thenif left(RetStr,1)= thenRetStr=Path&RetstrElseRetStr=path&RetstrEnd IfelseRetStr=getpath(Pathstr)&RetStrEnd IFEnd IfIf FSO.FileExists(RetStr) ThenChk=1End IfReImg=GetFn(RetStr)End IfIf Chk=0 ThenExists=Exists+1End ifIf File.Exists(ReImg) thenSet TheFile=File.Item(ReImg)If TheFile.Belong ReBel ThenTheFile.Belong=TheFile.Belong&|&RebelEnd IfElseIf (List=0 AND Chk =0) OR (List=1 And Chk=-1) Or (List=2 And Chk=1 ) Or List=3 ThenSet TheFile= New FileInfoTheFile.FileName=ReImgTheFile.Belong=ReBelTheFile.Exists=ChkFile.Add ReImg,TheFileSelect Case ScanTypeCase 1 Images=Images+1Case 2 DbImg = DbImg+1Case ElseIf AddNum = 0 ThenDbImg = DbImg+1ElseImages=Images+1End IfEnd Select End IfEnd IfEnd SubPrivate Function GetPath(Str) 获得文件路径response.write str&Dim Temp,EndBTemp=Replace(Str,/,)EndB=InstrRev(Temp,)If EndB = 0 ThenGetPath=SPathElseGetPath=Left(Temp,EndB)End Ifresponse.write GetPath&End FunctionPrivate Function GetFn(Str) 获得文件的相对路径名Dim TempTemp=Strresponse.write temp&Temp=Replace(Str,SPath,)Temp=Replace(Temp,/)GetFn=TempEnd FunctionEnd ClassClass FileInfoDim FileName,Belong,ExistsPrivate Sub Class_Initialize FileName=Belong=Exists=End subEnd Class%应用举例无标题文档 扫描图片 扫描文件夹： /%dim fso,f,fd,pp=server.MapPath(/)set fso=Server.CreateObject(Scripting.FileSystemObject)function showpath(str)set f=fso.getfolder(str)set fd=f.subfoldersfor each fds in fdResponse.Write &Replace(Replace(fds,p,),/)&set ff=fso.getfolder(fds)set ffd=ff.subfoldersif ffd.count0 thenshowpath(fds)end ifnextend functionshowpath(p)% 扫描类型： 所有 扫描文件 扫描数据库 显示类型： 失效 网络路径 有效 所有 文件类型： Asp Htm Html Inc 数据库： 表： 图片ID列： 图片路径列： scan.asp 图片名称 所在位置 有效 %Function GetVar(ID,Default)GetVar = DefaultIf Request(ID) ThenGetVar = Request(ID)End IFEnd FunctionDim SType,LType,Path,Ext,Conn,Tab,ColID,ColImgSType=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= n