[Resolvido] Upload de Arquivos?

Biducaes · Julho 10, 2009

Boa noite a todos!

Sou iniciante no ASP! Tenho um código de Upload para envio de arquivos (imagens) em JPG e GIF, que funcionam perfeitamente!!! Gostaria que o mesmo podesse upar arquivos com extensão .SWF e PNG, além dos que estão upando normalmente (JPG e GIF)!

O código que tenho encontra-se abaixo!

Se alguém poder me ajudar!!!! Eu agradeceria muito!! Pois, com o pouco conhecimento que tenho... tentei de tudo mas não obtive sucesso!!!

Um grande abraço a todos e obrigado!!

<% @ LANGUAGE="VBSCRIPT" %>

<HTML>
<HEAD>
<TITLE>Upload</TITLE>
<style type="text/css">
<!--
.campo_alerta
{
font-family: Tahoma, Verdana, Arial;
font-size: 11px;
border: 1px solid black;
background-color: #cccccc;
}
.texto_pagina
{
font-family: Tahoma, Verdana, Arial;
font-size: 11px;
color: black;
}

.tabela_formulario
{
width: 200;
background-color: white;
}

.titulo_campos
{
font-family: Tahoma, Verdana, Arial;
font-size: 11px;
color: black;
background-color: white;
}

.campos_formulario
{
font-family: Tahoma, Verdana, Arial;
font-size: 11px;
color: dimgray;
background-color: whitesmoke;
border: 1px solid black;
}

.botao_enviar
{
font-family: Tahoma, Verdana, Arial;
font-size: 11px;
color: black;
background-color: gainsboro;
}
-->
</style>
<script language=javascript>
function envia_imagem(imagem) {
self.opener.recebe_imagem('<%=Request("campo")%>', imagem);
window.close();
}
</script>
</HEAD>
<BODY class="texto_pagina">

