Upload script, how to upload more than 100k?

lslapiko · Dec 1, 2002

I am using the following code to let users upload files. Downloaded it from the web somewhere. How can I modify this script to get rid of the 100k limit?

Script 1
<%
Option Explicit
%>





<html>
<head>
<title>ALEA: Paper Upload Confirmation</title>
<style>

</style>
<script language="JavaScript" type="text/javascript">

</script>
</head>

<body bgcolor="#ffffff" background="../../images/bg.gif" topmargin="0" leftmargin="0">

<table width="100%" cellpadding="0" cellspacing="0" border="0">
<tr>
<td width="166" align="right" valign="top" rowspan="500">
<table width="166" border="0" cellpadding="0" cellspacing="0">
<tr>
<td bgcolor="#ffffff"><a href="

http://www.amlecon.org"><img

src="../../images/logo.gif" border="0"></a></td>
</tr>

</table>
</td>
<td width="100%" rowspan="500" valign="top">
<table width="100%" border="0" cellpadding="0" cellspacing="0" bordercolor="orange">
<tr>
<td width="5%" rowspan="500"> </td>
<td width="90%" height="150" class="title" valign="bottom">Confirmation of Paper Submission</td>
<td width="5%" rowspan="500"> </td>
</tr>
<tr>
<td width="90%">
<table border="0" cellpadding="2" cellspacing="0">
<tr>
<td colspan="2"> </td>
</tr>
<tr>
<td class="smalltext" colspan="2"><p>The following paper has been submitted for the 2003 ALEA Annual Meeting.</p></td>
</tr>
<tr>
<td> </td>
</tr>
<td colspan="2" class="smalltext">
<%

