Upload file trong Localhost bằng ASP. Sao lại củ chuối thế. Cái lổi này mong được gúp

<%
'© 2000-2003 L.C. Enterprises
'http://LCen.com
%>
<%
'MIME Parsing Functions Module
'Author: Luis Cantero
'© 2000-2003 L.C. Enterprises
'http://LCen.com
'Updated: 08/JUN/2003


'PURPOSE:	Returns the HEADER of a Mime entry
'INPUT:		String: Mime entry
'OUTPUT:	String: Found header | Empty
Function GetMimeHeader(strMime)

	Dim intDataStart, strHeader

	'Find header boundary
	intDataStart = InStr(strMime, vbCrLf & vbCrLf)
	If intDataStart > 0 Then 'Header boundary found
		'Parse header and return
		GetMimeHeader = Left(strMime, intDataStart - 1)
	End If

End Function

'PURPOSE:	Returns an array containing the received multipart data in Mime format
'OUTPUT:	String Array | Empty
Function GetMimeArray()

	Dim strSignature, strCompleteData, lngTotalBytes, lngBytesRead, lngChunkSize, objSourceData

	'Initialize
	lngChunkSize = 5242880 '5 MB
	lngBytesRead = 0

	If Request.ServerVariables("REQUEST_METHOD") = "POST" And LCase(Left(Request.ServerVariables("HTTP_Content_Type"), 19)) = "multipart/form-data" Then
		lngTotalBytes = Request.TotalBytes

		Set objSourceData = CreateObject("ADODB.Stream")
		objSourceData.Open
		objSourceData.Type = 1 'Binary

		Do While lngBytesRead < lngTotalBytes And Response.IsClientConnected
			'Adjust chunk's length before reading
			If lngChunkSize + lngBytesRead > lngTotalBytes Then lngChunkSize = lngTotalBytes - lngBytesRead

			'Read chunk of data
			objSourceData.Write(Request.BinaryRead(lngChunkSize))

			'Increase read counter
			lngBytesRead = lngBytesRead + lngChunkSize
		Loop

		'Convert binary string to real string
		objSourceData.Position = 0
		strCompleteData = GetStringFromBinary(objSourceData.Read)

		Set objSourceData = Nothing

		'Parse Signature (file separator)
		strSignature = Left(strCompleteData, InStr(strCompleteData, vbCrLf) + 1)

		strCompleteData = Mid(strCompleteData, InStr(strCompleteData, vbCrLf) + 2, Len(strCompleteData) - 2 - 2 * Len(strSignature))

		'Put files into a string Array and return
		GetMimeArray = Split(strCompleteData, strSignature)
	Else 'Return empty array
		GetMimeArray = Split("")
	End If

End Function

'PURPOSE:	Converts a multibyte or binary string (VT_UI1 | VT_ARRAY) to a real string (BSTR) using an ADO Recordset
'INPUT:		String: MultiByte or Binary string
'OUTPUT:	String: Real string
Function GetStringFromBinary(strBinaryData)

	Dim Rs, lngBinaryLength
	Const adLongVarChar = 201

	lngBinaryLength = LenB(strBinaryData)

	'Error check
	If lngBinaryLength = 0 Then Exit Function

	'MultiByte data must be converted To VT_UI1 | VT_ARRAY first
	If VarType(strBinaryData) = 8 Then strBinaryData = MultiByteToBinary(strBinaryData)

	Set Rs = CreateObject("ADODB.Recordset")

	Rs.Fields.Append "tmpBinField", adLongVarChar, lngBinaryLength 'Create temp field
	Rs.Open
	Rs.AddNew
	Rs("tmpBinField").AppendChunk strBinaryData	'Add binary data to temp table
	Rs.Update

	GetStringFromBinary = Rs("tmpBinField") 'Get string and return it

	Set Rs = Nothing

End Function

'PURPOSE:	Converts a multibyte string to real binary data (VT_UI1 | VT_ARRAY) using an ADO Recordset
'INPUT:		String: MultiByte string
'OUTPUT:	String: Real binary string
Function GetBinaryFromMultiByte(strMultiByte)

	Dim Rs, lngMultiByteLength
	Const adLongVarBinary = 205

	lngMultiByteLength = LenB(strMultiByte)

	'Error check
	If lngMultiByteLength = 0 Then Exit Function

	Set Rs = CreateObject("ADODB.Recordset")

	Rs.Fields.Append "tmpBinField", adLongVarBinary, lngMultiByteLength 'Create temp field
	Rs.Open
	Rs.AddNew
	Rs("tmpBinField").AppendChunk strMultiByte & ChrB(0) 'Add multibyte data to temp table
	Rs.Update

	GetBinaryFromMultiByte = Rs("tmpBinField").GetChunk(lngMultiByteLength) 'Get binary data and return it

	Set Rs = Nothing

