您现在的位置: 龚师傅之家 >> 文章中心 >> 编程技术 >> ASP编程 >> 正文

旧网站入口

无组件上传类(无惧上传类 V2.2)

        ★★★

字体:

作者:佚名    文章来源:网络    点击数:1476    更新时间:2014/3/31

<%
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'******************* 无惧上传类 V2.2 ************************************
'作者:梁无惧
'网站:http://www.25cn.com
'电子邮件:yjlrb@21cn.com
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是修改后必须把修改后的文件
'发送一份给作者.并且保留作者此版权信息
'**********************************************************************
'----------------------------------------------------------------------
'----------------------------------------------------------------------
'文件上传类
Class UpFile_Class

Dim Form,File
Dim AllowExt_ '允许上传类型(白名单)
Dim NoAllowExt_ '不允许上传类型(黑名单)
Dim IsDebug_ '是否显示出错信息
Private oUpFileStream '上传的数据流
Private isErr_ '错误的代码,0或tr表示无错
Private ErrMessage_ '错误的字符串信息
Private isGetData_ '指示是否已执行过GETDATA过程

'------------------------------------------------------------------
'类的属性
P lic Property Get Version
Version="无惧上传类 Version V2.0"
End Property

P lic Property Get isErr '错误的代码,0或tr表示无错
isErr=isErr_
End Property

P lic Property Get ErrMessage '错误的字符串信息
ErrMessage=ErrMessage_
End Property

P lic Property Get AllowExt '允许上传类型(白名单)
AllowExt=AllowExt_
End Property

P lic Property Let AllowExt(Val) '允许上传类型(白名单)
AllowExt_=LCase(Val)
End Property

P lic Property Get NoAllowExt '不允许上传类型(黑名单)
NoAllowExt=NoAllowExt_
End Property

P lic Property Let NoAllowExt(Val) '不允许上传类型(黑名单)
NoAllowExt_=LCase(Val)
End Property

P lic Property Let IsDebug(Val) '是否设置为调试模式
IsDebug_=Val
End Property


'----------------------------------------------------------------
'类实现代码

'初始化类
Private S Class_Initialize
isErr_ = 0
NoAllowExt="" '黑名单,可以在这里预设不可上传的文件类型,以文件的后缀名来判断,不分大小写,每个每缀名用;号分开,如果黑名单为空,则判断白名单
NoAllowExt=LCase(NoAllowExt)
AllowExt="" '白名单,可以在这里预设可上传的文件类型,以文件的后缀名来判断,不分大小写,每个后缀名用;号分开
AllowExt=LCase(AllowExt)
isGetData_=false
End S

'类结束
Private S Class_Terminate
on error Resume Next
'清除变量及对像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
if Err.number<>0 then OutErr("清除类时发生错误!")
End S

