开发学院WEB开发ASP 时间、空间性能极优的asp无组件上传类 阅读

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

 2005-04-26 10:31:46 来源:WEB开发网   
核心提示:在解码速度方面,化境 2.0 已经非常高了,时间、空间性能极优的asp无组件上传类,但是,它还存在以下两个问题:1、用Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)一次读取全部数据,可以减少内存需求 src.Position = iStart-1 bu

在解码速度方面,化境 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

Tags:时间 空间 性能

编辑录入:爽爽 [复制链接] [打 印]
[]
  • 好
  • 好的评价 如果觉得好,就请您
      0%(0)
  • 差
  • 差的评价 如果觉得差,就请您
      0%(0)
赞助商链接