网站图片扫描类
来源:ASP学习网 作者:Admin 时间:08-07-17 点击:
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
Next
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/'" DESIGNTIMESP=5631>http://")>0 OR Instr(RetStr,"0/'" DESIGNTIMESP=5632>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 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>
<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 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,""),"\","/")&">"&a