文件上传类

<Script RunAt="Server" Language="VBScript">
'==========================================================================
'名称：文件上传类
'功能：无组件文件上传
'运行环境：ADO 2.5以上
'作者：jimzhu 请保留
'版本：2.0
'日期：2004-12-08
'==========================================================================
Dim FormStream
Class upload_OneSky
 Dim objForm,objFile
 Private ItemStream,iScriptTimeOut
' Dim dteBegin
 Property Get Form(strForm)
  strForm=LCase(strForm)
  If Not objForm.Exists(strForm) Then
   Form=""
  Else
   Form=objForm(strForm)
  End If
    End Property
 Property Get File(strFile)
  strFile=LCase(strFile)
  If Not objFile.Exists(strFile) Then
   Set File=New FileInfo
  Else
   Set File=objFile(strFile)
  End If
    End Property
 Private Sub Class_Initialize
  iScriptTimeOut=Server.ScriptTimeOut
  Server.ScriptTimeOut=900
'  dteBegin=Timer()
  '缓冲区尺寸
  Const iCacheShortSize=512
  Const iCacheSize=1048576 '1M '655360 '640KB
  Dim RequestData,CrLf,theFile
  Dim sInfo,iInfoEnd,sFormName,sFormValue
  Dim sCache,iCachePosition,iCachePoint
  Dim mbFind,miFindPoint,miFindPosition
  Dim sFormSplit,iLenFormSplit
  Dim iNextPosition,iStreamEnd,iFindStart,iFindEnd
  Set objForm=Server.CreateObject("Scripting.Dictionary")
  Set objFile=Server.CreateObject("Scripting.Dictionary")
  If Request.TotalBytes<1 Then Exit Sub
  Set FormStream = Server.CreateObject("AdoDB.Stream")
  '将Form提交的数据写入FormStream流，并读取整个流到RequestData
  FormStream.Type = 1 '1-adTypeBinary;2-adTypeText
  FormStream.Mode = 3 '0-adModeUnknown;1-adModeRead;3-adModeReadWrite
  FormStream.Open
  FormStream.Write Request.BinaryRead(Request.TotalBytes)
  iCachePosition=0
  sCache=ReadCache(iCachePosition,100)

  Set ItemStream = Server.CreateObject("ADODB.Stream")
  CrLf = ChrB(13) & ChrB(10)
  iStreamEnd = FormStream.Size
  '取得表单域分隔字符串
  sFormSplit = LeftB(sCache, InStrB(1,sCache,CrLf)-1)
  iLenFormSplit = LenB (sFormSplit)
  iCachePosition=iLenFormSplit
  sCache=ReadCache(iCachePosition,iCacheShortSize)
  While (iNextPosition+10) < iStreamEnd
   iCachePoint=1
   '取得Form Item Info结束位置
   iInfoEnd = InStrB(iCachePoint,sCache,CrLf & CrLf)+3
   '读取到sInfo
   sInfo = SubStreamText(iCachePosition,iInfoEnd-iCachePoint)
   '取得下一个表单域开始位置
   mbFind=False
   miFindPoint = InStrB(iInfoEnd,sCache,sFormSplit)
   If miFindPoint Then
    iNextPosition = iCachePosition+miFindPoint
    mbFind = True
   End If
   miFindPosition = iCachePosition+iCacheShortSize-iLenFormSplit
   Do While miFindPosition<iStreamEnd and (Not mbFind)
    sCache=ReadCache(miFindPosition,iCacheSize)
    miFindPoint = InStrB(1,sCache,sFormSplit)
    If miFindPoint Then
     iNextPosition = miFindPosition+miFindPoint
     mbFind = True
    End If
    miFindPosition = miFindPosition+iCacheSize-iLenFormSplit
   Loop
   '取得表单项目名称
   iFindStart = InStr(22,sInfo,"name=""",1)+6
   iFindEnd = InStr(iFindStart,sInfo,"""",1)
   sFormName = LCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
   '如果是文件
   If InStr (45,sInfo,"filename=""",1) > 0 Then
    Set theFile = New FileInfo
    '取得文件名
    iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
    iFindEnd = InStr(iFindStart,sInfo,"""",1)
    theFile.FullPath = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    '取得文件类型
    iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
    iFindEnd = InStr(iFindStart,sInfo,vbCr)
    theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    '取得文件Start&Size
    theFile.FileStart = iCachePosition+iInfoEnd
    theFile.FileSize = iNextPosition - (iCachePosition+iInfoEnd) -3
    theFile.FormName=sFormName
    '添加FileInfo对象
    If Not objFile.Exists(sFormName) Then objFile.Add sFormName,theFile
   Else
   '如果是表单项目
    '读取到sFormValue
    sFormValue = SubStreamText(iCachePosition+iInfoEnd,iNextPosition-(iCachePosition+iInfoEnd)-3)
    '添加Form Item
    If objForm.Exists(sFormName) Then
     objForm(sFormName)=objForm(sFormName) & "," & sFormValue
    Else
     objForm.Add sFormName,sFormValue
    End If
   End If
   iCachePosition=iNextPosition+iLenFormSplit
   sCache=ReadCache(iCachePosition,iCacheShortSize)
   iNextPosition=iCachePosition+1
  WEnd
  sCache=""
  Set ItemStream =Nothing
 End Sub
 Private Function SubStreamText(Position,Length)
  ItemStream.Type =1
  ItemStream.Mode =3
  ItemStream.Open
  FormStream.Position = Position
  FormStream.CopyTo ItemStream,Length
  ItemStream.Position = 0
  ItemStream.Type = 2
  ItemStream.Charset ="GB2312"
  SubStreamText = ItemStream.ReadText
  ItemStream.Close
 End Function
 Private Function ReadCache(Position,Length)
  FormStream.Position = Position
  ReadCache = FormStream.Read(Length)
 End Function
 Private Function FindNextPosition()
 End Function
 Private Sub Class_Terminate
  If Request.TotalBytes>0 Then
   objForm.RemoveAll
   objFile.RemoveAll
   Set objForm=Nothing
   Set objFile=Nothing
   FormStream.Close
   Set FormStream =Nothing
  End If
  Server.ScriptTimeOut=iScriptTimeOut
'  Response.Write "执行时间：<FONT COLOR=red>" & FormatNumber((Timer()-dteBegin),6) & "</FONT>秒。"
 End Sub
End Class

Class FileInfo
 Private m_FormName,m_FullPath,m_FileType,m_FileSize,m_FileStart
 Private Sub Class_Initialize
  m_FormName = ""
  m_FullPath = ""
  m_FileSize = 0
  m_FileStart = 0
  m_FileType = ""
 End Sub
 Property Let FormName(value)
  m_FormName=value
    End Property
 Property Get FormName()
  FormName=m_FormName
    End Property
 Property Let FullPath(value)
  m_FullPath=value
    End Property
 Property Get FullPath()
  FullPath=m_FullPath
    End Property
 Property Get FileName()
  FileName=GetFileName(m_FullPath)
    End Property
 Property Get FileExt()
  FileExt=getFileExt(m_FullPath)
    End Property
 Property Let FileType(value)
  m_FileType=value
    End Property
 Property Get FileType()
  FileType=m_FileType
    End Property
 Property Let FileSize(value)
  m_FileSize=value
    End Property
 Property Get FileSize()
  FileSize=m_FileSize
    End Property
 Property Let FileStart(value)
  m_FileStart=value
    End Property
 Public Function SaveAs(SaveFileName)
  Dim FileStream,ErrorChar,i
  SaveAs=False
  If Not(Trim(SaveFileName)="" or m_FileStart=0 or FileName="" or Right(SaveFileName,1)="/") Then
   Set FileStream=CreateObject("AdoDB.Stream")
   FileStream.Mode=3
   FileStream.Type=1
   FileStream.Open
   FormStream.Position=m_FileStart
   FormStream.CopyTo FileStream,m_FileSize
   FileStream.SaveToFile SaveFileName,2 '1-adSaveCreateNotExists;2-adSaveCreateOverwrite
   FileStream.Close
   Set FileStream=Nothing
   SaveAs=True
  End If
 End Function
 Public Function GetData()
  GetData=""
  If m_FileStart=0 Then Exit Function
  If Not m_FileSize Then
   FormStream.Position = m_FileStart
   GetData=FormStream.Read(m_FileSize)
  End If
 End Function
 Private Function GetFilePath(FullPath)
  If FullPath = "" Then
   GetFilePath = ""
  Else
   GetFilePath = Left(FullPath,InStrRev(FullPath, "/"))
  End If
 End  Function
 Private Function GetFileName(FullPath)
  If FullPath = "" Then
   GetFileName = ""
  Else
   GetFileName = Mid(FullPath,InStrRev(FullPath, "/")+1)
  End If
 End Function
 Private Function GetFileExt(ByVal FullPath)
  Dim iTmp
  GetFileExt = ""
  iTmp=InStrRev(FullPath, ".")
  If Not iTmp Then GetFileExt = LCase(Mid(FullPath,iTmp))
 End Function
End Class
Public Function GetTimeStr()
 GetTimeStr=Cstr(Date()) & "-" & Int(Timer()*1000)
End Function
</SCRIPT>