UnitTest( upload.asp )

Form

Sources

/axe-ut/upload.unit.test.asp

<!--#include virtual="/lib/unit-tests.asp"-->
<!--#include virtual="/lib/axe/classes/Utilities/upload.asp"-->
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xml:lang="en">
    <head>
        <title>AXE - Unit Test - Upload</title>
        <!--// meta tags //-->
        <meta http-equiv="content-type" content="text/html; charset=UTF-8" />
        <!--// link tags //-->
        <link rel="stylesheet" type="text/css" media="screen" href="/lib/unit-tests.css" />
        <link rel="stylesheet" type="text/css" media="screen" href="/lib/dropzone/css/dropzone.css" />
    </head>
    <body>
        <div id="container">
            <div id="container-hd">
                <h1>UnitTest( upload.asp )</h1>
            </div>
            <div id="container-bd">
 
                <h2>Form</h2>
                <form id="my-awesome-dropzone" action="/axe-ut/upload.do.unit.test.asp" class="dropzone"></form>
 
            </div>
            <div id="container-ft">
                <h2>Sources</h2>
                <h3><%= Request.ServerVariables("SCRIPT_NAME") %></h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( Request.ServerVariables("SCRIPT_NAME") ) ), "asp" ) %></div>
                <h3>/axe-ut/upload.do.unit.test.asp</h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( "/axe-ut/upload.do.unit.test.asp" ) ), "asp" ) %></div>
                <h3>/lib/axe/classes/Utilities/upload.asp</h3>
                <div class="code"><%= geshify( loadTextFile( Server.mapPath( "/lib/axe/classes/Utilities/upload.asp" ) ), "asp" ) %></div>
            </div>
        </div>
        <!--// javascript tags //-->
        <script src="/lib/dropzone/dropzone.min.js"></script>
        <script type="text/javascript">
        // <![CDATA[
 
Dropzone.options.myAwesomeDropzone = {
 
    maxFilesize: 2,// MB
    acceptedFiles: "image/*"
 
};
 
        // ]]>
        </script>
    </body>
</html>
 
 

/axe-ut/upload.do.unit.test.asp

<!--#include virtual="/lib/axe/base.asp"-->
<!--#include virtual="/lib/axe/classes/Parsers/json2.asp"-->
<!--#include virtual="/lib/axe/classes/Utilities/upload.asp"-->
<%
 
const FOR_READING   = 1 _
    , FOR_WRITING   = 2 _
    , FOR_APPENDING = 8
 
const TRISTATE_USE_DEFAULT = -2 _
    , TRISTATE_TRUE        = -1 _
    , TRISTATE_FALSE       = 0
 
dim maxFilesize, mimetypes
 
maxFilesize = 2 * 1024 * 1024' 2MiB
 
mimetypes = array( _
    "image/jpg" _
  , "image/png" _
  , "image/gif" _
)
 
dim Obj, Entry _
  , Fso, File, prop _
  , Up, shortpath, fullpath, i, j
 
set Obj = JSON.parse("{ ""Files"": [] }")
set Fso = Server.createObject("Scripting.FileSystemObject")
 
shortpath = Server.mapPath("/cache/dropzone/")
 
set Up = new Upload
for each i in Up.Files
    with Up.Files(i)
        if( .size <= maxFilesize ) then
            for each j in mimetypes
                if( j = .contentType ) then
                    fullpath = shortpath & "\" & .name
                    if( .saveToFile(fullpath) ) then
                        set Entry = JSON.parse("{}")
                        Entry.set "mimetype", .contentType
 
                        set File = Fso.getFile(fullpath)
                        Entry.set "name", File.name
                        Entry.set "path", File.path
                        Entry.set "size", File.size
                        set File = nothing
 
                        Obj.Files.push(Entry)
                        set Entry = nothing
                    end if
                end if
            next
        end if
    end with
next
set Up = nothing
 
Response.contentType = "application/json"
Response.write( JSON.stringify(Obj) )
 
set Fso = nothing
set Obj = nothing
 
%>
 
 

/lib/axe/classes/Utilities/upload.asp

<%
 
' File: upload.asp
'
' AXE(ASP Xtreme Evolution) upload utility.
'
' License:
'
' This file is part of ASP Xtreme Evolution.
' Copyright (C) 2007-2012 Fabio Zendhi Nagao
'
' ASP Xtreme Evolution is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' ASP Xtreme Evolution is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU Lesser General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public License
' along with ASP Xtreme Evolution. If not, see <http://www.gnu.org/licenses/>.
 
 
 