<%
Sub BuildUploadRequest(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

pasta_imagens = "imagens/" & Request("pasta")
pasta = Server.URLEncode(Request("pasta"))
campo = Server.URLEncode(Request("campo"))

Set objFS = Server.CreateObject("Scripting.FileSystemObject")
If Not objFS.FolderExists(Server.MapPath(pasta_imagens)) Then
  objFS.CreateFolder(Server.MapPath(pasta_imagens))
End if

If Request("enviar") <> "" Then
  Set objFS = Nothing
  byteCount = Request.TotalBytes
  RequestBin = Request.BinaryRead(byteCount)
  Dim UploadRequest
  Set UploadRequest = CreateObject("Scripting.Dictionary")
  BuildUploadRequest  RequestBin
  contentType = UploadRequest.Item("blob").Item("ContentType")
  filepathname = UploadRequest.Item("blob").Item("FileName")
  filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
  value = UploadRequest.Item("blob").Item("Value")
  If Lcase(Right(filename,3)) = "jpg" Or Lcase(Right(filename,3)) = "gif" then
	Set objFS = Server.CreateObject("Scripting.FileSystemObject")
	If objFS.FileExists( Server.mappath(pasta_imagens & "\" & filename)) Then
%>

<script language=javascript>
alert("Erro ao enviar imagem, o arquivo '<%=filename%>' já existe na pasta '<%=pasta_imagens%>' do seu site")
enviar.disabled = false;
</script>

<%

	Else
	  If LenB(value) > 200000 then

%>

<script language=javascript>
alert("Erro ao enviar a imagem, o tamanho do arquivo deve ser menor que 200Kb")
enviar.disabled = false;
</script>

<%
	  Else
%>
<strong>Aguarde o envio da imagem...</strong><br>

<input name="progress" value="0% enviado" style="border:none">
<table width="100" border="0" cellspacing="0" cellpadding="0" style="border: 1px inset">
  <tr>
	<td><input name="barra" style="border:none; background-color: orangered; height: 10; width:1" readonly=""></td>
	<td></td>
  </tr>
</table>

<%
	  Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
	  Set MyFile = ScriptObject.CreateTextFile( Server.mappath(pasta_imagens & "\" & filename))
	  progress = 0
	  n = 0
	  For i = 1 to LenB(value)
		MyFile.Write chr(AscB(MidB(value,i,1)))
		progress = Fix((i * 100) / LenB(value))
		If n <> progress then
		  n = progress
%>

<script language=javascript>progress.value = "<%=n%>% enviado"</script>
<script language=javascript>barra.style.width = "<%=n%>"</script>

<%
		End if
	  Next
	  MyFile.Close
%>
<script language=javascript>
envia_imagem('<%=pasta_imagens & "/" & filename%>');
</script>

<%

	End If
	Set objFS = Nothing
  End if

Else
%>

<script language=javascript>
alert("Erro ao enviar a imagem, lembre-se que ela deve possuir extensão JPG ou GIF");
enviar.disabled = false;
</script>

<%
 End If
End If
%>

<FORM METHOD="post" ENCTYPE="multipart/form-data" ACTION="<%=Request.ServerVariables("SCRIPT_NAME")%>?campo=<%=campo%>&pasta=<%=pasta%>&enviar=sim" onSubmit="enviar.disabled=true">
Enviar uma nova imagem<BR>
<INPUT type="file" name="blob" class="campos_formulario" style="width: 100%"><BR>
<INPUT type="submit" name="enviar" value="Enviar" class="botao_enviar"><br>
<i>(A imagem deve ter nó máximo 200Kb)</i>
</FORM>
Selecionar uma imagem enviada anteriormente<BR>
<DIV class="titulo_campos" style="width:100%; height:175px; visibility: visible; overflow: auto; border:1px solid">
<%
lista_imagens pasta_imagens, "gif,jpg"
Function lista_imagens( strFolder, tipo )
  If Trim( Request.QueryString("folder") ) <> "" Then
	strFolder = Request.ServerVariables("APPL_PHYSICAL_PATH") & Request.QueryString("folder")
  End If

  Dim Folder, File
  Dim ObjFS, objRootFolder
  Set ObjFS = Server.CreateObject("Scripting.FileSystemObject")
  Set objFolder = ObjFS.GetFolder(Server.MapPath(strFolder))
  For Each File in objFolder.files
	tipo = Replace(tipo, ",", "")
	For i = 1 to len(tipo) step 3
	  If Right(File, 3) = Mid(tipo, i, 3) Then
		Response.Write "  <a href=""java script: envia_imagem('" & StrFolder& "/" & File.Name & "')"" class=""texto_pagina"">" & File.Name & "</a><BR>" & vbcrlf
	  End If
	Next
  Next
  
  Response.Write "</td></tr></table>" & vbcrlf
  
  Set objFolder = Nothing
  Set Folder = Nothing
End Function
%>
</DIV>
</BODY>
</HTML>

xanburzum · Julho 10, 2009

é porque você esta limitando extensoes GIF e JPG, altere o code, remova o if das extensoes...

Biducaes · Julho 10, 2009

é porque você esta limitando extensoes GIF e JPG, altere o code, remova o if das extensoes...

Seria este??

If Lcase(Right(filename,3)) = "jpg" Or Lcase(Right(filename,3)) = "gif" then

xanburzum · Julho 10, 2009

sse mesmo...

Biducaes · Julho 10, 2009

sse mesmo...

beleza.. retirei ele.. dae deu erro! Ae eu retrei a linha 223, que era:

alert("Erro ao enviar a imagem, lembre-se que ela deve possuir extensão JPG ou GIF");

enviar.disabled = false;

</script>

<%

End If

%>

Retirei!!

Bem deu certo!! Ele faz o Upload, sendo que mostra sempre o alerta "Erro ao enviar a imagem, lembre-se que ela deve possuir extensão JPG ou GIF", tentei retirar.. mas tb dá erro!

Outra coisa.. neste script, ele mostra os arquivos que estão armazenados na pasta! Retirando o If, ele não apareceu mais!

O que sugeriu, funcionou, mas acontece esses fatores!

1. Mensagem de "Erro ao enviar a imagem, lembre-se que ela deve possuir extensão JPG ou GIF""

2. Não carrega os nomes dos arquivos armazenados na pasta especificada!

xanburzum.... rapazz... esta sendo um apredizado com certeza!!! Até agora, só tenho a lhe agradecer!

xanburzum · Julho 10, 2009

retire o end if k faz parte do

If Lcase(Right(filename,3)) = "jpg" Or Lcase(Right(filename,3)) = "gif" then

Biducaes · Julho 10, 2009

retire o end if k faz parte do

If Lcase(Right(filename,3)) = "jpg" Or Lcase(Right(filename,3)) = "gif" then

Então... retirei o "End".. coloquei acima em vermelho e sublinhado para você ver! Dae funcionou, somente ocorre os fatores 1 e 2 que mencionei acima!

xanburzum · Julho 10, 2009

vai precisar adequar o code mesmo, tire o javascript, k da a mensagem

e altere o

lista_imagens pasta_imagens, "gif,jpg"

Biducaes · Julho 10, 2009

vai precisar adequar o code mesmo, tire o javascript, k da a mensagem

e altere o

lista_imagens pasta_imagens, "gif,jpg"

Rapazzzzz................ showww!!!!

você é 10!!!!!!!!

Me ajudou muitoo!!!

Te agradeço de coração brother!!!

Pode até colocar o tópico como resolvido se quiser!!!

Mais uma vez, muito... mas muito obrigado mesmo!!!!

Um grande abraço!

xanburzum · Julho 10, 2009

maravilha ,ficamos feliz k conseguiu...

kker coisa estamos ae...

Arquivado

[Resolvido] Upload de Arquivos?

Recommended Posts

Biducaes 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

Biducaes 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

Biducaes 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

Biducaes 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

Biducaes 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

Fixar div até atingir uma certa altura

PHP+Codeigniter - Dúvida referente a PDV

PHP+Codeigniter - Dúvida em Relação a Teclas

Fóruns

Tempo Real

Informação importante