時(shí)間、空間性能極優(yōu)的asp無組件上傳類

在解碼速度方面，化境 2.0 已經(jīng)非常高了，但是，它還存在以下兩個(gè)問題：
1、用Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)一次讀取全部數(shù)據(jù)，以及用RequestData =Data_5xsoft.Read 一次取出全部數(shù)據(jù)，在上傳數(shù)據(jù)過大時(shí)，會(huì)由于內(nèi)存不足，導(dǎo)致上傳失敗，這里應(yīng)該采用分段讀取方式。
2、保存數(shù)據(jù)時(shí)，需要先從Data_5xsoft中復(fù)制到一個(gè)臨時(shí)流中，在保存大文件時(shí)，需要兩倍的存儲(chǔ)資源，在單機(jī)狀態(tài)下測(cè)試，可以發(fā)現(xiàn)保存時(shí)間隨文件尺寸急劇增長，甚至超過上傳和解碼時(shí)間。

本人所寫的這個(gè)類，采用在解碼的過程中，逐塊讀�。ㄗ⒁猓簤K的大小與速度不成正比，單機(jī)測(cè)試表明，64K的塊比1M的塊快得多）的方法，解決問題1，同時(shí)采用對(duì)普通數(shù)據(jù)，寫入工作流；對(duì)文件內(nèi)容，直接寫入文件自身的流的方式，解決問題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)
 
  '查找第一個(gè)邊界
  iStart = Search(Upload_Stream, ChrB(13)&ChrB(10), 1)
  '取邊界串
  boundary = subString(1, iStart-1, false)
  '不是結(jié)束邊界,則循環(huán)
  do while StrComp(subString(iStart, 2, false),ChrB(13)&ChrB(10))=0
   iStart = iStart+2
   '取表單項(xiàng)信息頭
   do while true
    iEnd = Search(Upload_Stream, ChrB(13)&ChrB(10), iStart)
    '分解信息頭
    line = subString(iStart, iEnd-iStart, true)
    '移動(dòng)位置
    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
      '取表單項(xiàng)名稱
      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
   '取表單項(xiàng)內(nèi)容
   if FileName<>"" then
    '新建文件內(nèi)容
    set theFile = new FileInfo
    theFile.Init FileName, ContentType
    '文件流內(nèi)容移到文件流中
    MoveData Upload_Stream, theFile.Stream, iStart
    '上傳數(shù)據(jù)直接傳入文件流，可以減少文件存儲(chǔ)時(shí)間
    iEnd = Search(theFile.Stream, boundary, 1)
    '后繼數(shù)據(jù)移入工作流
    MoveData theFile.Stream, Upload_Stream, iEnd-2
    '
    FFile.add FieldName, theFile
    '移動(dòng)位置
    iStart = iStart+2+LenB(boundary)
   else
    '查找邊界
    iEnd = Search(Upload_Stream, boundary, iStart)
    '取表單項(xiàng)內(nèi)容
    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
    '移動(dòng)位置
    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
   '取一段數(shù)據(jù)，約64K，可以減少內(nèi)存需求
   src.Position = iStart-1
   buf = src.Read
   '檢測(cè)邊界
   pos=InStrB(buf,str)
   '如果未找到,向后移動(dòng)
   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
   '當(dāng)長度不夠時(shí)，讀一塊數(shù)據(jù)
   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，可以防止數(shù)據(jù)量過大時(shí)內(nèi)存溢出
  if Response.IsClientConnected = false then Raise "網(wǎng)絡(luò)連接中斷"
  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 "保存數(shù)據(jù)出錯(cuò)：" & 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