Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Inside

Upload com redimensionamento

Recommended Posts

Caros amigos,

 

preciso de uma ajuda. Tenho este código de uplod. Implantei nele um código de redimensionamento mas não funciona quando coloco vários formes para uplod. Quando deixo espaço para apenas 1 imagem funciona, mas quando quero fazer uplod de mais fotos o componete não funciona.

 

Alguém pode ajudar?

 

Talvez preciso de um Loop, For, algo do tipo.

 

<%
option explicit
response.buffer = true %>
<meta name="robots" content="noindex">
<%
'Para acessar o arquivo o URL é: upload.asp?acao=enviar

select case request("acao")
case "enviar"

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' MULT UPLOAD
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

dim UploadQueryString, AF_uploadAction, AF_redirectPage, RequestBin, PosBeg, i, char, Posend, boundary, boundaryPos, Pos, intCount, Name, PosFile, PosBound, FileName, ContentType, Value, ValueBeg, ValueLen, Valueend, AF_keys, AF_i, AF_curKey, AF_value, AF_valueBeg, AF_valueLen, AF_curPath

sub BuildUploadRequest(RequestBin)
 PosBeg = 1
 Posend = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
 if Posend = 0 then
	Response.Write "<b>O arquivo não foi enviado com o componente: ENCTYPE=""multipart/form-data""</b>
"
	Response.Write "Por favor faça a correção dos atributos do formulário e tente novamente. <a href=""javascript:history.back(1)"">voltar</a>."
	Response.end
 end if
 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))
 	FileName = Mid(FileName,InStrRev(FileName,"\")+1)
 	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 = FileName
 	ValueBeg = PosBeg-1
 	ValueLen = 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))
 	ValueBeg = 0
 	Valueend = 0
	end if

if FileName = "" then

else

if not Lcase(Right(FileName,3)) = "jpg" then

response.redirect "upload.asp?acao=enviar&m=1"

end if

end if

	UploadControl.Add "Value" , Value	
	UploadControl.Add "ValueBeg" , ValueBeg
	UploadControl.Add "ValueLen" , ValueLen	
	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 UploadFormRequest(name)
 if UploadRequest.Item(name) then
	UploadFormRequest = UploadRequest.Item(name).Item("Value")
 end if 
end function

UploadQueryString = Replace(Request.QueryString,"AF_upload=true","")
if mid(UploadQueryString,1,1) = "&" then
	UploadQueryString = Mid(UploadQueryString,2)
end if

AF_uploadAction = CStr(Request.ServerVariables("URL")) & "?AF_upload=true"
if (Request.QueryString <> "") then 
 if UploadQueryString <> "" then
 AF_uploadAction = AF_uploadAction & "&" & UploadQueryString
 end if 
end if

if (CStr(Request.QueryString("AF_upload")) <> "") then
	
 RequestBin = Request.BinaryRead(Request.TotalBytes)
 Dim UploadRequest
 Set UploadRequest = CreateObject("Scripting.Dictionary") 
 BuildUploadRequest RequestBin
 
 AF_keys = UploadRequest.Keys
 for AF_i = 0 to UploadRequest.Count - 1
	AF_curKey = AF_keys(AF_i)
	if UploadRequest.Item(AF_curKey).Item("FileName") <> "" then
 	AF_value = UploadRequest.Item(AF_curKey).Item("Value")
 	AF_valueBeg = UploadRequest.Item(AF_curKey).Item("ValueBeg")
 	AF_valueLen = UploadRequest.Item(AF_curKey).Item("ValueLen")

 	if AF_valueLen = 0 then
 	Response.Write "<b>Um erro ocorreu durante o envio do arquivo!</b>

"
 	Response.Write "Arquivo: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "
"
 	Response.Write "O arquivo não existe ou está vazio.