End Function

'PURPOSE:	Returns the "Content-Disposition" of a Mime entry
'INPUT:		String: Mime entry
'OUTPUT:	String: Found content-disposition | Empty
Function GetMimeContentDisposition(strMime)

	GetMimeContentDisposition = GetMimeValueByCoord(strMime, "Content-Disposition:", ";")

End Function

'PURPOSE:	Returns the "Content-Type" of a Mime entry
'INPUT:		String: Mime entry
'OUTPUT:	String: Found content-type | Empty
Function GetMimeContentType(strMime)

	GetMimeContentType = GetMimeValueByCoord(strMime, "Content-Type:", vbCrLf)

End Function

'PURPOSE:	Returns the "filename" of a Mime entry
'INPUT:		String: Mime entry
'OUTPUT:	String: Found filename | Empty
Function GetMimeFilename(strMime)

	GetMimeFilename = GetMimeValueByCoord(strMime, "filename=""", """")

End Function

'PURPOSE:	Returns the "name" of a Mime entry
'INPUT:		String: Mime entry
'OUTPUT:	String: Found name | Empty
Function GetMimeName(strMime)

	GetMimeName = GetMimeValueByCoord(strMime, "name=""", """")

End Function

'PURPOSE:	Returns the value of an ENTRY of a Mime entry
'INPUT:		String: Mime entry
'OUTPUT:	String: Found value | Empty
Function GetMimeValue(strMime)

	Dim intBeg

	'Search for left boundary
	intBeg = InStr(1, strMime, vbCrLf & vbCrLf) + Len(vbCrLf & vbCrLf)

	If intBeg > 0 Then
		'Return found value
		GetMimeValue = Mid(strMime, intBeg, Len(strMime) - intBeg - 1)
	End If

End Function

'PURPOSE:	Returns the value of a VARIABLE of a Mime entry
'INPUT:		String: Mime entry, String: Left and right bounds
'OUTPUT:	String: Found value | Empty
Function GetMimeValueByCoord(strMime, strLeftBound, strRightBound)

	Dim intBeg, intEnd, strHeader

	'Get header
	strHeader = GetMimeHeader(strMime)

	'Search for value name in header
	intBeg = InStr(1, strHeader, strLeftBound)

	If intBeg > 0 Then	 'Value name found in header, parse value
		intBeg = intBeg + Len(strLeftBound)
		intEnd = InStr(intBeg, strMime, strRightBound)

		If intEnd = 0 Then intEnd = Len(strMime)

		'Return found value
		GetMimeValueByCoord = Trim(Mid(strMime, intBeg, intEnd - intBeg))
	End If

End Function

'PURPOSE:	Returns the value of an ENTRY in the Mime array, according to it's NAME
'INPUT:		Array: Mime array, String: Name of the value to be retrieved
'OUTPUT:	String: Found value | Empty
Function GetMimeValueByName(arrMime, strValueName)

	Dim intI, intBeg, strHeader

	'Search all items of array
	For intI = 0 To UBound(arrMime)

		'Get header
		strHeader = GetMimeHeader(arrMime(intI))
		If strHeader <> "" Then 'Header found
			'Search for value name in header
			intBeg = InStr(1, strHeader, "name=""" & strValueName & """")
			If intBeg > 0 Then 'Value name found in header, parse value
				intBeg = intBeg + Len("name=""" & strValueName & """") + Len(vbCrLf & vbCrLf)

				'Return found value
				GetMimeValueByName = Mid(arrMime(intI), intBeg, Len(arrMime(intI)) - intBeg - 1)
				Exit For
			End If
		End If
	Next

End Function

'PURPOSE:	Extracts the name of a file from its path
'INPUT:		String: Path
'OUTPUT:	String: Name
Function GetFilenameFromPath(strPath)

	Dim intI

	intI = InStrRev(strPath, "\")
	If intI > 0 Then
		GetFilenameFromPath = Mid(strPath, intI + 1)
	Else
		GetFilenameFromPath = strPath
	End If

End Function

'PURPOSE:	Saves a file using the FileSystemObject
'INPUT:		String: files's contents, String: save path
Sub WriteFile(strFileData, strSavePath)

	Dim objFSO, objTextStream

	If Len(strFileData) = 0 Then Exit Sub

	'Create objects
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextStream = objFSO.CreateTextFile(strSavePath, True, False)

	'Write file and close it
	objTextStream.Write strFileData
	objTextStream.Close

	'Delete objects
	Set objTextStream = Nothing
	Set objFSO = Nothing

End Sub

'PURPOSE:	Deletes a file using the FileSystemObject
'INPUT:		String: files's path
Sub DeleteFile(strPath)

	Dim objFSO, tmpFileHandle

	'Create object
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	'Delete zoom image
	If objFSO.FileExists(strPath) Then
		Set tmpFileHandle = objFSO.GetFile(strPath)
	 	tmpFileHandle.Delete
	End If

	'Delete objects
	Set tmpFileHandle = Nothing
	Set objFSO = Nothing

End Sub

'PURPOSE:	Generates a "Unique Random Filename" to save uploaded files
'INPUT:		String: Name of uploaded file
'OUTPUT:	String: Unique random filename in this format: Date_RandomNumber.EXT
'NOTES:		RandomNumber = Round(RND * 1000000), Extension is kept
Function GenerateRandomName(strFileName)

	Dim strDate

	'Remove illegal characters for a filename
	strDate = Year(Now) & "." & String(2 - Len(Month(Now)), "0") & Month(Now) & "." & String(2 - Len(Day(Now)), "0") & Day(Now)

	Randomize

	'Return
	GenerateRandomName = strDate & "_" & CStr(Round(Rnd * 1000000)) & Mid(strFileName, InStrRev(strFileName, ".")) 'Date_RandomNumber.EXT

End Function

'PURPOSE:	Rounds a Byte amount and returns KB with 2 decimal places
'INPUT:		Long: Byte amount
'OUTPUT:	String: Rounded KB amount
Function GetRoundedKB(lngByteAmount)

	GetRoundedKB = FormatNumber(Int(lngByteAmount / 1024 * 100 + 0.5) / 100, 2)

End Function

'PURPOSE:	Rounds a Byte amount and returns, according to an elapsed time in seconds, KB/s with 2 decimal places
'INPUT:		Long: Byte amount
'OUTPUT:	String: Rounded KB/s amount
Function GetRoundedKBperS(lngByteAmount, lngSecondsElapsed)

	'Error check
	If lngSecondsElapsed <= 0 Then lngSecondsElapsed = 1

	GetRoundedKBperS = FormatNumber(Int(lngByteAmount / 1024 / lngSecondsElapsed * 100 + 0.5) / 100, 2)

End Function

%>

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
'© 2000-2003 L.C. Enterprises
'http://LCen.com
%>
<%
	Option Explicit
	Response.Expires = 0

	'CONFIGURATION BEGIN	***********************
	Server.ScriptTimeout = 1000					'Time-out limit for the file upload in seconds
	Const lngUploadLimit = 30000000				'File size limit in Bytes
	Const strPageToContinue = "TargetPage.asp"	'Name of the page to which the received variables should be posted/redirected
	Const intTypeOfPageContinue = 0				'What to do after the upload is complete: 0 = Do nothing / 1 = Post variables to continue page / 2 = Redirect
	Const strUploadFolder = "Uploaded/"
	Const intVerbose = 1						'Display info about uploaded file(s): 0 = No / 1 = Yes
	'CONFIGURATION END		***********************
%>
<!--#INCLUDE FILE="modMimeFunctions.asp" -->
<%
Dim strDate
strDate = Now()

Response.Write "<BR>Upload started: " & strDate & "<BR>"

Dim lngBytesReceived, arrMimeData, lngItemIndex
Dim strActualFileOrValue, strSaveName

Dim strName

lngBytesReceived = Request.TotalBytes

If lngBytesReceived > lngUploadLimit Then
	Response.Write("<DIV ALIGN=""CENTER""><B>Sorry, your request cannot be completed because:<BR><BR>Maximum allowed size for the file is " & GetRoundedKB(lngUploadLimit) & " KB. Your request: " & GetRoundedKB(lngBytesReceived) & " KB</DIV>")
	Response.Write("<META HTTP-EQUIV=""REFRESH"" CONTENT=""3; URL=javascript:history.go(-1)"">")
	Response.End
End If

If lngBytesReceived > 0 Then 'Data has been received
	%>
		<DIV ALIGN="CENTER"><IMG SRC="images/processing.gif"><BR>File is uploading... Please wait...</DIV>
		<FORM NAME="frmUpload">
	<%
	'Put files into a String Array
	arrMimeData = GetMimeArray()

	'Loop for every file in the Array
	For lngItemIndex = 0 To UBound(arrMimeData)

		'Get file or value
		strActualFileOrValue = GetMimeValue(arrMimeData(lngItemIndex))

		If GetMimeContentType(arrMimeData(lngItemIndex)) = "" Or GetMimeFilename(arrMimeData(lngItemIndex)) = "" Then 'No Content-type Or filename found

			strName = GetMimeName(arrMimeData(lngItemIndex))

			'Write form name and value, make sure it is safe for posting
			Response.Write("<INPUT TYPE=""HIDDEN"" NAME=""" & strName & """ VALUE=""" & Server.HTMLEncode(strActualFileOrValue) & """>" & vbCrLf)

			'Response.Write "<B>=== ERROR: Not a file</B><BR>"
			'Response.Write "--- Data Submitted: <B>" & strActualFileOrValue & "</B>"
			'Response.Write " (Length=" & Len(strActualFileOrValue) & ")<BR>"

		Else 'Content-type and filename found

			'Get the name of the variable
			strName = GetMimeName(arrMimeData(lngItemIndex))
			'strSaveName = GetFilenameFromPath(GetMimeFilename(arrMimeData(lngItemIndex))) 'Use original filename

			'Generate unique name, extension is kept
			strSaveName = GenerateRandomName(strSaveName)

			Response.Write("<INPUT TYPE=""HIDDEN"" NAME=""" & strName & """ VALUE=""" & strSaveName & """>" & vbCrLf)

			Call WriteFile(strActualFileOrValue, Server.MapPath(strUploadFolder & strSaveName))
			If intVerbose = 1 Then Response.Write("<FONT COLOR=""RED"">" & strSaveName & "</FONT> (" & GetRoundedKB(Len(strActualFileOrValue)) & " KB)<BR>")

		End If
	Next
End If

'All done, now redirect
Response.Write "<BR><BR>Upload complete: " & Now()
Response.Write "<BR>Speed: " & GetRoundedKBperS(lngBytesReceived, DateDiff("s", strDate, Now())) & " KB/s"
%>
<SCRIPT>
<!--
	<%
	Select Case intTypeOfPageContinue
		Case 0 'Do nothing

		Case 1 'Post variables to continue page
			%>
				document.forms[0].action = "<%=strPageToContinue%>";
				document.forms[0].method = "POST";
				document.forms[0].submit();
			<%

		Case 2 'Redirect
			%>
				window.location.href = "<%=strPageToContinue%>";
			<%
	End Select
	%>
// -->
</SCRIPT>

<HTML>
<HEAD>
<TITLE>File upload test form</TITLE>
</HEAD>
<BODY>
<FORM ACTION="upload.asp" METHOD="POST" ENCTYPE="multipart/form-data" NAME="Form1" onSubmit="return OnFilesSubmitted()">
  <P>
    <INPUT NAME="File1" TYPE="File">
    <BR>
  </P>
  <P>
	<INPUT NAME="File2" TYPE="File">
  </P>
  <P>
	<INPUT NAME="File3" TYPE="File">
  </P>
  <P>
	<INPUT NAME="File4" TYPE="File">
  </P>
  <P>
	<INPUT NAME="File5" TYPE="File">
			<BR>
	<INPUT NAME="Submit1" TYPE="Submit">
  </P>
</FORM>
			
<DIV ALIGN="CENTER">
	<FONT COLOR="a90000" SIZE="5" FACE="verdana"><MARQUEE><P ID="MyID"></P></MARQUEE></FONT>
	<BR><IMG NAME="imgPross" BORDER="0" SRC="images/WhitePixel.gif" WIDTH="123" HEIGHT="16">
</DIV>

<SCRIPT>
	function OnFilesSubmitted()
	{
	    document.all("MyID").innerHTML = '<BR>Files are uploading... Please wait...';

		document.all.imgPross.src = imgPreload.src;
		document.all.Submit1.disabled = true;
    	return true;
	}

	var imgPreload = new Image(); //Preload image
	imgPreload.src = "images/processing.gif";
</SCRIPT>
</BODY>
</HTML>