asp上传

<%
'判断是否添加了文件
Dim ulFileName, ulResult

ulSaveToPath="/upload" '保存文件路径
ulMaxFileSize = 1000000 '文件大小限制 1000,000

ulResult = DoUploadFile(ulMaxFileSize, ulFileName)

Function DoUploadFile(MaxUpLoadSize, FileName)
    Dim Upload, File, formName, formPath, FileExt
    FileName = ""
    Set Upload = New upload_yfly '建立上传对象

 IF IsNull(Upload.File) THEN
  DoUploadFile= 6
  EXIT Function
 END IF
 
    IF Upload.File.Count = 0 Then
        DoUploadFile= 5 'No File uploaded
    Else
        Set File = Upload.File("ulFileToUpload")
        If File.FileName = "" Then
            DoUploadFile= 4 'No File uploaded
        Else
            '上传文件不是空的时候处理上传
            '在目录后加(/)
  formPath=upload.Form("ulSaveFilePath")
   
            If Right(formPath, 1) <> "/" Then
                formPath = formPath & "/"
            End If
   
            If File.FileSize < 100 Then
                DoUploadFile= 1 '文件大小太小
                Exit Function
            End If
       
            If File.FileSize > MaxUpLoadSize Then
                DoUploadFile= 2 '文件大小超过了限制
                Exit Function
            End If
 
            FileExt = LCase(Right(File.FileName, 4))
            uploadsuc = False
           
            If Not (FileExt = ".gif" Or FileExt = ".jpg") Then
                DoUploadFile= 3 '文件格式不正确
                Exit Function
            End If

            Randomize
            ranNum = Int(90000 * Rnd) + 10000
            '文件名
            FileName = formPath & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & ranNum & FileExt
   
            If File.FileSize > 0 Then       ''如果 FileSize > 0 说明有文件数据
                File.SaveAs server.mappath(FileName)   ''保存文件
            End If
            DoUploadFile= 0
        End If
        Set File = Nothing
    End If
    Set Upload = Nothing '删除此对象
End Function

%>

<SCRIPT RUNAT="SERVER" LANGUAGE="VBSCRIPT">

dim upfile_yfly_Stream

Class upload_yfly
 
dim Form,File,Version
 
Private Sub Class_Initialize
  dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
  dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
  Version=""
  File = NULL
  Form = Null
  upfile_yfly_Stream=NULL
  if Request.TotalBytes<1 then Exit Sub
  set Form=CreateObject("Scripting.Dictionary")
  set File=CreateObject("Scripting.Dictionary")
  set upfile_yfly_Stream=CreateObject("Adodb.Stream")
  upfile_yfly_Stream.mode=3
  upfile_yfly_Stream.type=1
  upfile_yfly_Stream.open
  upfile_yfly_Stream.write Request.BinaryRead(Request.TotalBytes)
  
  vbEnter=Chr(13)&Chr(10)
  iDivLen=inString(1,vbEnter)+1
  strDiv=subString(1,iDivLen)
  iFormStart=iDivLen
  iFormEnd=inString(iformStart,strDiv)-1
  while iFormStart < iFormEnd
    iStart=inString(iFormStart,"name=""")
    iEnd=inString(iStart+6,"""")
    mFormName=subString(iStart+6,iEnd-iStart-6)
    iFileNameStart=inString(iEnd+1,"filename=""")
    if iFileNameStart>0 and iFileNameStart<iFormEnd then
     iFileNameEnd=inString(iFileNameStart+10,"""")
     mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
     iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
     iEnd=inString(iStart+4,vbEnter&strDiv)
     if iEnd>iStart then
   mFileSize=iEnd-iStart-4
     else
   mFileSize=0
     end if
     set theFile=new FileInfo
     theFile.FileName=getFileName(mFileName)
     theFile.FilePath=getFilePath(mFileName)
     theFile.FileSize=mFileSize
     theFile.FileStart=iStart+4
     theFile.FormName=FormName
     file.add mFormName,theFile
    else
     iStart=inString(iEnd+1,vbEnter&vbEnter)
     iEnd=inString(iStart+4,vbEnter&strDiv)
  
     if iEnd>iStart then
   mFormValue=subString(iStart+4,iEnd-iStart-4)
     else
   mFormValue=""
     end if
     form.Add mFormName,mFormValue
    end if
  
    iFormStart=iformEnd+iDivLen
    iFormEnd=inString(iformStart,strDiv)-1
  wend
End Sub

Private Function subString(theStart,theLen)
 dim i,c,stemp
 upfile_yfly_Stream.Position=theStart-1
 stemp=""
 for i=1 to theLen
   if upfile_yfly_Stream.EOS then Exit for
   c=ascB(upfile_yfly_Stream.Read(1))
   If c > 127 Then
    if upfile_yfly_Stream.EOS then Exit for
    stemp=stemp&Chr(AscW(ChrB(AscB(upfile_yfly_Stream.Read(1)))&ChrB(c)))
    i=i+1
   else
    stemp=stemp&Chr(c)
   End If
 Next
 subString=stemp
End function

Private Function inString(theStart,varStr)
 dim i,j,bt,theLen,str
 InString=0
 Str=toByte(varStr)
 theLen=LenB(Str)
 for i=theStart to upfile_yfly_Stream.Size-theLen
   if i>upfile_yfly_Stream.size then exit Function
   upfile_yfly_Stream.Position=i-1
   if AscB(upfile_yfly_Stream.Read(1))=AscB(midB(Str,1)) then
    InString=i
    for j=2 to theLen
      if upfile_yfly_Stream.EOS then
        inString=0
        Exit for
      end if
      if AscB(upfile_yfly_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
        InString=0
        Exit For
      end if
    next
    if InString<>0 then Exit Function
   end if
 next
End Function

Private Sub Class_Terminate 
  if not isNull(Form) then
  form.RemoveAll
  set form=nothing
  end if
  if not isNull(File) then
  file.RemoveAll
  set file=nothing
  end if
  if not isNull(upfile_yfly_Stream) then
  upfile_yfly_Stream.close
  set upfile_yfly_Stream=nothing
  end if
End Sub
  
 
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "/"))
  Else
   GetFilePath = ""
  End If
 End  function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
  Else
   GetFileName = ""
  End If
 End  function

 Private function toByte(Str)
   dim i,iCode,c,iLow,iHigh
   toByte=""
   For i=1 To Len(Str)
   c=mid(Str,i,1)
   iCode =Asc(c)
   If iCode<0 Then iCode = iCode + 65535
   If iCode>255 Then
     iLow = Left(Hex(Asc(c)),2)
     iHigh =Right(Hex(Asc(c)),2)
     toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
   Else
     toByte = toByte & chrB(AscB(c))
   End If
   Next
 End function
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileStart
  Private Sub Class_Initialize
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
  End Sub
 
 Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=1
    if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
    if FileStart=0 or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    upfile_yfly_Stream.position=FileStart-1
    upfile_yfly_Stream.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing
    SaveAs=0
  end function
End Class
</SCRIPT>