"
 	Response.Write "Por favor repita a operação. <a href=""javascript:history.back(1)"">voltar</a>."
 response.end
		end if
 	
 	Dim AF_strm1, AF_strm2
 	Set AF_strm1 = Server.CreateObject("ADODB.Stream")
 	Set AF_strm2 = Server.CreateObject("ADODB.Stream")

 	AF_strm1.Open
 	AF_strm1.Type = 1 'Binary
 	AF_strm2.Open
 	AF_strm2.Type = 1 'Binary
 	
 	AF_strm1.Write RequestBin
 	AF_strm1.Position = AF_ValueBeg
 	AF_strm1.CopyTo AF_strm2,AF_ValueLen
	
 	AF_curPath = Request.ServerVariables("PATH_INFO")
 	AF_curPath = Trim(Mid(AF_curPath,1,InStrRev(AF_curPath,"/")) & "")
 	if Mid(AF_curPath,Len(AF_curPath),1) <> "/" then
 	AF_curPath = AF_curPath & "/"
 	end if 
 	AF_strm2.SaveToFile Trim(Server.mappath(AF_curPath))& "\foto_g\" & UploadRequest.Item(AF_curKey).Item("FileName"),2
 	if err then
 	Response.Write "<b>Um erro ocorreu durante o envio do arquivo!</b>

"
 	Response.Write "Arquivo: " & Trim(AF_curPath) & UploadRequest.Item(AF_curKey).Item("FileName") & "
"
 	Response.Write "O diretório especificado não existe ou não foi configurado a permissão de escrita para a pasta selecionada.
"
 	Response.Write "Por favor verifique as configurações e repita a operação. <a href=""javascript:history.back(1)"">voltar</a>."
 	 err.clear
 response.end
		end if
	end if


'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' REDIMENCIONA FOTOS
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

dim caminho1

caminho1 = "foto_g/"

dim imagem

imagem = FileName

dim Jpeg1

'Criando o thumbnail:
Set Jpeg1 = Server.CreateObject("Persits.Jpeg")

Jpeg1.Open Server.MapPath("" & caminho1 & "" & imagem & "")

'Especifica o tamanho da imagem
Jpeg1.Width = 450
Jpeg1.Height = 338

'Cria um thumbnail e o grava no caminho abaixo
dim nome_final1

nome_final1 = "" & imagem & ""

Jpeg1.Save Server.MapPath("" & caminho1 & "" & nome_final1 & "")

'Para enviar o thumbnail para o browser do cliente utilize o método SendBinary:
Response.Write jpeg1.SendBinary

Set Jpeg1 = Nothing

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'' FIM REDIMENCIONA FOTOS
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


 AF_redirectPage = "upload.asp?acao=upload&arq=" & FileName & ""


 if (AF_redirectPage = "") then
	AF_redirectPage = CStr(Request.ServerVariables("URL"))
 end if

 next

 if (AF_redirectPage <> "") then
	if (InStr(1, AF_redirectPage, "?", vbTextCompare) = 0 And UploadQueryString <> "") then
 	AF_redirectPage = AF_redirectPage & "?" & UploadQueryString
	end if
	Call Response.Redirect(AF_redirectPage) 
 end if 
 
end if 
if UploadQueryString <> "" then
 UploadQueryString = UploadQueryString & "&AF_upload=true"
else 
 UploadQueryString = "AF_upload=true"
end if 

set af_strm1 = nothing
set af_strm2 = nothing

'Fim Multi Upload
%>


<table border="0" cellspacing="0" cellpadding="0">
<tr><td>
<form name="enviar_arquivo" method="post" action="<%=AF_uploadAction%>" enctype="multipart/form-data" onSubmit="return valida_enviar()">
<p><input type="file" name="files1" size="40"></p>
<p><input type="file" name="files2" size="40"></p>
<p><input type="file" name="files3" size="40"></p>
<p><input type="file" name="files4" size="40"></p>
<p><input type="file" name="files5" size="40"></p>
<table border="0" cellpadding="0" cellspacing="0">
<tr><td width="280"></td><td><input type="submit" name="submit1" class="submit" value="Enviar Arquivo(s)"></td></tr></table>
</form>
</td></tr></table>

<% if request.queryString("m") = 1 then %>

<b>ATENÇÃO:</b> Arquivo inválido!

A fotos devem possuir extensão "jpg" somente.

<% end if %>

<script language="JavaScript"><!--
function valida_enviar(form)
{
	if(enviar_arquivo.files1.value.length == 0)
	{
		alert("Selecione um arquivo pelo menos para enviar.");
		enviar_arquivo.files1.focus();
		return false;
	}
}

// -->
</script>