' Class: Upload
'
' This class implements an easy interface to upload files to a webserver. It's
' built using standard only functionallity in ASP. It will automaticly start
' parsing the binary stream sent by the browser which might take a while if the
' uploaded files are large.
'
' Notes:
'
' Large parts of this code is based on code by Gez Lemon of Juicy Studio
' <http://www.juicystudio.com/>. It has been and partially rewritten and
' enhanced by CrazyBeaver Software along with it's new class interface.
'
' About:
'
'	- Written by Karl-Johan Sjögren <http://www.crazybeavers.se/> @ June 2006
'	- Modified and normalized by Fabio Zendhi Nagao <http://zend.lojcomm.com.br/> @ January 2008
'
class Upload
 
	' Property: classType
	'
	' Class type.
	'
	' Contains:
	'
	'	(string) - type
	'
	public property get classType
		classType = typename(Me)
	end property
 
	' Property: classVersion
	'
	' Class version.
	'
	' Contains:
	'
	'	(string) - version in terms of http://semver.org/#semantic-versioning-200
	'
	public property get classVersion
		classVersion = "2.0.0"
	end property
 
	' Property: Form
	'
	' Stores Request.Form elements.
	'
	' Contains:
	'
	'	(scripting.dictionary) - With the elements
	'
	public Form
 
	' Property: Files
	'
	' Stores File elements.
	'
	' Returns:
	'
	'	(scripting.dictionary) - With the Upload_File objects
	'
	public Files
 
	' Property: errorText
	'
	' If an error occurs it's message will be stored here.
	'
	' Returns:
	'
	'	(string) - Error description
	'
	public errorText
 
