时间、空间性能极优的asp无组件上传类

在解码速度方面，化境 2.0 已经非常高了，但是，它还存在以下两个问题：
1、用Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)一次读取全部数据，以及用RequestData =Data_5xsoft.Read 一次取出全部数据，在上传数据过大时，会由于内存不足，导致上传失败，这里应该采用分段读取方式。
2、保存数据时，需要先从Data_5xsoft中复制到一个临时流中，在保存大文件时，需要两倍的存储资源，在单机状态下测试，可以发现保存时间随文件尺寸急剧增长，甚至超过上传和解码时间。

本人所写的这个类，采用在解码的过程中，逐块读取（注意：块的大小与速度不成正比，单机测试表明，64K的块比1M的块快得多）的方法，解决问题1，同时采用对普通数据，写入工作流；对文件内容，直接写入文件自身的流的方式，解决问题2。

代码如下，用法类似于化境:

Server.ScriptTimeOut = 600

Class QuickUpload
Private FForm, FFile, Upload_Stream, ConvertStream

property get Form
set Form = FForm
end property

property get File
set File = FFile
end property

Private Sub Class_Initialize
dim iStart, iEnd, boundary, FieldName, FileName, ContentType, ItemValue, theFile, LineEnd

set FForm=CreateObject("Scripting.Dictionary")
set FFile=CreateObject("Scripting.Dictionary")
set Upload_Stream=CreateObject("Adodb.Stream")
Upload_Stream.mode=3
Upload_Stream.type=1
Upload_Stream.open
set ConvertStream = Server.CreateObject("adodb.stream")
ConvertStream.Mode =3
ConvertStream.Charset="GB2312"

if Request.TotalBytes<1 then Exit Sub

'dStart = CDbl(Time)

'查找第一个边界
iStart = Search(Upload_Stream, ChrB(13)&ChrB(10), 1)
'取边界串
boundary = subString(1, iStart-1, false)
'不是结束边界,则循环
do while StrComp(subString(iStart, 2, false),ChrB(13)&ChrB(10))=0
iStart = iStart+2
'取表单项信息头
do while true
iEnd = Search(Upload_Stream, ChrB(13)&ChrB(10), iStart)
'分解信息头
line = subString(iStart, iEnd-iStart, true)
'移动位置
iStart = iEnd+2
if Line="" then Exit do
pos = instr(line,":")
if pos>0 then
if StrComp(left(Line,pos-1),"Content-Disposition",1)=0 then
'取表单项名称
FieldName = ExtractValue(Line,pos+1,"name")
'取文件名称
FileName = ExtractValue(Line,pos+1,"filename")
'删除文件路径
FileName = Mid(FileName,InStrRev(FileName, "")+1)
elseif StrComp(left(Line,pos-1),"Content-Type",1)=0 then
'取文件类型
ContentType = trim(mid(Line,pos+1))
end if
end if
loop
'取表单项内容
if FileName<>"" then
'新建文件内容
set theFile = new FileInfo
theFile.Init FileName, ContentType
'文件流内容移到文件流中
MoveData Upload_Stream, theFile.Stream, iStart
'上传数据直接传入文件流，可以减少文件存储时间
iEnd = Search(theFile.Stream, boundary, 1)
'后继数据移入工作流
MoveData theFile.Stream, Upload_Stream, iEnd-2
'
FFile.add FieldName, theFile
'移动位置
iStart = iStart+2+LenB(boundary)
else
'查找边界
iEnd = Search(Upload_Stream, boundary, iStart)
'取表单项内容
ItemValue = subString(iStart, iEnd-2-iStart, true)
'
if FForm.Exists(FieldName) then
FForm.Item(FieldName) = FForm.Item(FieldName) & "," & ItemValue
else
FForm.Add FieldName, ItemValue
end if
'移动位置
iStart = iEnd+LenB(boundary)
end if
loop
'Response.Write "parse time:" & FormatNumber((CDbl(Time)-dStart)2460*60,-1,-1) & "

1<br/>

"
End Sub

Private Function Search(src, str, theStart)
iStart = theStart
pos=0
do while pos=0
'长度不够，读一块
if src.Size<(iStart+lenb(str)-1) then ReadChunk src
'取一段数据，约64K，可以减少内存需求
src.Position = iStart-1
buf = src.Read
'检测边界
pos=InStrB(buf,str)
'如果未找到,向后移动
if pos=0 then iStart = iStart+LenB(buf)-LenB(str)+1
loop
Search = iStart+pos-1
End function

private sub MoveData(Src, Dest, theStart)
Src.Position = theStart-1
Dest.Position = Dest.Size
Src.CopyTo dest
Src.Position = theStart-1
Src.SetEOS
end sub

private function ExtractValue(line,pos,name)
dim t, p
ExtractValue = ""
t = name + "="""
p = instr(pos,line,t)
if p>0 then
n1 = p+len(t)
n2 = instr(n1,line,"""")
if n2>n1 then ExtractValue = mid(line,n1,n2-n1)
end if
end function

Private Function subString(theStart,theLen, ConvertToUnicode)
if theLen>0 then
'当长度不够时，读一块数据
if Upload_Stream.Size

 1<thestart+thelen-1 "quickupload",="" "网络连接中断"="" 'dstart="CDbl(Time)" '异常信息="" '读一块，通过一次读64k，可以防止数据量过大时内存溢出="" afiletype)="" binary="" bytesread="65536" class="" class_terminate="" convertstream="nothing" convertstream.close="" convertstream.open="" convertstream.position="0" convertstream.type="2" convertstream.write="" converttounicode="" dim="" dr,errorchar,i="" else="" end="" err.number="" err.raise="" error="" exit="" ffilename="AFileName" ffilename,="" ffilesize,="" ffilestart,="" ffiletype="AFileType" ffiletype,="" file="nothing" file.removeall="" fileinfo="" filename="FFileName" filesize="FStream.Size" filetype="FFileType" form="nothing" form.removeall="" fstream="" fstream.savetofile="" fullpath,2="" function="" get="" if="" init(afilename,="" message="" next="" on="" or="" private="" property="" public="" raise="" raise(message)="" readchunk="" readchunk(src)="" request.binaryread(bytesread)="" response.isclientconnected="false" resume="" right(fullpath,1)="/" saveas="1" saveas(fullpath)="" set="" src.position="src.Size" src.write="" stream="FStream" sub="" substring="" then="" trim(fullpath)="" upload_stream="nothing" upload_stream.close="" upload_stream.position="theStart-1" vbobjecterror,="">0 then Response.Write "保存数据出错：" &amp; Err.Description &amp; "<br/>"   
 2SaveAs=0   
 3'Response.Write "save time:" &amp; FormatNumber((CDbl(Time)-dStart)*24*60*60,-1,-1) &amp; "<br/>"   
 4end function   
 5  
 6Private Sub Class_Initialize   
 7set FStream=CreateObject("Adodb.Stream")   
 8FStream.mode=3   
 9FStream.type=1   
10FStream.open   
11end sub   
12  
13Private Sub Class_Terminate   
14FStream.Close   
15set FStream=nothing   
16end sub   
17End Class</thestart+thelen-1>