ASP无组件上传·从机制详细说明到实践

[ 2023-03-02 22:25:06 | 作者: admin ]
字号: | |
p.s. 看老代码的时候发现asp的无组件上传没有研究过,网上发现有个blog介绍比较好,就记录下
https://www.cnblogs.com/lsm/articles/1089542.html



无组件上传一直是困扰大家的一个问题。其实原理很简单,核心就是分析字符串。但是,实际操作时,却困难重重。其中的关键问题还是大家往往对原理的剖析不够深入,或者是因为过程过于繁琐,导致bug不断。一直以来,都想做一个完善的例子,只不过想想就头痛,加上没时间(借口,呵呵 ),所以没有付诸行动。


今天就咬咬牙,给大家提供一个完整的无组件上传的例子。因为本人耐性不好,所以咱们一点一点来,分几天完成。未来的几天,我会天天更新这个文档,这个过程也是大家学习和提高的过程。

(完整的源码和示例,可以在这里找到:http://www.2yup.com/ASP/attach/A0000006.zip)

==============================================================
第一天:认识我们的解剖对象——数据

上传文件时,首先要知道我们得到的是什么。下面是一个上传文件的表单,我们就从他开始。
<form action="doupload.ASP" method=post enctype="multipart/form-data">
file1说明:<input type=text name=file1_desc> &nbsp;
file1<input type=file name=file1><br>
file2说明:<input type=text name=file2_desc> &nbsp;
file2<input type=file name=file2><br>
<input type=submit name=upload value=upload>
</form>

表单中enctype="multipart/form-data"的意思,是设置表单的MIME编码。默认情况,这个编码格式是application/x-www-form-urlencoded,不能用于文件上传;只有使用了multipart/form-data,才能完整的传递文件数据,进行下面的操作(有兴趣的朋友,可以自己试试看两者的异同。方法很简单,就是把这一句去掉)。现在,我们在表单中分别填入数据:
file1的说明 D:\我的 图片\BACK046.GIF
file2的说明 D:\我的 图片\BACK293.GIF

这里用了中英文、空格混排。目的是让例子更有一般性。我选的这两个图片分别是54和62字节。大图片的原理完全一样,不过小图片做例子更合适些,原理容易展现。
为了看到我们得到的数据,在doupload.ASP里,有这几行代码:
<%
formsize=request.totalbytes
formdata=request.binaryread(formsize)
response.BinaryWrite(formdata)
%>

很简单,作用就是打出来传过来的所有数据。如果不熟悉,你可以先研究一下request和response对象的这两个方法。

提交表单,我们在ie里面查看HTML源,得到:
-----------------------------7d22131090458
Content-Disposition: form-data; name="file1_desc"

file1μ??μ?÷
-----------------------------7d22131090458
Content-Disposition: form-data; name="file1"; filename="D:\?òμ? í???\BACK046.GIF"
Content-Type: image/gif

GIF89a‘ì?f?f3?ì???ì!ù,@?.á?o ;

-----------------------------7d22131090458
Content-Disposition: form-data; name="file2_desc"

file2μ??μ?÷
-----------------------------7d22131090458
Content-Disposition: form-data; name="file2"; filename="D:\?òμ? í???\BACK293.GIF"
Content-Type: image/gif

GIF89a(‘???YYYììì!ù,(@L€?j(·"j?N(34ˉ;
-----------------------------7d22131090458
Content-Disposition: form-data; name="upload"

upload
-----------------------------7d22131090458--

不用怀疑,这就是你从上一个“简单”表单传过来的东西。现在想想看,怎么对付这一堆东西?是不是看上去有规律,又不知道从何下手?明天,咱们就分析一下这堆“图片”,看看怎么分离出我们要的内容。


==============================================================
第二天:分拆初步

睡了个好觉,大家脑子清醒多了吧?今天中午吃的火锅,阿森纳vs.铁哥也没看完,现在一脑子大油。。。
OK,咱们继续研究这个枯燥的问题。首先,要找出规律。看上去似乎很简单,就是用
-----------------------------7d22131090458
做分隔,这样,每一个文本单元里,都是
Content-Disposition: form-data; name="表单域的名字";

表单域的内容

而每一个文件单元里,都是
Content-Disposition: form-data; name="表单域的名字"; filename="文件全路径"
Content-Type: 文件类型

文件的二进制内容

那么,是不是直接用
split(formdata,"-----------------------------7d22131090458")
就可以得到各个单元了呢?答案是否定的。首先,formdata不是字符串而是二进制串,不能用split的方法;其次,这里的7d22131090458并不固定,每次都会有变化,并不适合做分隔符。所以,应该用一个更保险的办法。想到没?很简单——就用formdata的第一行做分隔符。只要用instrb函数得到换行符的位置,然后用leftb或midb函数截取数据就行了。我们动手试试:
<%
' 二进制的回车<return>
bncrlf=chrB(13) & chrB(10)

' 得到formdata
formsize=request.totalbytes
formdata=request.binaryread(formsize)

' 得到分隔符
divider=leftB(formdata,clng(instrb(formdata,bncrlf))-1)

' 看看对不对?
response.BinaryWrite(divider)
%>

运行。。。成功了!得到了需要的divider。注意,这里的字符串函数都是针对二进制数据操作的,所以,用的是他们的二进制版,加了“b”(binary的首字母)——instrb,leftb(以后可能还出现rightb,midb,lenb。。等等)。毕竟,formdata是用“binaryread()”得到的嘛。好了,有的分隔符,就可以得到数据了。我们从简单的开始,先拿第一个单元出来看看,目标是得到表单域名称和数据。
<%
' 这是回车<return>
bncrlf=chrB(13) & chrB(10)

' 得到数据
formsize=request.totalbytes
formdata=request.binaryread(formsize)

' 得到divider,分隔符
divider=leftB(formdata,clng(instrb(formdata,bncrlf))-1)

' 起始位置
startpos = instrb(formdata,divider)+lenb(divider)+lenb(bncrlf)
' 终止位置,从起始位置开始到下一个divider
endpos = instrb(startpos, formdata, divider)-lenb(bncrlf)
part1 = midb(formdata, startpos, endpos-startpos)
response.BinaryWrite(part1)
%>

这一段有注释,相信大家没问题。如果对这些函数不了解,可以到http://www.2yup.com/ASP/referrence/index.ASP下载msdn参考看看vbscript的函数用法,对提高水平有很大帮助。
这时候得到的结果可以通过查看生成的HTML源的方式看到:
Content-Disposition: form-data; name="file1_desc"

file1的说明

好了,离成功又进一步!
下来只要分别读取part1里name="和第一个“双引号+回车”之间的内容就可以得到表单域的名称;读取连续两个回车之后的内容就可以得到表单域的值了。下面一段顺理成章:
<%
' 这就是name="
const_nameis=chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 这是回车<return>
bncrlf=chrB(13) & chrB(10)

' 得到数据
formsize=request.totalbytes
formdata=request.binaryread(formsize)

' 得到divider,分隔符
divider=leftB(formdata,clng(instrb(formdata,bncrlf))-1)

' 起始位置
startpos = instrb(formdata,divider)+lenb(divider)+lenb(bncrlf)
' 终止位置,从起始位置开始到下一个divider
endpos = instrb(startpos, formdata, divider)-lenb(bncrlf)
part1 = midb(formdata, startpos, endpos-startpos)

' 得到表单域名称,就是<input type=sometype name=somename>里的somename。
fldname = midb(part1,_
instrb(part1, const_nameis)+lenb(const_nameis),_
instrb(part1, bncrlf)-instrb(part1,const_nameis)-lenb(const_nameis)-1)
' 得到表单域的值
fldvalue = midb(part1,_
instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
lenb(part1)-instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf))

' 检查一下?可以每次打开一个注释,分别检查。
'response.binarywrite(fldname)
'response.binarywrite(fldvalue)
%>

执行一下?呵呵,没问题啦,分别打开注释,会在IE里看到“file1_desc”和“file1的说明”。
当然,这是得到文本单元的方法,不过看看上边的原始数据就知道,得到文件单元方法可以说是基本相同,只不过:
1。需要额外得到filename=""里的值,也就是文件全路径;
2。需要额外得到Content-Type: 后边的值,也就是文件的类型。
这个工作就是体力劳动了,相信大家没问题。现在更大的精力应该放在:怎么得到所有的段落内容?想来应该是某种形式的循环,但是,具体怎么做?还有,怎么样组织得到的东西,才不显得凌乱?

呵呵,不早了,这个就是咱今天晚上要做的梦了。明天来,咱就一起解决这个问题。。。。


==============================================================
第三天:得到所有的文本单元

wake up!继续啦~~~~~
昨天,我们已经找到了得到一个单元的信息的办法,不过,还没有到实用阶段。毕竟,想实用,还至少要:
对于文本单元,能按名称检索的内容;
对于文件单元,能按名称得到文件的具体内容、类型、全路径、以及大小等信息。
今天,我们就首先着手解决文本单元的问题。

得到内容也许不难,可是,怎么组织才能使这个过程井井有条,才能符合我们的一般习惯?我们可以从现有的知识里找答案。
大家都知道,ASP有一个内置对象request,他的功能是得到用户请求的相关信息,包括表单域的值。粗看上去,他的form集合的用法和我们要实现的得到文本单元内容的功能是很近似的,我们来看看request.form的几个应用的例子:

得到表单域的值 -
request.form("表单域名称")或request.form("表单域在<form></form>里的序号")
得到同名表单域的各个元素 -
request.form("表单域名称")(i)或request.form("表单域在<form></form>里的序号")(i)
得到同名表单域的个数 -
request.form("表单域名称").Count或request.form("表单域在<form></form>里的序号").Count

如果我们能够用ourRequest.form("name"),ourRequest.form(index),ourRequest.form("name").count,ourRequest.form(index).count这样的方式,或是与之相近的方式,不就可以很好的和request对象对应起来么?而且,因为对request对象本身的熟悉,也会降低使用我们自己方法的时候的门槛,相对于写一堆getValue(name)函数这样的方法,更不容易出错,扩展性更好更灵活,可读性也好得多。那么,我们就看看如果要实现自己的request对象,都有哪些工作要做。

首先,ourRequest应该是一个对象,有自己的属性和方法。只有这样,才可能和现有的request对象做呼应。在vbs5里面,已经可以通过Class关键字,来实现自己的类了,所以,可行性上是没有问题的,只要我们自己定义一个类,然后实例化他,就可以得到我们所需的对象;
其次,因为ourRequest.form可以用名称和序号检索,所以,应该提供比较丰富的访问方式;
第三,在表单里有多个域名称相同的时候(比如多个checkbox),应该能够得到其中的各个元素,并且可以得到总个数。所以,ourRequest.form()得到的,应该也是一个可以检索的对象,而且有Count属性。

最终,结合vbscript的语言特点,兼顾开发效率,我们决定实现这样的几个类:
A。UploadRequest
这个类和request对象是对应的
属性:
RawData 得到原始数据,方便检查[只读]
Forms 得到一个有count属性的计数器,
可以用outRequest.Forms.Count的方式,得到文本表单域的的个数[只读]
Form(index) 可以用数字或文本检索文本表单域,做用类似request.form。
他返回一个FormElement型的对象
B。FormElement
可以把它看成单个表单域的化身。通过这个类,可以得到详细的表单域信息,比如name,value等等。如果有多个value(比如checkbox的情况),还可以选择用序号索引
属性:
Value 得到表单域的值。如果有多个(比如checkbox),
返回所有的,用逗号分隔[默认]
Name 得到表单域的名称
Item(index) 用数字索引多个值中的某一个
Count 得到对应一个name,所拥有的value的个数。主要用于checkbox[只读]
C。Counter
一个辅助类,就是为了实现outRequest.Forms.Count功能。这里写的并不好,不过考虑大家的理解方便,先暂时这样。
属性:
Count 得到Count
方法:
setCount 设置Count


下面,我们就来看看这几个类的实现:
<%
Class FormElement

' m_开头,表示类成员变量。
Private m_dicItems

Private Sub Class_Initialize()
Set m_dicItems = Server.CreateObject("Scripting.Dictionary")
End Sub

' count是咱们这个类的一个只读属性
Public Property Get Count()
Count = m_dicItems.Count
End Property

' Value是一个默认属性。目的是得到值
Public Default Property Get Value()
Value = Item("")
End Property

' Name是得到文本域名称。就是<input name=xxx>里的xxx
Public Property Get Name()
Keys = m_dicItems.Keys
Name = Keys(0)
Name = left(Name,instrrev(Name,"_")-1)
End Property

' Item属性用来得到重名表单域(比如checkbox)的某一个值
Public Property Get Item(index)
If isNumeric(index) Then '是数字,合法!
If index > m_dicItems.Count Then
err.raise 1,"IndexOutOfBound", "表单元素子集索引越界"
End If
Itms = m_dicItems.Items
Item = Itms(index)
ElseIf index = "" Then '没给值?那就返回所有的!逗号分隔
Itms = m_dicItems.Items
For i = 0 to m_dicItems.Count-1
If i = 0 Then
Item = Itms(0)
Else
Item = Item & "," & Itms(i)
End If
Next
Else '给个一个不是数字的东东?出错!
err.raise 2,"IllegalArgument", "非法的表单元素子集索引"
End If
End Property

Public Sub Add(key, item)
m_dicItems.Add key, item
End Sub

End Class

Class UploadRequest

Private m_dicForms
Private m_bFormdata

Private Sub Class_Initialize()
Set m_dicForms = Server.CreateObject("Scripting.Dictionary")
Call fill()
End Sub

' 有了这个,就可以检查原始数据了
Public Property Get RawData()
RawData = m_bFormdata
End Property

' 这一段丑陋的代码是为了实现outRequest.Forms.Count这个功能。
Public Property Get Forms()
Set Forms = New Counter
Forms.setCount(m_dicForms.Count)
End Property

Public Property Get Form(index)
If isNumeric(index) Then '是数字?用数字来检索
If index > m_dicForms.Count Then
err.raise 1,"IndexOutOfBound", "表单元素索引越界"
End If
Items = m_dicForms.Items
Set Form = Items(index)
ElseIf VarType(index) = 8 Then '字符串?也行!
If m_dicForms.Exists(index) Then '存在,就返回值
Set Form = m_dicForms.Item(index)
Else '不存在,就给个空值——request对象就是这么做的。
Exit Property
End If
Else '给了一个不是数字也不是字符串的东东?出错!
err.raise 2,"IllegalArgument", "非法的表单元素索引"
End If
End Property

Private Sub fill
' 得到数据
m_bFormdata=request.binaryread(request.totalbytes)
' 调用这个函数实现递归循环,读取文本单元
Call fillEveryFirstPart(m_bFormdata)
End Sub

Private Sub fillEveryFirstPart(data)
' 这就是name="
const_nameis=chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 这就是filename="
const_filenameis=chrb(102)&chrb(105)&chrb(108)&chrb(101)&_
chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 这是回车<return>
bncrlf=chrb(13) & chrb(10)
' 得到divider,分隔符
divider=leftb(data,instrb(data,bncrlf)-1)
' 起始位置
startpos = instrb(data,divider)+lenb(divider)+lenb(bncrlf)
' 终止位置,从起始位置开始到下一个divider
endpos = instrb(startpos, data, divider)-lenb(bncrlf)
If endpos < 1 Then '没有下一个了!结束!
Exit Sub
End If
part1 = midb(data, startpos, endpos-startpos)
' 得到part1的第一行
firstline = midb(part1, 1, instrb(part1, bncrlf)-1)

'没有filename=",有name=",说明是一个文本单元(这里有一个BUG,自己研究一下?当作业吧)
If Not instrb(firstline, const_filenameis) > 0_
And instrb(firstline, const_nameis) > 0 Then
' 得到表单域名称,就是<input type=sometype name=somename>里的somename。
fldname = B2S(midb(part1,_
instrb(part1, const_nameis)+lenb(const_nameis),_
instrb(part1, bncrlf)_
-instrb(part1, const_nameis)-lenb(const_nameis)-1))
' 得到表单域的值
fldvalue = B2S(midb(part1,_
instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
lenb(part1)-instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf)))
If m_dicForms.Exists(fldname) Then
Set fElement = m_dicForms.Item(fldname)
m_dicForms.Remove fldname
Else
Set fElement = new FormElement
End If

fElement.Add fldname&"_"&fElement.Count, fldvalue
m_dicForms.Add fldname, fElement

End If

' 截取剩下的部分,递归调用这个函数,来得到下一个part1。
Call fillEveryFirstPart(rightb(data, lenb(data)-endpos-1))
End Sub

' 这是一个公用函数,作用是二进制和字符串的转换
Private Function B2S(bstr)
If not IsNull(bstr) Then
for i = 0 to lenb(bstr) - 1
bchr = midb(bstr,i+1,1)
If ascb(bchr) > 127 Then '遇到了双字节,就得两个字符一起处理
temp = temp & chr(ascw(midb(bstr, i+2, 1) & bchr))
i = i+1
Else
temp = temp & chr(ascb(bchr))
End If
next
End If
B2S = temp
End Function

End Class

' 这是一个辅助类,为了实现outRequest.Forms.Count功能。
Class Counter
Private m_icnt

' count是咱们这个类的一个只读属性
Public Property Get Count()
Count = m_icnt
End Property

Public Function setCount(cnt)
m_icnt = cnt
End Function
End Class
%>

<%
'下面是测试码
set outRequest = new UploadRequest
%>

<%=outRequest.Form(0).Name%>:<%=outRequest.Form("file1_desc")%><br>
<%=outRequest.Form(1).Name%>:<%=outRequest.Form("file2_desc")%><br>
<%=outRequest.Form(2).Name%>:<%=outRequest.Form(2).Count%><br>
<%=outRequest.Form(3).Name%>:<%=outRequest.Form(3)%><hr>

一共有<%=outRequest.Forms.Count%>个文本单元

这里的注释很详细,而且,每一个类的属性和方法都很少,所以相信基础好的朋友读懂是没有问题的。对应的,我们的测试表单也改成了:
<form action="doupload.ASP" method=post enctype="multipart/form-data">
file1说明:<input type=text name=file1_desc> &nbsp;
file1<input type=file name=file1><br>
file2说明:<input type=text name=file2_desc> &nbsp;
file2<input type=file name=file2><br>
<input type=checkbox name=chk value=a>a
<input type=checkbox name=chk value=b>b
<input type=checkbox name=chk value=c>c
<input type=checkbox name=chk value=d>d
<input type=checkbox name=chk value=e>e<hr>
<input type=submit name=upload value=upload>
</form>

注意,这里的每一个文本表单域都要填上,因为测试码给得很特殊,读了0,1,2,3各个项目的值,测试了各个属性。不过,现实情况下,因为事先知道表单域的名称;即使不知道,也可以用outRequest.Forms.Count来循环读取,所以是没问题的,不容易出错。

现在,试试看!怎么样?成功了吧 呵呵,中英文都没有问题,用法也很简单,很清晰。现在,我们就可以说基本上解决了文本域的读取问题。

--------------------------------------------------------
今天这一段是很有挑战性的。我写了两个多小时。对于尚处于初级的朋友,可能会觉得有些吃力。其实,关键在于深刻的理解类的概念,如果这一点没有问题,那么,理解这些代码就不在话下了。对了,今天的代码里有一个比较明显的BUG(我故意放的,当然,肯定还有不少不明显的BUG ),有兴趣的朋友可以当做作业来检验一下自己的水平。
因为今天要掌握的内容比较多,所以,明天暂停一天,给大家一个消化的机会(我也顺便偷个懒)。。。如果有疑问,请用下面的“我要提问”连接提出。
现在轻松啦,可以上床虎虎了。。。


==============================================================
第四天:休息,休息一下

今天大家可要好好消化一下昨天的东西啦。。正好,我也歇歇。对了,有不明白的,点下面的“我要提问”连接提出,我会在论坛里解答。毕竟这里的“我要评论”显示效果差一些,也不能查询。谢谢大家合作 ^ ^


第七天:实现附加功能

今天,我们就来实现昨天提出的方法和属性,来完善我们的文件上传类。以前没有太注意的性能问题,这一次也要彻底的解决:
1。所有的变量先声明,后使用;
2。设置类的teminate方法;

3。简化有些地方的写法,注意细节。
我们的原则,就是先实现,后优化。当然,象变量声明这样的东西,如果程序很大,最好还是在写程序的时候一次过。如果写完了才加,可以在页面开头加上option explicit(强制变量声明),然后测试所有的方法和属性,直到没有错误为止。

另外,异常代码我们也整理一下:
代码 类名 类型 描述
==============================================================================
11 FormElement IndexOutOfBound 表单元素子集索引越界
12 FormElement IllegalArgument 非法的表单元素子集索引
21 UploadRequest IndexOutOfBound 文本元素索引越界
22 UploadRequest IllegalArgument 非法的文本元素索引
23 UploadRequest IndexOutOfBound 文件元素索引越界
24 UploadRequest NullRef 文件元素索引不存在
25 UploadRequest IllegalArgument 非法的表单元素索引
26 UploadRequest TooLargeFile 文件%fldname尺寸过大
27 UploadRequest TooLargeFiles 文件总尺寸过大
28 UploadRequest InvalidFileType 文件%fldname类型错误

好了,下面的,就是我们的整个实现了:
1。com.2yup.util.uploadrequest.class
<%
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 没有版权,欢迎拷贝或是作为商业用途。
' 如果要转载,能注明出处最好,我们会很感激您的支持;如果不方便,就算了,呵呵。
' 感谢各位常来2yup的网友(很多名字,写不下了,呵呵)长期热情的支持,
' 你们是我持久的动力。
'
' 关于这个组件的详细信息,以及编程的全过程,可以来
' http://www.2yup.com/ASP
' 的文档中心看个究竟。有任何疑问,欢迎来我们的论坛讨论,或是给我发email:
' miles2yup@hotmail.com
' ---- Miles [Yup Studio] ^ ^
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'=========================================================================
'' 这个,是存储文本域信息的的类。每一个name的文本域,对应一个这样的类。
'=========================================================================
Class FormElement

' m_开头,表示类成员变量。
Private m_dicItems

Private Sub Class_Initialize()
Set m_dicItems = Server.CreateObject("Scripting.Dictionary")
End Sub

' set nothing时激发。清理资源
Private Sub Class_Terminate()
Set m_dicItems = Nothing
End Sub

' count是咱们这个类的一个只读属性
Public Property Get Count()
Count = m_dicItems.Count
End Property

' Value是一个默认属性。目的是得到值
Public Default Property Get Value()
Value = Item("")
End Property

' Name是得到文本域名称。就是<input name=xxx>里的xxx
Public Property Get Name()
Dim Keys
Keys = m_dicItems.Keys
Name = Keys(0)
Name = left(Name,instrrev(Name,"_")-1)
End Property

' Item属性用来得到重名表单域(比如checkbox)的某一个值
Public Property Get Item(index)
Dim Items, i
If isNumeric(index) Then '是数字,合法!
If index > m_dicItems.Count-1 Then
err.raise 11,"IndexOutOfBound", "表单元素子集索引越界"
End If
Items = m_dicItems.Items
Item = Items(index)
ElseIf index = "" Then '没给值?那就返回所有的!逗号分隔
Items = m_dicItems.Items
For i = 0 to m_dicItems.Count-1
If i = 0 Then
Item = Items(0)
Else
Item = Item & "," & Items(i)
End If
Next
Else '给个一个不是数字的东东?出错!
err.raise 12,"IllegalArgument", "非法的表单元素子集索引"
End If
End Property

Public Sub Add(key, item)
m_dicItems.Add key, item
End Sub

End Class

'=========================================================================
'' 这个,是存储文件域信息的的类。每一个name的文件,对应一个这样的类。
'=========================================================================
Class FileElement

' m_开头,表示类成员变量。
Private m_strName
Private m_bData
Private m_bRawData
Private m_strContentType
Private m_strFilePath
Private m_strFileName
Private m_lSize

' Data是一个默认属性。目的是得到值
Public Default Property Get Data()
Data = m_bData
End Property

' 这个属性很尴尬——stream对象write方法要求的数据类型是
' "A Variant that contains an array of bytes to be written."
' 但是我却无法从一个二进制串中得到这个数据类型!的确很奇怪。所以,我打算
' 使用符合要求的原始数据m_bRawData。但是,vbs的类功能少得可怜,既不能传递
' 当前对象的引用来回访UploadRequest的m_bRawData也不能用inner class的方
' 法进行组织。为了保持方法的简洁,所以加了这个只写的RawData属性。
' 这个地方很值得改进。
Public Property Let RawData(data)
m_bRawData = data
End Property

' Name是得到文件域名称,就是<input type=file name=xxx>里的xxx
Public Property Get Name()
Name = m_strName
End Property

' ContentType是得到文件contentType
Public Property Get ContentType()
ContentType = m_strContentType
End Property

' FilePath是得到文件在客户端的路径
Public Property Get FilePath()
FilePath = m_strFilePath
End Property

' FilePath是得到文件在客户端的路径
Public Property Get FileName()
FileName = m_strFileName
End Property

' Size是得到文件大小
Public Property Get Size()
Size = m_lSize
End Property

Public Sub Add(name, data, contenttype, path)
m_strName = name
m_bData = data
m_strContentType = contenttype
m_strFilePath = path
m_strFileName = right(path, len(path)-instrrev(path, "\"))
m_lSize = lenb(data)
End Sub

Public Sub SaveTo(path)
Call SaveAs(path, m_strFileName)
End Sub

Public Sub SaveAs(path, name)
Call Save(path, name, True)
End Sub

Public Sub SaveWithoutOverwrite(path, name)
Call Save(path, name, False)
End Sub

Private Sub Save(path, name, isOverwrite)
Dim st, st2
'这样就可以兼顾c:\xxx\和c:\xxx两种格式了
If right(path,1) <> "\" Then path = path & "\"
'用两个stream对象,来截取我们要的内容
Set st = Server.CreateObject("ADODB.Stream")
Set st2 = Server.CreateObject("ADODB.Stream")
st.Type = 1
st.open
st2.Type = 1
st2.open
st.write m_bRawData
st.Position = instrb(m_bRawData,m_bData)-1
st.copyto st2, m_lSize

If isOverwrite Then '覆盖保存
st2.SaveToFile path & name,2
Else '不覆盖
st2.SaveToFile path & name
End If

st.Close
Set st = Nothing
st2.Close
Set st2 = Nothing
End Sub

End Class

'=========================================================================
'' 这个,是我们模拟的request类。我们用它完成ASP的request完成不了的任务 :)
'=========================================================================
Class UploadRequest

Private m_dicForms
Private m_dicFiles
Private m_bRawData
Private m_lTotalBytes
Private m_strAllowedFilesList
Private m_strDeniedFilesList
Private m_lMaxFileSize
Private m_lTotalMaxFileSize

'初始化类成员
Private Sub Class_Initialize()
m_lTotalBytes = 0
m_strAllowedFilesList = ""
m_strDeniedFilesList = ""
m_lMaxFileSize = -1
m_lTotalMaxFileSize = -1
End Sub

' set nothing时激发。清理资源
Private Sub Class_Terminate()
' 这些对象应该有自己的清理方法,咱就不管了
Set m_dicForms = Nothing
Set m_dicFiles = Nothing
End Sub

Public Sub Upload
Set m_dicForms = Server.CreateObject("Scripting.Dictionary")
Set m_dicFiles = Server.CreateObject("Scripting.Dictionary")
Call fill()
End Sub

'存文件到指定路径
Public Sub SaveTo(path)
Dim fElement
'调用FileElement自己的方法
For Each fElement In m_dicFiles
Call m_dicFiles.Item(fElement).SaveTo(path)
Next
End Sub

' 有了这个,就可以检查原始数据了
Public Property Get RawData()
RawData = m_bRawData
End Property

' 这一段丑陋的代码是为了实现ourRequest.Forms.Count这个功能。这个地方值得改进。
Public Property Get Forms()
Set Forms = New Counter
Forms.setCount(m_dicForms.Count)
End Property

' 这一段丑陋的代码是为了实现ourRequest.Files.Count这个功能。这个地方值得改进。
Public Property Get Files()
Set Files = New Counter
Files.setCount(m_dicFiles.Count)
End Property

'只读的TotalBytes属性
Public Property Get TotalBytes()
TotalBytes = m_lTotalBytes
End Property

'只写的AllowedFilesList属性,填入允许类型的扩展名,用|分隔
Public Property Let AllowedFilesList(afl)
m_strAllowedFilesList = afl
End Property

'只写的DeniedFilesList属性,填入允许类型的扩展名,用|分隔
Public Property Let DeniedFilesList(dfl)
m_strDeniedFilesList = dfl
End Property

'只写的MaxFileSize属性,填入各个允许上传文件的大小
Public Property Let MaxFileSize(mfs)
m_lMaxFileSize = mfs
End Property

'只写的TotalMaxFileSize属性,填入允许上传文件的总大小
Public Property Let TotalMaxFileSize(tmfs)
m_lTotalMaxFileSize = tmfs
End Property

Public Property Get Form(index)
Dim Items
If isNumeric(index) Then '是数字?用数字来检索
If index > m_dicForms.Count-1 Then
err.raise 21,"IndexOutOfBound", "文本元素索引越界"
End If
Items = m_dicForms.Items
Set Form = Items(index)
ElseIf VarType(index) = 8 Then '字符串?也行!
If m_dicForms.Exists(index) Then '存在,就返回值
Set Form = m_dicForms.Item(index)
Else '不存在,就给个空值——request对象就是这么做的。
Exit Property
End If
Else '给了一个不是数字也不是字符串的东东?出错!
err.raise 22,"IllegalArgument", "非法的文本元素索引"
End If
End Property

Public Property Get File(index)
Dim Items
If isNumeric(index) Then '是数字?用数字来检索
If index > m_dicFiles.Count-1 Then
err.raise 23,"IndexOutOfBound", "文件元素索引越界"
End If
Items = m_dicFiles.Items
Set File = Items(index)
ElseIf VarType(index) = 8 Then '字符串?也行!
If m_dicFiles.Exists(index) Then '存在,就返回值
Set File = m_dicFiles.Item(index)
Else '不存在,出错!
err.raise 24,"NullRef", "文件元素索引不存在"
End If
Else '给了一个不是数字也不是字符串的东东?出错!
err.raise 25,"IllegalArgument", "非法的表单元素索引"
End If
End Property

Private Sub fill
' 得到数据
m_bRawData=request.binaryread(request.totalbytes)
' 调用这个函数实现递归循环,读取文本/文件单元
Call fillEveryFirstPart(m_bRawData)
End Sub

Private Sub fillEveryFirstPart(data)
Dim const_nameis, const_filenameis, bncrlf, divider, startpos, endpos
Dim part1, firstline
Dim fldname, fldvalue, fElement, filepath, contenttype, ext, afl, dfl
Dim isTypeError, i

' 这就是name="
const_nameis=chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 这就是filename="
const_filenameis=chrb(102)&chrb(105)&chrb(108)&chrb(101)&_
chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
' 这是回车<return>
bncrlf=chrb(13) & chrb(10)
' 得到divider,分隔符
divider=leftb(data,instrb(data,bncrlf)-1)
' 起始位置
startpos = instrb(data,divider)+lenb(divider)+lenb(bncrlf)
' 终止位置,从起始位置开始到下一个divider
endpos = instrb(startpos, data, divider)-lenb(bncrlf)
If endpos < 1 Then '没有下一个了!结束!
Exit Sub
End If
part1 = midb(data, startpos, endpos-startpos)
' 得到part1的第一行
firstline = midb(part1, 1, instrb(part1, bncrlf)-1)

'没有filename=",有name=",说明是一个文本单元
'(这里有一个BUG,自己研究一下?当作业吧)
If Not instrb(firstline, const_filenameis) > 0_
And instrb(firstline, const_nameis) > 0 Then
' 得到表单域名称,就是<input type=sometype name=somename>里的somename。
fldname = B2S(midb(part1,_
instrb(part1, const_nameis)+lenb(const_nameis),_
instrb(part1, bncrlf)_
-instrb(part1, const_nameis)-lenb(const_nameis)-1))
' 得到表单域的值
fldvalue = B2S(midb(part1,_
instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
lenb(part1)-instrb(part1, bncrlf&bncrlf)+_
lenb(bncrlf&bncrlf)))
If m_dicForms.Exists(fldname) Then
Set fElement = m_dicForms.Item(fldname)
m_dicForms.Remove fldname
Else
Set fElement = new FormElement
End If

fElement.Add fldname&"_"&fElement.Count, fldvalue
m_dicForms.Add fldname, fElement

'有filename=",有name=",说明是一个文件单元
'(这里还是有一个BUG,研究出来没?)
ElseIf instrb(firstline, const_filenameis) > 0_
And instrb(firstline, const_nameis) > 0 Then
' 得到表单域名称,就是<input type=file name=somename>里的somename。
fldname = B2S(midb(part1,_
instrb(part1, const_nameis)+lenb(const_nameis),_
instrb(part1, const_filenameis)_
-instrb(part1, const_nameis)-lenb(const_nameis)-3))
' 得到表单域的值
fldvalue = midb(part1,_
instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
lenb(part1)-instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf))
' 得到路径
filepath = B2S(midb(part1,_
instrb(part1, const_filenameis)+lenb(const_filenameis),_
instrb(part1, bncrlf)_
-instrb(part1, const_filenameis)-lenb(const_filenameis)-1))
' 得到contenttype
contenttype = B2S(midb(part1,_
instrb(part1, bncrlf)+lenb(bncrlf)+14,_
instrb(part1,_
bncrlf&bncrlf)-instrb(part1, bncrlf)-_
lenb(bncrlf)-14))
If lenb(fldvalue) > 0 Then 'size>0说明有文件传来了。
If m_dicFiles.Exists(fldname) Then
Set fElement = m_dicFiles.Item(fldname)
m_dicFiles.Remove fldname
Else
Set fElement = new FileElement
fElement.Rawdata = m_bRawData
End If

'检查单个文件尺寸
If m_lMaxFileSize > 0 And m_lMaxFileSize < lenb(fldvalue) Then _
err.raise 26,"TooLargeFile", "文件"&fldname&"尺寸过大"
m_lTotalBytes = m_lTotalBytes + lenb(fldvalue)
'检查文件总尺寸
If m_lTotalMaxFileSize > 0 And m_lTotalMaxFileSize < m_lTotalBytes Then
err.raise 27,"TooLargeFiles", "文件总尺寸过大"
End If
'检查文件类型
ext = right(filepath, len(filepath)-instrrev(filepath, "."))
If m_strAllowedFilesList <> "" Then
afl = Split(m_strAllowedFilesList,"|")
isTypeError = True
For i = 0 To Ubound(afl)
'找到了,允许
If ucase(trim(ext)) = ucase(trim(afl(i))) Then
isTypeError = False
Exit For
End If
Next
If isTypeError Then _
err.raise 28,"InvalidFileType", "文件"&fldname&"类型错误"
End If
If m_strDeniedFilesList <> "" Then
dfl = Split(m_strDeniedFilesList,"|")
For i = 0 To Ubound(dfl)
'找到了,不允许
If ucase(trim(ext)) = ucase(trim(dfl(i))) Then _
err.raise 28,"InvalidFileType", "文件"&fldname&"类型错误"
Next
End If

fElement.Add fldname, fldvalue, contenttype, filepath
m_dicFiles.Add fldname, fElement
End If
End If

' 截取剩下的部分,递归调用这个函数,来得到下一个part1。
Call fillEveryFirstPart(rightb(data, lenb(data)-endpos-1))
End Sub

' 这是一个公用函数,作用是二进制和字符串的转换
Private Function B2S(bstr)
Dim bchr, temp, i
If not IsNull(bstr) Then
for i = 0 to lenb(bstr) - 1
bchr = midb(bstr,i+1,1)
If ascb(bchr) > 127 Then '遇到了双字节,就得两个字符一起处理
temp = temp & chr(ascw(midb(bstr, i+2, 1) & bchr))
i = i+1
Else
temp = temp & chr(ascb(bchr))
End If
next
End If
B2S = temp
End Function

End Class

' 这是一个辅助类,为了实现ourRequest.Forms.Count功能。
Class Counter
Private m_iCnt

' count是咱们这个类的一个只读属性
Public Property Get Count()
Count = m_iCnt
End Property

Public Function setCount(cnt)
m_iCnt = cnt
End Function
End Class
%>


2。testform.HTML
<form action="doupload.ASP" method=post enctype="multipart/form-data">
file1说明:<input type=text name=file1_desc>
file1:<input type=file name=file1><br>
file2说明:<input type=text name=file2_desc>
file2:<input type=file name=file2><br>
<input type=checkbox name=chk value=a>a
<input type=checkbox name=chk value=b>b
<input type=checkbox name=chk value=c>c
<input type=checkbox name=chk value=d>d
<input type=checkbox name=chk value=e>e<hr>
<input type=submit name=upload value=upload>
</form>


3。doupload.ASP
<%Option Explicit%>
<!--#INCLUDE FILE="com.2yup.util.uploadrequest.class"-->

<%
'下面是测试码
Dim ourRequest
set ourRequest = new UploadRequest
ourRequest.AllowedFilesList = "gif|doc"
ourRequest.DeniedFilesList = "jpg"
ourRequest.MaxFileSize = 10*1000 '10k
ourRequest.TotalMaxFileSize = 15*1000 '15k
on error resume next
ourRequest.Upload
if err.number <> 0 then
response.write err.description
response.end
end if
on error goto 0 '关闭on error resume next
%>

<%=ourRequest.Form(0).Name%>:<%=ourRequest.Form("file1_desc")%><br>
<%=ourRequest.Form(1).Name%>:<%=ourRequest.Form("file2_desc")%><br>
<%=ourRequest.Form(2).Name%>:<%=ourRequest.Form(2).Count%><br>
<%=ourRequest.Form(3).Name%>:<%=ourRequest.Form(3)%>

一共有<%=ourRequest.Forms.Count%>个文本单元<hr>

<%=ourRequest.File(0).Name%>:
<%=ourRequest.File("file1").ContentType%>:
<%=ourRequest.File("file1").Size%>byte:
<%=ourRequest.File("file1").FileName%>:
<%=ourRequest.File("file1").FilePath%><br>

<%=ourRequest.File(1).Name%>:
<%=ourRequest.File("file2").ContentType%>:
<%=ourRequest.File("file2").Size%>byte:
<%=ourRequest.File("file2").FileName%>:
<%=ourRequest.File("file2").FilePath%><br>

一共有<%=ourRequest.Files.Count%>个文件单元,共<%=ourRequest.TotalBytes%>Byte<hr>

<%
'测试存盘。
Dim desFolder:desFolder=server.mappath("incoming")
Call ourRequest.SaveTo(desFolder)
Call ourRequest.File(0).SaveAs(desFolder, "复件 "&ourRequest.File(0).FileName)
'因为选择了不覆盖的方法,所以第二次执行这一句会出错,一定要注意啊
Call ourRequest.File("file2").SaveWithoutOverwrite(desFolder,_
"复件 "&ourRequest.File(1).FileName)
%>

<%
'测试写库
If False Then '要测的话,就把False改成True。

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 数据库结构:
' ID 自增主键
' img access里,用ole对象型;在sql server里,就应该是image型了
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' 这部分没啥好说的。。
Dim connGraph, rec
set connGraph=server.CreateObject("ADODB.connection")
connGraph.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" &_
server.MapPath("img.mdb")
connGraph.Open
set rec=server.createobject("ADODB.recordset")
rec.Open "SELECT * FROM img where id is null",connGraph,1,3
rec.addnew
rec("img").appendchunk ourRequest.File(0)
rec.update
rec.close
set rec=nothing
set connGraph=nothing

' 读库代码如下。当然,读库显示是要在其他页面进行的。。
' 这部分也没啥好说的。不用contentType,IE也认。要是其他浏览器,就设一下。
'set connGraph=server.CreateObject("ADODB.connection")
'connGraph.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" &_
' server.MapPath("img.mdb")
'connGraph.Open
'set rec=server.createobject("ADODB.recordset")
'rec.Open "SELECT * FROM img order by id desc",connGraph,1,1
'response.BinaryWrite rec("img")
'rec.close
'set rec=nothing
'set connGraph=nothing
End If
%>

<%
'清理资源,别忘了啊
Set ourRequest = Nothing
%>


好了,把这3个文件保存到一个虚拟目录下,然后,建立一个incoming的子目录,并且给足权限(关于权限,看看http://www.2yup.com/ASP/forum/branch.ASP?pid=2430#F0002430),就可以测试了。现在,一个功能强大的无组件上传类就已经完成了。

==============================================================
结束语

这里演示了文件上传从分析倒实践的全过程。通过不懈的努力,我们终于达到了预定的目标。当然,这个实现,和“完美”尚有差距。他没有经过严格测试;还存在至少两个BUG;还有几个蹩脚的实现。这些,都是值的改进的。但是,如果能掌握这个示例的完整过程,相信大家也可以胜任各种复杂的应用,能够独立的完成一般的设计和编码工作了。所以,我们的收获,绝不仅仅是知道了怎样上传一个文件,更多的,是知道了怎样达到一个目标。最后,附上整个示例的源码和用到的库。刚刚(2002-12-02 09:00)才进行了更新,做了一个自认为比较清晰的例子。不需要看懂,就可以用了 ^ ^:

http://www.2yup.com/ASP/attach/A0000006.zip

注意,把这个包里的东西放到一个虚拟目录下,其中的incoming子目录一定要有IUSR的写权限(关于权限,看看http://www.2yup.com/ASP/forum/branch.ASP?pid=2430#F0002430)。有任何问题,请到论坛提出。
评论Feed 评论Feed: http://blog.xg98.com/feed.asp?q=comment&id=2920

这篇日志没有评论。

此日志不可发表评论。