網站圖片掃描類

來源:互聯網
上載者:User
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=http://www.163design.net/a/f/(.[^/>^/&]*)(.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



相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。