一个老个写的无组件上传

March 25,2004

<%
Response.write "<title>上传文件至当前文件夹</title>"
Response.Write "<body bgcolor=""#D6D3CE"" leftmargin=""0"" topmargin=""0"" title = "" 请您遵守国家相关法律法规上传文件。上传前请杀毒，否则系统将会自动删除此文件！"">"

'**Start Encode**
Action=Request("A")
If Action="UL" Then
      DoUpload Request.Cookies("DAZHOU.NET")("nowpath") & ""
      'CheckDiskSpace
'       Response.redirect "fileman.asp"
Else
ShowUploadForm
End If

Set fso=Nothing
'========================
SUB ShowUploadForm
'========================
Response.write "<Dir><form enctype=multipart/form-data name=fmupload method=Post action=Upload.asp?A=UL><br>"
If Request("n")<>"" AND IsNumeric(Request("n")) Then Session("NumUploadFields")=CInt(Request("n"))
For i=1 to 5
      Response.Write "<INPUT type=file name=file"& i & " size=35><br>"
Next
Response.Write "<br><center><INPUT type=submit value=""开始上传"">  <INPUT type='button' value= '取消上传' onclick='window.close()'> "
Response.Write "</form>"
End SUB

'========================
SUB DoUpload(Dir)
'========================
'If NOT Application("Debugging") Then On Error resume next
StartTime=Now
RequestBin=Request.BinaryRead(Request.TotalBytes)
Set UploadRequest=CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin, UploadRequest
keys=UploadRequest.Keys
For i=0 to UploadRequest.Count - 1
      curKey=keys(i)
      fName=UploadRequest.Item(curKey).Item("FileName")

      If fso.FileExists(Dir & fName) Then fso.deletefile Dir & fName
      If fName<>"" AND NOT fso.FileExists(Dir & fName) Then
         value=UploadRequest.Item(curKey).Item("Value")
         valueBeg=UploadRequest.Item(curKey).Item("ValueBeg")
         valueLen=UploadRequest.Item(curKey).Item("ValueLen")
         TotalULSize=TotalULSize + valueLen
         Set strm1=Server.CreateObject("ADODB.Stream")
         Set strm2=Server.CreateObject("ADODB.Stream")
         strm1.Open
         strm1.Type=1 'Binary
         strm2.Open
         strm2.Type=1 'Binary
         strm1.Write RequestBin
         strm1.Position=ValueBeg
         strm1.CopyTo strm2,ValueLen
         strm2.SaveToFile Dir & fName,2
         Set strm1=Nothing
         Set strm2=Nothing
      End If
   Next
If Now>StartTime Then Response.Write("<br><br><br><br><center>上传成功！<br>速度: " & Round(TotalULSize/1024/DateDiff("s",StartTime,Now)) &" 千字节/秒" )
Set UploadRequest=Nothing
End SUB

'========================
Sub BuildUploadRequest(RequestBin, UploadRequest)
'========================
'Get the boundary
PosBeg=1
PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(13)))
boundary=MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos=InstrB(1,RequestBin,boundary)
'Get all data inside the boundaries
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
      'Members variable of objects are put in a dictionary object
      Dim UploadControl
      Set UploadControl=CreateObject("Scripting.Dictionary")
      'Get an object name
      Pos=InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
      Pos=InstrB(Pos,RequestBin,getByteString("name="))
      PosBeg=Pos+6
      PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(34)))
      Name=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
      PosFile=InstrB(BoundaryPos,RequestBin,getByteString("filename="))
      PosBound=InstrB(PosEnd,RequestBin,boundary)
      'Test if object is of file type
      If PosFile<>0 AND (PosFile<PosBound) Then
         'Get Filename, content-type and content of file
         PosBeg=PosFile + 10
         PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(34)))
         FileName=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
         FileName=Mid(FileName,InStrRev(FileName,"")+1)
         'Add filename to dictionary object
         UploadControl.Add "FileName", FileName
         Pos=InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
         PosBeg=Pos+14
         PosEnd=InstrB(PosBeg,RequestBin,getByteString(chr(13)))
         'Add content-type to dictionary object
         ContentType=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
         UploadControl.Add "ContentType",ContentType
         'Get content of object
         PosBeg=PosEnd+4
         PosEnd=InstrB(PosBeg,RequestBin,boundary)-2
         Value=FileName
         ValueBeg=PosBeg-1
         ValueLen=PosEnd-Posbeg
      Else
         'Get content of object
         Pos=InstrB(Pos,RequestBin,getByteString(chr(13)))
         PosBeg=Pos+4
         PosEnd=InstrB(PosBeg,RequestBin,boundary)-2
         Value=getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
         ValueBeg=0
         ValueEnd=0
      End If
      UploadControl.Add "Value" , Value
      UploadControl.Add "ValueBeg" , ValueBeg
      UploadControl.Add "ValueLen" , ValueLen
      UploadRequest.Add name, UploadControl
      BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
Loop
End Sub

'====================================
Function getByteString(StringStr)
'====================================
For i=1 to Len(StringStr)
      char=Mid(StringStr,i,1)
      getByteString=getByteString & chrB(AscB(char))
Next
End Function

'====================================
Function getString(StringBin)
'====================================
getString =""
For intCount=1 to LenB(StringBin)
      getString=getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function
%>