时间、空间性能极优的asp无组件上传类-ASP教程,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)*24*60*60,-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<thestart+thelen-1 then readchunk upload_stream
   upload_stream.position=thestart-1
   binary =upload_stream.read(thelen)
   if converttounicode then
    convertstream.type = 1
    convertstream.open
    convertstream.write binary
    convertstream.position = 0
    convertstream.type = 2
    substring = convertstream.readtext
    convertstream.close
   else
    substring = midb(binary,1)
   end if
  else
   substring = “”
  end if
 end function
 
 private sub readchunk(src)
  ’读一块，通过一次读64k，可以防止数据量过大时内存溢出
  if response.isclientconnected = false then raise “网络连接中断”
  bytesread = 65536
  src.position = src.size
  src.write request.binaryread(bytesread)
  end sub
 
 ’异常信息
 private sub raise(message)
 err.raise vbobjecterror, “quickupload”, message
 end sub
 private sub class_terminate  
    form.removeall
    file.removeall
    set form=nothing
    set file=nothing
    upload_stream.close
    set upload_stream=nothing
  convertstream.close
  set convertstream=nothing
  
 end sub
end class
class fileinfo
   private ffilename, ffiletype, ffilestart, ffilesize, fstream
 
 property get filename
  filename = ffilename
 end property
 
 property get filetype
  filetype = ffiletype
 end property
 
 property get filesize
  filesize = fstream.size
 end property
 
 property get stream
  set stream = fstream
 end property
 
   public sub init(afilename, afiletype) 
     ffilename = afilename
  ffiletype = afiletype
   end sub
  
 public function saveas(fullpath)
     dim dr,errorchar,i
  ’dstart = cdbl(time)
     saveas=1
     if trim(fullpath)=”” or right(fullpath,1)=”/” then exit function
     on error resume next
     fstream.savetofile fullpath,2
  if err.number>0 then response.write “保存数据出错：” & err.description & “<br>”
     saveas=0
  ’response.write “save time:” & formatnumber((cdbl(time)-dstart)*24*60*60,-1,-1) & “<br>”
   end function
   
 private sub class_initialize 
  set fstream=createobject(“adodb.stream”)
  fstream.mode=3
  fstream.type=1
  fstream.open
 end sub
 
 private sub class_terminate  
     fstream.close
     set fstream=nothing 
 end sub
end class