'分析上传的数据
P lic S GetData (MaxSize)
'定义变量
on error Resume Next
if isGetData_=false then
Dim ReqstBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormVal,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代码开始
If Reqst.TotalBytes < 1 Then '如果没有数据上传
isErr_ = 1
ErrMessage_="没有数据上传,这是因为直接提交网址所产生的错误!"
OutErr("没有数据上传,这是因为直接提交网址所产生的错误!!")
Exit S
End If
If MaxSize > 0 Then '如果限制大小
If Reqst.TotalBytes > MaxSize Then
isErr_ = 2 '如果上传的数据超出限制大小
ErrMessage_="上传的数据超出限制大小!"
OutErr("上传的数据超出限制大小!")
Exit S
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
if Err.number<>0 then OutErr("创建流对象(ADODB.STREAM)时出错,可能系统不支持或没有开通该组件")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Reqst.BinaryRead (Reqst.TotalBytes)
oUpFileStream.Position = 0
ReqstBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每个项目之间的分隔符
sSpace = MidB (ReqstBinDate,1, InStrB (1,ReqstBinDate,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
'分解项目
Do
iInfoEnd = InStrB (iFormStart,ReqstBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sInfo = tStream.ReadText
'取得表单项目名称
iFormStart = InStrB (iInfoEnd,ReqstBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
'取得文件属性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
oFileInfo.FileName = GetFileName(sFileName)
oFileInfo.FilePath = GetFilePath(sFileName)
oFileInfo.FileExt = GetFileExt(sFileName)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'如果是表单项目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sFormVal = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormVal
else
Form.Add sFormName,sFormVal
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) >= iFormEnd
if Err.number<>0 then OutErr("分解上传数据时发生错误,可能客户端的上传数据不正确或不符合上传数据规则")
ReqstBinDate = ""
Set tStream = Nothing
isGetData_=tr
end if
End S

'保存到文件,自动覆盖已存在的同名文件
P lic Function SaveToFile(Item,Path)
SaveToFile=SaveToFileEx(Item,Path,Tr)
End Function

'保存到文件,自动设置文件名
P lic Function AutoSave(Item,Path)
AutoSave=SaveToFileEx(Item,Path,false)
End Function

'保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim FileExt
if file.Exists(Item) then
Dim oFileStream
Dim tmpPath
isErr_=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
tmpPath=Split(Path,".")(0)
FileExt=GetFileExt(Path)
if Over then
if isAllowExt(FileExt) then
oFileStream.SaveToFile tmpPath & "." & FileExt,2
if Err.number<>0 then OutErr("保存文件时出错,请检查路径,是否存在该上传目录!该文件保存路径为" & tmpPath & "." & FileExt)
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
OutErr("该后缀名的文件不允许上传")
End if
Else
Path=GetFilePath(Path)
dim fori
fori=1
if isAllowExt(File(Item).FileExt) then
do
fori=fori+1
Err.Clear()
tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
oFileStream.SaveToFile tmpPath
loop Until ((Err.number=0) or (fori>50))
if Err.number<>0 then OutErr("自动保存文件出错,已经测试50次不同的文件名来保存,请检查目录是否存在!该文件最后一次保存时全路径为"&Path&GetNewFileName()&"."&File(Item).FileExt)
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
OutErr("该后缀名的文件不允许上传")
End if
End if
oFileStream.Close
Set oFileStream = Nothing
else
ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"
OutErr("不存在该对象(如该文件没有上传,文件为空)")
end if
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function

'取得文件数据
P lic Function FileData(Item)
isErr_=0
if file.Exists(Item) then
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传"
OutErr("该后缀名的文件不允许上传")
FileData=""
End if
else
ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"
OutErr("不存在该对象(如该文件没有上传,文件为空)")
end if
End Function


'取得文件路径
P lic function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function

'取得文件名
P lic Function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function

'取得文件的后缀名
P lic Function GetFileExt(FullPath)
If FullPath <> "" Then
GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
Else
GetFileExt = ""
End If
End function

'取得一个不重复的序号
P lic Function GetNewFileName()
dim ranNum
dim dtNow
dtNow=Now()
randomize
ranNum=int(90000*rnd)+10000
'以下这段由webboy提供
GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function

P lic Function isAllowExt(Ext)
if NoAllowExt="" then
isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
else
isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
end if
End Function
End Class

P lic S OutErr(ErrMsg)
if IsDebug_=tr then
Response.Write ErrMsg
Response.End
End if
End S

'----------------------------------------------------------------------------------------------------
'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class

%>
------------------------以下是类的使用说明
无惧上传类 - UpFile_Class V2.1 使用手册

作者:梁无惧 http://www.25cn.com [下载]


UpFile_Class 概述
自从用ASP来编写网站,就无时无刻想找一种兼容性强,使用方便的上传方法,用过很多的无组件上传方法,但是都存在使用不方便,兼容性差,速度慢等的问题。终于在2003年的元旦里,想到了可以让上传文件达到最快的方法,经过10天的努力,整整10个版本的版本的更新,终于完成了第一个“无惧上传类V1.0”,这个版本与其它的上传类或方法相比,具有速度快,兼容性强,使用方便等特点。
经过整整一年,在得到各大网友的支持下,并且在长期使用中针对该版的不足,开发了1.1,1.2等版本,由于为了向下兼容,放弃了很多新的特性,现在,结过审慎考虑,终于在2004年7月10日完成了"无惧上传类2.0"版,该版相对于前作在安全上作出了最大的改进,在类内部实现了上传类型的黑白名单,更多方便了各种上传的环境,即使黑客突破了上传程序,但是最终在保存文件时会使他的所有努力付之流水,该版在使用上比前作更加方便,更人性化了。由于添加和修改了不少属性值,在移植上需要作出比较大的修改。

UpFile_Class 公共属性
File 文件域的集合,是一个Dictionary 对象,返回值一个FileInfo_Class 类。可读写。
Form 表单域的集合,是一个Dictionary 对象,返回对应表单域的值。可读写。
isErr 返回错误的数值。-1表示无错,1表示没有上传数据,2表示上传超出限制。只读。
Version 获取类的版本信息。只读。
AllowExt 白名单,允许上传的文件类型,可以在类文件里预设可上传的文件类型,以文件的后缀名来判断,不区分大小写,每个后缀名用“;”号分开。如AllowExt="jpg;rar;zip"。可读写。
NoAllowExt 黑名单,不允许上传的文件类型,可以在类文件里预设不可上传的文件类型,以文件的后缀名来判断,不区分大小写,每个后缀名用“;”号分开。如NoAllowExt="asp;htm;html;js;"。可读写
ErrMessage 错误信息,在发生错误时,可以调用ErrMessage显示错误的字符串信息。只读。


UpFile_Class 公共方法
GetData(MaxSize As Int64) 分析上传的数据。MaxSize为限制上传的字节,设为-1即不限制大小,此为过程,没有返回值,调用后调检查isErr是否大于0。
SaveToFile(Item As String,Path As String) 保存到文件,自动覆盖已存在的同名文件,Item为表单项名,Path为保存的绝对路径,返回值为保存的文件名。
AutoSave(Item As String,Path As String) 保存到文件,自动创建文件名以避免重复,Item为表单的名,Path为保存的绝对路径(可不包含文件名,如e:\wwwroot\upimg\),返回值为保存的文件名。
FileData(Item As String) 取得文件数据,Item为表单项名
GetFilePath(FullPath As String) 返回文件在路径,如GetFilePath("c:\a.asp") 返回值为"c:\"。
GetFileName(FullPath As String) 返回文件名,如GetFileName("c:\a.asp") 返回值为"a.asp"。
GetFileExt(FullPath As String) 返回文件的后缀名,如GetFileExt("c:\a.asp") 返回值为"asp"。
GetNewFileName() 返回一个以时间种子的不重复数值,可以用作文件名。
isAllowExt(Ext As String) 返回一个真假值指是Ext是否为可上传的类型,如isAllowExt("jpg")。


UpFile_Class 受保护方法
SaveToFileEx(Item As String,Path As String,Over As bool) 保存到文件,其中Over指示如果文件存在是否覆盖,如果OVER为真时,文件按PATH来保存,如果OVER为假,则自动调用 GetNewFileName() 生成一个新的不重复的文件名,以上传时的后缀名保存。


FileInfo_Class 概述
文件信息类,用来存贮上传的文件信息

FileInfo_Class 公共属性
FileName 返回上传的文件名。
FilePath 返回上传时文件在客户端的路径。
FileExt 返回文件扩展名。
FileMIME 返回文件MIME类别。
FileSize 返回文件大小(以字节为单位)。

Dictionary 对象 请参考VBSCRIPT帮助取得更详细的属性和方法

UPFILE_CLASS 特性
版本更新
0.96 第一个公开版本,以新的解析方法达到速度上的一个提升,修改稻香老农的无组件上传类,以达到完全兼容。


1.0 发现原版中一个无法避免的BUG,会导至黑客利用服务器在上传其间会占用100%CPU资源来达到拒绝服务攻击,故修改了原来的设用方法,增加一个GetData来在实际上传数据前对上传文件的大小进行判断,防止被上传超大文件。至于其它的改变,忘掉了。
1.2 修改了1.0中的一些错误命名(俺的英语不好),整理部分代码和加入更多对代码的注释。
2.0 更加稳定和更安全,加入了上传类型的黑白名单,自动保存,修改了文件类中的一个属性,原为FileType现在改为FileMIME,增加了几个常用的方法。


使用中的一些问题解答

1、什么时候用AutoSave和SaveToFile?
AutoSave是自动生成新的文件名以避免与服务器上的原文件同名,而SaveToFile则是覆盖存在的文件,所以,如果你上传的文件需要覆盖原文件的时候,那么就调用SaveToFile,如果你上传的文件不需要覆盖存在的文件,那么就调用AutoSave,该函数会返回所保存的文件名。

2、为什么不提供自全部保存?
我不太相信大家用上传类时不需要对文件进行处理,那么提供全部保存与分别保存并没有什么太大的区别,在能少不多的情况下,我没有加入这个功能。

3、为什么我保存的时候会提示“该类型不允许上传呢”?我没有执行判断啊!
这是因为程序内部进行了判断,为了防止由于外部调用代码的BUG而导至判断上传类型失效,在内部的保存和取得数据都自动进行了文件类型的判别,如果黑名单存在,则白名单不起作用,这是为了方便一些程序的使用,因为有些时间只需要禁止几个上传类型即可,而不需要对每个上传类型进行判别。

关于网友的一些问题

1、为什么上传的时候会出现无效页?
这是因为IE的BUG所导至的,目前尚没有更好的解决方法,原理是:当客户端提交表单时,IE会首先发把上传的总大小传到服务器,而这时服务器开始执行ASP代码,当运行到GetData方法时,会首先判断上传的总大小是为超过程序预设大小,如果没有,则开始执行上传,这时IE才真正开始上传数据,但是如果上传的总大小为超过程序预设大小,那么程序自动放弃读取并退出执行,这时上传并没有真正开始,虽然服务器返回了错误信息给IE,但是IE由于设计当初没有考虑到服务器会拒绝表单的上传,故IE会继续等待服务器的上传回应,由于服务器已经终止上传,IE就会以为服务器没有响应而出现无效页的错误了。

2、为什么从1.2马上升到了2.0?好像代码改得不多啊!
这是因为大家都喜欢高版本,我巴不得改为7.0呢,那样大家都会觉得这个版真高级。。。。-_-||

使 用 示 例
上传文件的表单要加入enctype="multipart/form-data"属性,即
<form name="form1" method="post" action="" enctype="multipart/form-data">
<input type="text" val="1" name="name">
<input type=file name="img">
<input type=s mit name="s mit" val="提交">
</form>


在执行上传的ASP页
'包含类文件
<!-- #incl? file="upfile_class.asp" -->
dim upfile
dim SaveFilename
'建立上传对象
set upfile=new upfile_class
'取得上传数据,限制最大上传10M 计算方法为 10240000/1000000=10.24M
upfile.GetData (10240000)
'判决是否出错
if upfile.isErr then
select case upfile.err
case 1
Response.Write "你没有上传数据呀???是不是搞错了??"
case 2
Response.Write "你上传的文件超出我们的限制,最大10M"
end select
else
'执行保存文件代码
upfile.SaveToFile "img","c:\"&upfile.file("img").filename
'执行自动保存文件代码,SaveFilename为保存的文件名
SaveFilename=upfile.AutoSave("img","c:\")
'销毁对像
set upfile=nothing
end if

实例二:

Index.html

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>上传文件</title>
</head>
<body>
   <form action="upfile2.asp" method="post" enctype="multipart/form-data">
   <input type="file" name="path">
   <input type="s mit" val="上传">
   </form>
</body>
</html>

upfile2.asp

<!-- #incl? file="upFile_Class.asp" -->
<%
dim upfile,ServerPath,FSPath,oFile
upfilecount=0
set upfile=new upfile_class   '建立上传对象
upfile.AllowExt="Jpg"   '设置上传类型的黑名单
upfile.GetData (2048000) '上传文件的最大大小
FSPath=GetFilePath(Server.mappath("./"),"\") '取得当前文件在服务器路径
Response.Write(FSPath&"<BR>")
ServerPath=GetFilePath(Reqst.ServerVariables("HTTP_REFERER"),"/") '取得在网站上的位置
Response.Write(ServerPath&"<BR>")
for each formName in upfile.file '列出所有上传了的文件
set oFile=upfile.file(formname)
Response.Write(TypeName(upfile.file)&"<BR>")
Response.Write upfile.AutoSave(formname,FSPath&oFile.FileName)   '保存文件
if upfile.iserr then
   Response.Write upfile.errmessage
   Else
   Response.Write "上传成功"
    end if
set oFile=nothing
Next
set upfile=nothing
function GetFilePath(FullPath,str)
   If FullPath <> "" Then
    GetFilePath = left(FullPath,InStrRev(FullPath, str))
   Else
   GetFilePath = ""
   End If
End function
%>

 

文章录入:admin    责任编辑:admin 

[版权声名] 本网转载稿件及图片均来自于互联网,版权归属其版权拥有者全权所有。龚师傅之家此频道仅作为展示与交流之用。作品不代表本网观点,本网不承担此类稿件侵权行为的连带责任。谢谢您的支持!—— 龚师傅之家
  • 上一篇文章:

  • 下一篇文章:
  •  
    网友评论

    只显示最新10条。评论内容只代表网友观点,与本站立场无关!

     
    友情连接

    文字连接w3school在线教程| DIV+CSS布局教程

     

    站长:龚师傅 建站时间:2005-11-23 联系方式:QQ446380909

    网站备案:【蜀ICP备05028898号】