<%
'	r.upload | facilitando o upload de arquivos sem depender de componentes
'	@author: Raphael Ramos | raphael@ligacomunicacao.com.br | www.ligacomunicacao.com.br/rramos/
'	@version: 0.6.2
'	@description: vb class para upload de arquivos (classic asp)

extAllow = ""
extNegado = ".exe|.com|.asp|.php|.sql|.bat|.pif|.ocx|.dll|.aspx|.shtml"

Class rUpload

	Dim UploadRequest, filename, path
	Dim AllowExt, DeniedExt, status
	Dim msgOK, msgErro, msgExtInvalida

	Sub Class_Initialize
		Response.Expires=0
		Response.Buffer = TRUE
		Response.Clear
		byteCount = Request.TotalBytes
		RequestBin = Request.BinaryRead(byteCount)
		Set UploadRequest = CreateObject("Scripting.Dictionary")
		initUpload(RequestBin)
	End Sub
	
	Private Sub Class_Terminate
		set UploadRequest = nothing
		set regEx = nothing
	End Sub
	
	Sub initUpload(RequestBin)
		PosBeg = 1
		PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
		boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
		boundaryPos = InstrB(1,RequestBin,boundary)
		Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
			Dim UploadControl
			Set UploadControl = CreateObject("Scripting.Dictionary")
			Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
			Pos = InstrB(Pos,RequestBin,getByteString("name="))
			PosBeg = Pos+6
			PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
			Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
			PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
			PosBound = InstrB(PosEnd,RequestBin,boundary)
			If PosFile <> 0 AND (PosFile<PosBound) Then
				PosBeg = PosFile + 10
				PosEnd =  InstrB(PosBeg,RequestBin,getByteString(chr(34)))
				FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
				UploadControl.Add "FileName", FileName
				Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
				PosBeg = Pos+14
				PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
				ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
				UploadControl.Add "ContentType",ContentType
				PosBeg = PosEnd+4
				PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
				Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
			Else
				Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
				PosBeg = Pos+4
				PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
				Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
			End If
			UploadControl.Add "Value" , Value
			UploadRequest.Add name, UploadControl
			BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
		Loop
	End Sub

	Function getByteString(StringStr)
		For i = 1 to Len(StringStr)
			char = Mid(StringStr,i,1)
			getByteString = getByteString & chrB(AscB(char))
		Next
	End Function

	Function getString(StringBin)
		getString =""
		For intCount = 1 to LenB(StringBin)
			getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
		Next
	End Function

	Function salvaArquivo(Campo, Nome)
		'configura extensões permitidas e negadas
		if DeniedExt <> "" then
			extNegado = DeniedExt
		end if
		if AllowExt <> "" then
			extAllow = AllowExt
		end if
		
		'define caminho para upload
		strPath = path
		if right(strPath,1) <> "\" then
			strPath=strPath & "\"
		end if
		
		'busca arquivo para upload
		filepathname = UploadRequest.Item(Campo).Item("FileName")
		
		'verifica se o arquivo pode ser enviado
		set RegEx = New RegExp
			RegEx.IgnoreCase = True
			RegEx.Global = True

		if extAllow = "" then
			regEx.Pattern = "[^"& extNegado &"]"
		else
			regEx.Pattern = extAllow
		end if
		
		pode = regEx.Test(filepathname)
		
		if pode then
			'busca valor binário do arquivo
			value = UploadRequest.Item(Campo).Item("Value")
			
			'verifica path para upload
			Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
			if not ScriptObject.FolderExists(strPath) then ScriptObject.CreateFolder(strPath)
			
			'busca nome do arquivo para ser salvo
			filename = Nome
			if filename = "" then
				For i = Len(filepathname) To 1 Step -1
					If Mid(filepathname, i, 1) = "\" Then Exit For
				Next
				filename = Right(filepathname, Len(filepathname) - i)
			end if
			pathfilename = strPath & filename
			
			'cria arquivo no servidor
			Set MyFile = ScriptObject.CreateTextFile(pathfilename,true)
			For i = 1 to LenB(value)
				MyFile.Write chr(AscB(MidB(value,i,1)))
			Next
			MyFile.Close
			
			'retorna mensagem
			if Err.number = 0 then
				if msgOK = "" then
					status = "Enviado com sucesso!"
				else
					status = msgOK
				end if
			else
				if msgErro = "" then
					status = "Ocorreu um erro no envio!"
				else
					status = msgErro
				end if
			end if
			Err.Clear
		else
			if msgExtInvalida = "" then
				status = "Extensão inválida!"
			else
				status = msgExtInvalida
			end if
		end if
		salvaArquivo = msgEnvio
	end function

	function getField(n)
		getField = ""
		if UploadRequest.Exists(n) then getField = UploadRequest.Item(n).Item("Value")
	end function
	
	function getFile(n)
		getFile = ""
		if UploadRequest.Exists(n) then getFile = UploadRequest.Item(n).Item("FileName")
	end function

end Class
%>