Search Tools Links Login

Form Based File Upload Using Pure ASP


This code will allow you to do form based file uploads. It supports multiple files and uses only pure ASP. It will parse form data, browse server folders for a save location, and log uploads or failed uploads into a database There are no components to install so it will work on any web server that supports ASP. Just paste this code into a text file and name it saveany.asp. I have tested it on IIS 4 and 5, with IE 4, IE 5 and Netscape 6. With this code you will be able to save a file in any directory that the anonymous account assigned to it (usually IUSER_machinename) has access to so be careful. I should note that the server needs ADO, ADOX and the File System Object installed on it.

Original Author: Karl P. Grear

Code

<%response.buffer=false
  Func = Request("Func")
  if isempty(Func) Then
   Func = 1
  End if
  Select Case Func
  Case 1
  'You do not need to use this form to
  'send your files.
  BrowseServer = Request.Form("BrowseServer")
  
  %>
  

File Upload Form.


  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
Debug Options.
Create Raw File
Create Boundry File

Hit the [Browse Server] button to find the folder on the server to upload to.


Hit the [Browse] button to find the file on your computer.




Enter security password.

Comments



NOTE: Please be patient, you will not receive any notification until the file is completely transferred.


  <%
  Case 2
  Server.ScriptTimeout=300
  ForWriting = 2
   adLongVarChar = 201
   lngNumberUploaded = 0
  
  'Create a database connection
   set conn = server.createobject("adodb.connection")
  'Create a recordset
Set rstLog = server.createobject("adodb.recordset")

on error resume next
'Open the connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:inetpubUploadLog.mdb;Persist Security Info=False"
if err.number = "-2147467259" then
'the database is missing create it
CreateDatabase
Response.Write "Create Database"
'reopen the connetion
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:inetpubUploadLog.mdb;Persist Security Info=False"
err.clear
end if

'Open recordset
rstLog.Open "Select * from Logs", conn, 3, 3, 1

  'Get binary data from form
   noBytes = Request.TotalBytes
   binData = Request.BinaryRead (noBytes)
  
  'convery the binary data to a string
   Set RST = CreateObject("ADODB.Recordset")
   LenBinary = LenB(binData)
  
   if LenBinary > 0 Then
   RST.Fields.Append "myBinary", adLongVarChar, LenBinary
   RST.Open
   RST.AddNew
   RST("myBinary").AppendChunk BinData
   RST.Update
   strDataWhole = RST("myBinary")
   End if
  
  
   'get the boundry indicator
   strBoundry = Request.ServerVariables ("HTTP_CONTENT_TYPE")
   lngBoundryPos = instr(1,strBoundry,"boundary=") + 8
   strBoundry = "--" & right(strBoundry,len(strBoundry)-lngBoundryPos)
  
   'ParseForm returns a dictionary object
   'You can ParseForm any time after the
   'Boundry indicator is set.
  
   Set dPassword = ParseForm("Password")
   Set dOptions = ParseForm("Options")
  
   'both of these are valid
   Response.Write ParseForm("Password").item(0) & "
"
   Response.write dPassword.item(0) & "
"
  
   'Just write the data in the TArea
   response.Write ParseForm("TArea").item(0) & "
"
  
   SavePath = ParseForm("ServerPath").item(0)
   if SavePath = "" or isempty(SavePath) Then
   Response.Write "

The following Error occured.

"
   Response.Write "You did Not enter a server path To save your file to."
   Response.Write "

Hit the back button, make the needed corrections and resubmit your information."
   Response.Write "

"
   Response.End
   End if
  
   intCount = dOptions.count
  
   if intCount > 0 Then
   For x = 0 To intCount
   Select Case dOptions.item(x)
   Case "Raw"
   Raw = True
   Case "Boundry"
   Boundry = True
   End Select
   Next
   Else
   Raw = False
   Boundry = False
   End if
  
   if dPassword.item(0) <> "oktosend" Then
   'Log invalid attempt to log file.
   rstLog.AddNew
   'Log the date and time, the IP, the Path
   rstLog(0) = Now()
   rstLog(1) = request.ServerVariables("REMOTE_ADDR")
   rstLog(2) = SavePath
   rstLog(3) = "Invalid Logon"
  
   rstLog.Update
  
   Response.Write "

The following Error occured.

"
   Response.Write "The Password you entered is invalid."
   Response.Write "

Hit the back button, make the needed corrections and resubmit your information."
   Response.Write "

"
   Response.End
   End if
   'Creates a raw data file For With all
  'data sent. Uncomment for debuging.
   if Raw Then
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile(SavePath & " aw.txt", ForWriting, True)
   f.Write strDataWhole
   Set f = nothing
   Set fso = nothing
   End if
  
  'Get first file boundry positions.
  lngCurrentBegin = instr(1,strDataWhole,strBoundry)
  lngCurrentEnd = instr(lngCurrentBegin + 1,strDataWhole,strBoundry) - 1
  
  
  
  countloop = 0
  
  Do While lngCurrentEnd > 0
  'Get the data between current boundry
  'and remove it from the whole.
  strData = mid(strDataWhole,lngCurrentBegin, (lngCurrentEnd - lngCurrentBegin) + 1)
  'Remove the file data from the whole
   'strDataWhole = replace(strDataWhole,strData,"")
  
  
  'Get the full path of the current file.
   lngBeginFileName = instr(1,strdata,"filename=") + 10
   lngEndFileName = instr(lngBeginFileName,strData,chr(34))
  'Make sure they selected at least one
  'file.
   if lngBeginFileName = lngEndFileName and lngNumberUploaded = 0 Then
  
   Response.Write "