dim author
author = Session("author&quot

dim title
title = Session("title&quot

dim area
area = Session("area&quot

dim comments
comments = Session("comments&quot

dim db_ID
db_ID = Session("db_ID&quot

dim submitted_by

dim conn
set conn = server.CreateObject("ADODB.Connection&quot

conn.Open cALEA, cDB_USERNAME, cDB_PASSWORD

dim rs
dim SQL

set rs = Server.CreateObject("ADODB.RecordSet&quot

SQL = "SELECT * FROM person WHERE db_ID = " & db_ID
rs.open SQL, conn, adOpenKeySet, adLockPessimistic, adCmdText

submitted_by = rs.Fields("f_name&quot

submitted_by = submitted_by & " "
submitted_by = submitted_by & rs.Fields("l_name&quot

rs.Close
set rs = nothing

response.write("<p><span class='boldtext'>Title:</span> " & title & "</p>&quot

response.write("<p><span class='boldtext'>Author(s):</span> " & author & "</p>&quot

response.write("<p><span class='boldtext'>Submitted by:</span> " & submitted_by & "</p>&quot

response.write("<p><span class='boldtext'>Comments:</span> " & comments & "</p>&quot

response.write("<p><span class='boldtext'>Subject area(s):</span><br>&quot

dim areaArray
areaArray = Split(area, ", &quot

'dim conn
'set conn = server.CreateObject("ADODB.Connection&quot

'conn.Open cALEA, cDB_USERNAME, cDB_PASSWORD

dim strArea_name
dim i
for i = LBound(areaArray) to UBound(areaArray)
set rs = Server.CreateObject("ADODB.RecordSet&quot

SQL = "SELECT * FROM area WHERE area_ID = " & areaArray(i)
rs.open SQL, conn, adOpenKeySet, adLockPessimistic, adCmdText
strArea_name = rs.Fields("area&quot

response.write(strArea_name & "<br>&quot

rs.close
set rs = nothing
next

conn.close
set conn = nothing

response.write("</p>&quot

Response.Write "<p>Upload started: " & Now & "</p>"

Dim lngBytesReceived, arrFiles, lngItemIndex
Dim strActualFileOrValue, strSourcePath, strSaveName

Dim strName

lngBytesReceived = Request.TotalBytes

If lngBytesReceived > 102400 Then

Response.Write("<DIV ALIGN=""CENTER""><B>Sorry, your request cannot be completed because:<BR><BR>Maximum allowed file size for both files (combined) is 100KB. Your request: " & CLng(lngBytesReceived / 1024) & "KB</DIV>&quot

Response.End
End If

If lngBytesReceived > 0 Then 'Data has been received
%>

<FORM NAME=FORM1>
<%
'Put files into a String Array
arrFiles = GetMimeArray()

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

If GetMimeHeader(arrFiles(lngItemIndex)) = "" Then 'No header found

Response.Write lngItemIndex & ": No header found<BR>"

Else 'Header found

If GetMimeContentDisposition(arrFiles(lngItemIndex)) <> "form-data" Then 'No Content-Disposition found

Response.Write "<b>=== ERROR: Unknown data</b><BR>"

Else 'Content-Disposition found

'Parse actual file
strActualFileOrValue = GetMimeValue(arrFiles(lngItemIndex))

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

strName = GetMimeName(arrFiles(lngItemIndex))

'Write form name and value
Response.Write("<INPUT TYPE=""HIDDEN"" NAME=""" & strName & """ VALUE=""" & strActualFileOrValue & """>" & vbCrLf)

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

<BR>"

Else 'Content-type And filename found

If GetMimeName(arrFiles(lngItemIndex)) = "" Then 'Input has no name

Response.Write "<b>=== ERROR: Input name not found</b><BR>"

Else 'Input has a name

strSourcePath = GetMimeFilename(arrFiles(lngItemIndex))

If strSourcePath = "" Then 'No filename found

Response.Write "<b>=== ERROR: Source path not found</b><BR>"

Else 'Filename found

strSaveName = GetFilenameFromPath(strSourcePath)

If strSaveName = "" Then 'Save name not found

Response.Write "Error: Save name not found: " & strSourcePath & "<BR>"

Else 'Save name found, everything's OK

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

Call WriteFile(strActualFileOrValue, Server.MapPath("uploaded\" & strSaveName))
End If
End If
End If
End If
End If
End If
Next
End If

'All done, now redirect
Response.Write "<p>Upload complete: " & Now & "</p>"
%>

</td>
</tr>
<tr>
<td colspan="2"> </td>
</tr>
<tr>
<td colspan="2">
<input type="button" name="another" value="Submit Another" onclick="document.location='default.asp';">
<input type="button" name="finish" value="Finish" onclick="document.location='../default.asp';">
</td>
</tr>
</FORM>
</table>
</td>
</tr>
</table>
</td>
</tr>
</table>

</body>
</html>
<SCRIPT>
document.forms[0].action = "TargetPage.asp"
document.forms[0].method = "POST"
//document.forms[0].submit()
</SCRIPT>

Script 2:
<%
'MIME Parsing Functions Module
'Author: Luis Cantero
'© 2002 L.C. Enterprises
'

http://LCenterprises.net

'Updated: 10/OCT/2002

'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 intI, strBytes, strSignature, strCompleteData

'Get binary data
strBytes = Request.BinaryRead(Request.TotalBytes)

For intI = 1 To LenB(strBytes) 'Convert binary data to a String
strCompleteData = strCompleteData & Chr(AscB(MidB(strBytes, intI, 1)))
Next

'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)

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:", ";&quot

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=""", """&quot

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=""", """&quot

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 & """&quot

If intBeg > 0 Then 'Value name found in header, parse value
intBeg = intBeg + Len("name=""" & strValueName & """&quot

+ 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, "\&quot

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&quot

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&quot

'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 = Replace(Date, "/", ".&quot

Randomize

'Return
GenerateRandomName = strDate & "_" & CStr(Round(RND * 1000000)) & Right(strFileName, 4) 'Date_RandomNumber.EXT

End Function
%>

Targol · Dec 2, 2002

If you change this line "

Code:

If lngBytesReceived > 102400 Then

" by raising the comparision value, you'll get rid of the message for over 100K files. Thus, this message may be here for technical reasons that should crash your page if Upload is > 100Kb. Try and tell me. Water is not bad as long as it stays out human body ;-)

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Upload script, how to upload more than 100k?

lslapiko

Programmer

Targol

Technical User

Similar threads

Part and Inventory Search

Sponsor