<% strDBName = "../database/vbc.mdb" %> <% '************************************** ' Name: Form Based File Upload Using Pure ASP ' ' Description: This code will allow you to do form based file uploads. It supports ' multiple files and uses only pure ASP. 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 upload.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 and the File System Object ' installed on it, but both of these are installed by default with ASP. ' ' By: Karl P. Grear ' ' This code is copyrighted and has limited warranties. ' Please see http://www.1ASPStreet.com/xq/ASP/txtCodeId.6569/lngWId.4/qx/vb/scripts/ShowCode.htm ' for details. '************************************** response.buffer=true Func = Request("Func") if isempty(Func) Then Func = 1 End if Response.Write "" & vbCRLF & "" Select Case Func Case 1 %>

File Upload Form

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

Home

**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 'Get binary data from form noBytes = Request.TotalBytes binData = Request.BinaryRead (noBytes) 'convert 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) 'These can only be set after the boundry indicator is set above 'These are image tag parameters the user specifies on the form strBorder = ParseForm("border").item(0) strAlt = ParseForm("alt").item(0) strAlign = ParseForm("align").item(0) strWidth = ParseForm("width").item(0) 'This is the path to the directory where the uploaded files will be saved SavePath = Server.MapPath("../uploads") '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 boxes. 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 & "\raw_" & 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 'This is the filename on the local machine FileName = right(strFilename,len(strFileName) - PrevPos) 'This is the unique filename assigned to the file saved on the server strOutFileName = cstr(Timer() * 100) & right(FileName,len(FileName) - InStrRev(FileName,".") + 1) '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 & "\" & strOutFileName, ForWriting, True) f.Write strFileData Set f = nothing Set fso = nothing if lngNumberUploaded = 0 Then ' Response.Write "Saving File...

" End if 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!" Response.End End if loop 'Determine if this is an image file or some other type of file strExtension = right(FileName,len(FileName) - InStrRev(FileName,".") + 1) if LCase(strExtension) = ".jpg" or LCase(strExtension) = ".jpeg" or _ LCase(strExtension) = ".gif" or LCase(strExtension) = ".bmp" or _ LCase(strExtension) = ".tif" or LCase(strExtension) = ".tiff" or _ LCase(strExtension) = ".png" then 'image blnImage = True else 'not an image blnImage = False end if 'file type Response.Write "" & FileName & " (" & noBytes & " bytes) uploaded.

" Response.Write "1) Select the line below
2) Copy the selection (Ctrl+C)
3) Paste (Ctrl+V) into the Entry Description box at the point where you want the " if blnImage then Response.Write "image" else Response.Write "link" end if Response.Write " to appear
" Response.Write "

" if blnImage then 'image Response.Write "<img src="uploads/" & strOutFileName & "" border=""" & strBorder & """" Response.Write " alt=""" & strAlt & """" Response.Write " align=""" & strAlign & """" Response.Write " width=""" & strWidth & """>" else 'not an image Response.Write "<a href="uploads/" & strOutFileName & "">Enter Link Text Here</a>" end if 'type of file Response.Write "

" Response.Write "

" End Select Response.Write "" & vbCRLF & "" 'Use in place of request.form function ParseForm(strFieldName) Set strFormData = CreateObject("Scripting.Dictionary") lngCount = -1 'Try To find the Field lngNamePos = instr(1,strDataWhole,"name=" & chr(34) & strFieldName & chr(34)) 'Parse through data In search of fields Do While lngNamePos <> 0 lngCount = lngCount + 1 lngBeginFieldData = instr(lngNamePos,strDataWhole,vbcrlf & vbcrlf)+4 lngEndFieldData = instr(lngBeginFieldData,strDataWhole,vbcrlf) strFormData.Add lngCount, mid(strDataWhole,lngBeginFieldData,lngEndFieldData-lngBeginFieldData) lngNamePos = instr(lngEndFieldData,strDataWhole,"name=" & chr(34) & strFieldName & chr(34)) Loop Set ParseForm = strFormData End function 'ParseForm %>