The following Error occured.

"
   Response.Write "You must Select at least one file To upload"
   Response.Write "

Hit the back button, make the needed corrections and resubmit your information."
   response.Write "

"
   Response.End
   End if
  'There could be one or more empty file b
  '  
  ' oxes.
   if lngBeginFileName <> lngEndFileName and lngBeginFileName - 10 <> 0 Then
   strFilename = mid(strData,lngBeginFileName,lngEndFileName - lngBeginFileName)
  'Creates a raw data file with data
  'between current boundrys. Uncomment
  'for debuging.
   if Boundry Then
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile(SavePath & " aw_" & lngNumberUploaded & ".txt", ForWriting, True)
   f.Write strData
   Set f = nothing
   Set fso = nothing
   End if
  
  'Loose the path information and keep
  'just the file name.
   tmpLng = instr(1,strFilename,"")
   Do While tmpLng > 0
   PrevPos = tmpLng
   tmpLng = instr(PrevPos + 1,strFilename,"")
   Loop
  
   FileName = right(strFilename,len(strFileName) - PrevPos)
  
  'Get the begining position of the file
  'data sent.
  'if the file type is registered with
  'the browser then there will be a
  'Content-Type
   lngCT = instr(1,strData,"Content-Type:")
  
   if lngCT > 0 Then
   lngBeginPos = instr(lngCT,strData,chr(13) & chr(10)) + 4
   Else
   lngBeginPos = lngEndFileName
   End if
  'Get the ending position of the file
  'data sent.
   lngEndPos = len(strData)
  
  'Calculate the file size.
   lngDataLenth = (lngEndPos - lngBeginPos) -1
  'Get the file data
   strFileData = mid(strData,lngBeginPos,lngDataLenth)
  'Create the file.
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile(SavePath & "" & FileName, ForWriting, True)
   f.Write strFileData
   Set f = nothing
   Set fso = nothing
  
   'Log Upload Informatoin.
   rstLog.AddNew
   'Log the date and time, the IP, the Path, and the Filename
   rstLog(0) = Now()
   rstLog(1) = request.ServerVariables("REMOTE_ADDR")
   rstLog(2) = SavePath
   rstLog(3) = FileName
  
   rstLog.Update
  
  
   if lngNumberUploaded = 0 Then
   Response.Write "Saving Files...

"
  
   End if
  
   Response.Write SavePath & "" & FileName & "
"
  
  
   lngNumberUploaded = lngNumberUploaded + 1
  
   End if
  
  'Get then next boundry postitions if
  'any.
   lngCurrentBegin = lngCurrentEnd
   lngCurrentEnd = instr(lngCurrentBegin + 9 ,strDataWhole,strBoundry) - 1
  
   'Prevents infinate loop.
   countloop = countloop + 1
   if countloop = 100 Then
   Response.Write "looped 100 times terminating script!"
   'Close the Log
   if rstLog.State then rstLog.close
   if conn.State then conn.Close
  
   Response.End
   End if
  loop
   'Close the Log
   if rstLog.State then rstLog.close
   if conn.State then conn.Close
  
   Response.Write "" & lngNumberUploaded & " File(s) Uploaded"
   Response.Write "

"
   Case 3
  
   'get prev path if any
   path = Request.QueryString("Path")
   'if Not assign one
   if path = "" or isempty(path) Then
   path = server.MapPath(".")'"c:inetpub"
   End if
   'create filesystemobject
   Set fso = CreateObject("Scripting.FileSystemObject")
   'get a folder object
   Set f = fso.GetFolder(path)
   path = f.path
  
   'limit access To hard drive
   'if lcase(left(path,10)) <> "c:inetpub" Then
   ' path = "C:Inetpub"
   ' Set f = fso.GetFolder(path)
   ' path = f.path
   'End if
  
   Response.Write "

Server Browse Form.

"
   Response.Write "
"
   Response.Write "" & vbcrlf
   Response.Write ""
   Response.Write "" & vbcrlf
  
   'get subfolders collection
   Set fc = f.subfolders
  
   'enum subfolders
   For Each folder In fc
   Response.Write "" & vbcrlf
   Next
  
   'if there is a folder display the Select folder button
   if fc.count > 0 Then
   Response.Write ""
   End if
  
   Response.Write""
  
   Response.Write "
" & path & "
Parent ..
" & folder.name & "

" & vbcrlf
   Response.Write "
"
  End Select
  
  %>
  
  
  

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 155 times

Categories

ASP/ HTML

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.