' --[ Private section ]---------------------------------------------------------
 
	private sub Class_initialize()
		dim contentType, sData, iEndPos, sBoundary, aData
		contentType = Request.serverVariables("HTTP_CONTENT_TYPE")
		if( inStr(contentType, "multipart/form-data") > 0 ) then
			sData = parseRequest()
			iEndPos = inStrRev(contentType, "=")
			sBoundary = trim( right(contentType, len(contentType) - iEndPos ) )
			aData = split(sData, sBoundary)
			set Form = Server.createObject("Scripting.Dictionary")
			set Files = Server.createObject("Scripting.Dictionary")
			call parseFormData(aData)
		else
			errorText = "Encoding: multipart/form-data is required."
		end if
	end sub
 
	private sub Class_terminate()
		set Files = nothing
		set Form = nothing
	end sub
 
	private function parseRequest()
		const adLongVarChar = 201
		dim Rs, iBytesRead, iBlockSize, iTotalBytes
 
		iTotalBytes = Request.totalBytes
		iBlockSize = 16384
		iBytesRead = 0
 
		set Rs = Server.createObject("ADODB.Recordset")
		Rs.Fields.append "BinaryField", adLongVarChar, iTotalBytes
		Rs.open
		Rs.addNew
		do while(iBytesRead < iTotalBytes)
			if(iBytesRead + iBlockSize < iTotalBytes) then
				Rs("BinaryField").appendChunk Request.binaryRead(iBlockSize)
				iBytesRead = iBytesRead + iBlockSize
			else
				Rs("BinaryField").appendChunk Request.binaryRead(iTotalBytes - iBytesRead)
				iBytesRead = iTotalBytes
			end if
		loop
 
		Rs.update
		parseRequest = Rs.Fields("BinaryField").value
		Rs.close
		set Rs = nothing
	end function
 
	private sub parseFormData(byRef aData)
		dim iCounter, iEndMarker _
		  , sFieldInfo, sFieldName, sFieldValue _
		  , File, filename
		for iCounter = 0 to UBound(aData)
			iEndMarker = instr(aData(iCounter), vbNewLine & vbNewLine)
			if iEndMarker > 0 then
				sFieldInfo = mid(aData(iCounter), 3, iEndMarker - 3)
				sFieldName = getFieldName(sFieldInfo)
				sFieldValue = mid(aData(iCounter), iEndMarker + 4, len(aData(iCounter)) - iEndMarker - 7)
				if(instr(sFieldInfo, "filename=") > 0) then
					filename = getFileName(sFieldInfo)
					if(len(filename) > 0) then
						set File = new Upload_File
						File.Name = filename
						File.FormName = sFieldName
						File.Data = sFieldValue
						File.ContentType = getContentType(sFieldInfo)
						Files.add getUniqueFieldName(sFieldName, Files), File
						set File = nothing
					end if
				else
					Form.add getUniqueFieldName(sFieldName, Form), sFieldValue
				end if
			end if
		next
	end sub
 
	private function getFileName(byVal sData)
		dim sBrowser, iStartPos, iEndPos, sQuote
		if(sData = "") then
			getFieldName = ""
			exit function
		end if
		sQuote = Chr(34)
		iStartPos = instr(sData, "filename=")
		iEndPos = instr(iStartPos + 10, sData, sQuote & ";")
		if iEndPos = 0 then
			iEndPos = instr(iStartPos + 10, sData, sQuote)
		end if
		sData = mid(sData, iStartPos + 10, iEndPos - (iStartPos + 10))
		sBrowser = UCase(Request.ServerVariables("HTTP_USER_AGENT"))
		if(instr(sBrowser, "WIN") > 0) then
			iStartPos = instrrev(sData, "\")
			sData = mid(sData, iStartPos + 1)
		else
			iStartPos = instrrev(sData, "/")
			sData = mid(sData, iStartPos + 1)
		end if
		getFileName = sData
	end function
 
	private function getFieldName(byVal sData)
		dim iStartPos, iEndPos, sQuote
		if(sData = "") then
			getFieldName = ""
			exit function
		end if
		sQuote = chr(34)
		iStartPos = instr(sData, "name=")
		iEndPos = instr(iStartPos + 6, sData, sQuote & ";")
		if iEndPos = 0 then
			iEndPos = instr(iStartPos + 6, sData, sQuote)
		end if
		getFieldName = mid(sData, iStartPos + 6, iEndPos - (iStartPos + 6))
	end function
 
	private function getUniqueFieldName(byVal name, byRef Sd)
		dim i
		getUniqueFieldName = name
		while( Sd.exists(getUniqueFieldName) )
			i = i + 1
			getUniqueFieldName = name & "_" & i
		wend
	end function
 
	private function getContentType(byVal sData)
		dim iStartPos, iEndPos
		if(sData = "") then
			getContentType = ""
			exit function
		end if
		iStartPos = instr(sData, "Content-Type: ")
		iEndPos = len(sData)
		getContentType = mid(sData, iStartPos + 14, iEndPos)
	end function
 
end class
 
 
 
' Class: Upload_File
'
' Each entry of Upload.Files contains an object of this class. This is the class
' that user should use to retrieve information from the uploaded file.
'
' About:
'
'   - Written by Karl-Johan Sjögren <http://www.crazybeavers.se/> @ June 2006
'   - Modified and normalized by Fabio Zendhi Nagao <http://zend.lojcomm.com.br/> @ January 2008
'
class Upload_File
 
	' Property: classType
	'
	' Class type.
	'
	' Contains:
	'
	'	(string) - type
	'
	public property get classType
		classType = typename(Me)
	end property
 
	' Property: classVersion
	'
	' Class version.
	'
	' Contains:
	'
	'	(string) - version in terms of http://semver.org/#semantic-versioning-200
	'
	public property get classVersion
		classVersion = "2.0.0"
	end property
 
	' Property: name
	'
	' File name.
	'
	' Returns:
	'
	'	(string) - Name
	'
	public name
 
	' Property: data
	'
	' File.
	'
	' Returns:
	'
	'	(binary) - File
	'
	public data
 
	' Property: contentType
	'
	' File mimetype.
	'
	' Returns:
	'
	'	(string) - MIMEType
	'
	public contentType
 
	' Property: formName
	'
	' Name of the input field in the form which the image came from.
	'
	' Returns:
	'
	'	(string) - Name
	'
	public formName
 
	' Function: size
	'
	' Compute the file size.
	'
	' Returns:
	'
	'	(int) - Size
	'
	' Example:
	'
	' (start code)
	'
	' dim oUpload, oFile
	' set oUpload = new Upload
	' for each oFile in oUpload.Files
	' 	set oFile = oUpload.Files(oFile)
	' 	Response.write(oFile.name & " has " & oFile.size & " bytes<br />" & vbNewLine)
	' 	set oFile = nothing
	' next
	' set oUpload = nothing
	'
	' (end)
	'
	public function size()
		size = len(data)
	end function
 
	' Function: saveToFile
	'
	' Saves the binary in the hard drive.
	'
	' Parameters:
	'
	'	(string) - Physical path
	'
	' Returns:
	'
	'   true  - if saveToFile is successful
	'   false - otherwise
	'
	' Example:
	'
	' (start code)
	'
	' dim oUpload, oFile
	' set oUpload = new Upload
	' for each oFile in oUpload.Files
	' 	set oFile = oUpload.Files(oFile)
	' 	if(oFile.saveToFile(Server.mappath("saved/" & oFile.name))) then
	' 	    Response.write(oFile.name & " has been saved...<br />" & vbNewLine)
	' 	end if
	' 	set oFile = nothing
	' next
	' set oUpload = nothing
	'
	' (end)
	'
	public function saveToFile(byVal sPath)
		dim Fso, TextFile
		set Fso = Server.createObject("Scripting.FileSystemObject")
 
		on error resume next
		set TextFile = Fso.createTextFile(sPath, true)
		TextFile.write(data)
		TextFile.close
		if(Err <> 0) then
			saveToFile = false
		else
			saveToFile = true
		end if
		on error goto 0
 
		set TextFile = nothing
		set Fso = nothing
	end function
 
' --[ Private section ]---------------------------------------------------------
 
	private sub Class_initialize()
	end sub
 
	private sub Class_terminate()
	end sub
 
end class
 
%>