<script language="JavaScript">
//Coloca o foco inicial no campo usuario.
document.enviar_arquivo.files1.focus();
</script>

<% end select %>

<%
select case request("acao")
case "upload" %>




Arquivo(s) publicado(s) com sucesso!




<meta name="refresh" http-equiv="refresh" content="3;URL=upload.asp?acao=enviar">

<% end select %>

 

Obrigado pela atenção recebida.

Compartilhar este post


Link para o post
Compartilhar em outros sites

ele gera algum erro ? se sim, poste o número ???

e também existem exemplos no fórum, pode te ajudar...

Compartilhar este post


Link para o post
Compartilhar em outros sites

o caminho está invalido ou sem permissao de escrita para o IIS em

 

Jpeg1.Save Server.MapPath("" & caminho1 & "" & nome_final1 & "")

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ai que tá, quando eu deixo o formulário com 1 campo apenas ele redimensiona e quando são vários arquivos sendo enviados o redimensionamento não dá loop, alguém sabe como faria isso?

 

Obrigado.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia Inside, eu uso o codigo abaixo e funciona tranquilo.

<%
		'Esse script é personalizavel, pode colocar quantos arquivos quiser, lembrando que alguns servidores de email limita o tamanho do anxo.	
		'Instancia o componente
		SET SaFileUp = Server.CreateObject("SoftArtisans.FileUp") 
		server.ScriptTimeout=99999 ' aumenta o tempo para enviar aquivos maiores
 
			'Configura o caminho onde arquivo será salvo
			SaFileUp.Path = Server.MapPath("fotos/")
             'Para Revenda substitua o caminho físico para E:\vhosts\SEU_DOMINIO_COMPLETO\httpdocs\
 
			'Você pode usar também o caminho relativo se preferir
			'SaFileUp.Path = Server.MapPath("./upload/")
 
			'Caso o usuário não indique um arquivo para upload, informa erro.
			If SaFileUp.IsEmpty Then
					response.write "<center>Por favor, indique um arquivo para upload.</center><br>"
			Else
				'Salva o primeiro arquivo no servidor
				SaFileUp.Form("file1").Save
				'Sava o segundo arquivo no servidor
				SaFileUp.Form("file2").Save
Set SaFileUp = Nothing
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Caro Gilberto Jr,

 

obrigado pela ajuda, porém o meu código funciona a aprte que nao está funcionando é Redimensionamento, o uploa funciona normal.

Compartilhar este post


Link para o post
Compartilhar em outros sites

verifique se esta com as permissoes corretas, também

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sim, a permissão está correto, pois como falei quando deixo o Form com apenas 1 campo para upload o script redimensiona normal.

 

 

<form name="enviar_arquivo" method="post" action="<%=AF_uploadAction%>" enctype="multipart/form-data" onsubmit="return valida_enviar()">
<p><input type="file" name="files1" size="40"></p>
input type="submit" name="submit1" class="submit" value="Enviar Arquivo(s)">
</form>

 

Caros amigos,

 

não quero ser chato mas preciso de uma ajuda.

 

Alguém consegue resolver esse loop?

 

 

Obrigado pela atenção de todos.

Compartilhar este post


Link para o post
Compartilhar em outros sites

qual o erro gerado, atualmente

Compartilhar este post


Link para o post
Compartilhar em outros sites

O erro que ocorre é esse:

 

Persits.Jpeg.1 error '800a0002'

 

Access is denied.

 

/arquivos/upload.asp, line 184

 

A linha 184 é esta:

Jpeg1.Open Server.MapPath("" & caminho1 & "" & imagem & "")

 

Mas não é erro de permissão porque quando deixo o form para enviar apenas 1 arquivo o erro nao acontece.

 

Obrigado pela atenção.

 

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Dê um response.write Server.MapPath("" & caminho1 & "" & imagem & "")

 

E post o resultado.

Compartilhar este post


Link para o post
Compartilhar em outros sites

isso é erro de permissão,

Compartilhar este post


Link para o post
Compartilhar em outros sites

Caro xanburzum,

 

mas porque não dá erro de permissão quando faço upload de apenas 1 imagem?

 

 

Obrigado pela atenção.

Compartilhar este post


Link para o post
Compartilhar em outros sites

verifique se o caminho é um path válido...

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.