Ir para conteúdo

POWERED BY:

Arquivado

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

WEBIER

[Resolvido] Cadastro com foto

Recommended Posts

Meu codigo:

<%
Dim ADOCnn
Dim objUpload
Dim strErro
Dim strURLFOTO
Dim strExtensao

strErro = ""
strURLFOTO = ""

On error resume next

Set objUpload = Server.CreateObject("Dundas.Upload.2") 
objUpload.UseVirtualDir = true
objUpload.UseUniqueNames = True 
objUpload.Save "\Classificados\imagens\"

if objUpload.Form("txtNome") = "" then
strErro = strErro & " - NOME<br>"
end if

if objUpload.Form("txtTelefone") = "" then
strErro = strErro & " - TELEFONE<br>" 
end if

if objUpload.Form("txtEmail") = "" then
strErro = strErro & " - E-MAIL<br>" 
end if

if objUpload.Form("txtTitulo") = "" then
strErro = strErro & " - TITULO<br>" 
end if

if objUpload.Form("cboTipo") = "" then
strErro = strErro & " - TIPO<br>" 
end if

if objUpload.Form("txtDescricao") = "" then
strErro = strErro & " - DESCRIÇÃO<br>"
end if

if objUpload.Files.Count > 0 then
	strURLFOTO = "\Classificados\imagens\" & objUpload.GetFileName(objUpload.Files(0).Path)
	strExtensao = objUpload.GetFileExt(objUpload.Files(0).Path) 
else
	strURLFOTO = "\Classificados\imagens\semfoto.jpg"
end if

If Err <> 0 or strExtensao <> "jpg" and strExtensao <> "gif" and strExtensao <> "bmp" Then
	%>	
	<span class="texto">
	<p style="margin-top: 0; margin-bottom: 0"><br>
	  <font color="#CC0000"><b><font size="3">HOUVE UM ERRO NA HORA DE CARREGAR O ARQUIVO !!</font></b></font></p>
	<p style="margin-top: 0; margin-bottom: 0"><br>
	2 - VERIFIQUE A EXTENSÃO DO ARQUIVO , SOMENTE IMAGENS SÃO PERMITIDAS (*.JPG , *.GIF , *.BMP )<br>
	3 - SE NENHUM DESSES PASSOS RESOLVERAM , ENTRE EM CONTATO COM O SITE <BR>
	   </p>
	<p style="margin-top: 0; margin-bottom: 0"><b>
	<a href=javascript:history.back(-1)>VOLTAR</a></b></font>
	<%
	objUpload.FileDelete "\Classificados\Imagens\" & objUpload.GetFileName(objUpload.Files(0).Path)
	Set objUpload = Nothing
	Response.End()
else
	Set ADOCnn = Server.CreateObject("ADODB.Connection")
	ADOCnn.Open("Provider=Microsoft.Jet.OLEDB.4.0; Data Source="& Server.MapPath("\Classificados\CLASSIFICADOS.MDB"))
	
	ADOCnn.Execute("INSERT INTO TAB_CLAS(CLAS_NOM,CLAS_TEL,CLAS_MAIL,CLAS_TIT,CLAS_TIPO,CLAS_FOTO,CLAS_DESC,CLAS_DATA) VALUES ('" & ucase(objUpload.Form("txtNome")) & "','" & objUpload.Form("txtTelefone") & "','" & objUpload.Form("txtEmail") & "','" & ucase(objUpload.Form("txtTitulo")) & "','" & objUpload.Form("cboTipo") & "','" & strURLFOTO & "','" & objUpload.Form("txtDescricao") & "',#" & Date() & "#)")
	Set ADOCnn = Nothing
	Set objUpload = Nothing
	Response.Redirect("classificado.asp")
end if
%>

já conferir o banco de dados, a tabela, os campos, os objetos do form e a validação dos objetos e todos estao perfeitos.. os dados estão preenchidos corretamente nos objetos no form.

 

mas sempre ele usa o primeiro IF (If Err <> 0 or strExtensao <> "jpg" and strExtensao <> "gif" and strExtensao <> "bmp" Then).... uma hora para testar deixei o primeiro IF somente assim (If Err <> 0 then) e continua somente no primeiro IF, ou seja, sempre a mesma msg:

 

HOUVE UM ERRO NA HORA DE CARREGAR O ARQUIVO !!

 

2 - VERIFIQUE A EXTENSÃO DO ARQUIVO , SOMENTE IMAGENS SÃO PERMITIDAS (*.JPG , *.GIF , *.BMP )

3 - SE NENHUM DESSES PASSOS RESOLVERAM , ENTRE EM CONTATO COM O SITE

 

VOLTAR

 

uma hora tire esse primeiro IF todo... deixei somente:

	Set ADOCnn = Server.CreateObject("ADODB.Connection")
	ADOCnn.Open("Provider=Microsoft.Jet.OLEDB.4.0; Data Source="& Server.MapPath("\Classificados\CLASSIFICADOS.MDB"))
	
	ADOCnn.Execute("INSERT INTO TAB_CLAS(CLAS_NOM,CLAS_TEL,CLAS_MAIL,CLAS_TIT,CLAS_TIPO,CLAS_FOTO,CLAS_DESC,CLAS_DATA) VALUES ('" & ucase(objUpload.Form("txtNome")) & "','" & objUpload.Form("txtTelefone") & "','" & objUpload.Form("txtEmail") & "','" & ucase(objUpload.Form("txtTitulo")) & "','" & objUpload.Form("cboTipo") & "','" & strURLFOTO & "','" & objUpload.Form("txtDescricao") & "',#" & Date() & "#)")
	Set ADOCnn = Nothing
	Set objUpload = Nothing
	Response.Redirect("classificado.asp")

simplesmente nao aconteceu nada... nao armazenou e nem deu msg de erro.

 

Onde tô errando?

Compartilhar este post


Link para o post
Compartilhar em outros sites

tira o

 

On error resume next

para corrigir primeiramente os erros que ocorrem depois poe

 

Outra coisa testou se

 

strExtensao = objUpload.GetFileExt(objUpload.Files(0).Path)

 

está realmente pegando a extensão correta?

Compartilhar este post


Link para o post
Compartilhar em outros sites

tira o

 

On error resume next

para corrigir primeiramente os erros que ocorrem depois poe

 

Outra coisa testou se

 

strExtensao = objUpload.GetFileExt(objUpload.Files(0).Path)

 

está realmente pegando a extensão correta?

 

eu tire o "On error resume next" e deu o seguinte erro:

Script error detected at line 14.

Source line: objUpload.UseVirtualDir = true

Description: Objeto necessário

 

outra coisa, como faço para testar se tah pegando a extensão?

Compartilhar este post


Link para o post
Compartilhar em outros sites

só escrever o valor da variavel

 

Response.write(strExtensao)

Compartilhar este post


Link para o post
Compartilhar em outros sites

ele gera algum número de erro ???

Compartilhar este post


Link para o post
Compartilhar em outros sites

verifique se eta Desabilitando mensagens de erro HTTP amigáveis no browser e dá uma olhada neste exemplo

 

Upload aceitando apenas imagens Gif e Jpg

 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>

<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")
'response.write(pasta_imagens & "\" & filename)
'response.end()
    
    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>

Compartilhar este post


Link para o post
Compartilhar em outros sites

ele gera algum número de erro ???

 

se eu tirar o "On error resume next" ele dar o seguinte erro:

Script error detected at line 14.

Source line: objUpload.UseVirtualDir = true

Description: Objeto necessário

Compartilhar este post


Link para o post
Compartilhar em outros sites

você esta usando algum direório virtual, certifique-se que o path do ISS esta habilitado, e se gera algum ero tipo 0800.....

e veja o exemplo que postei, poe te ajudar

Compartilhar este post


Link para o post
Compartilhar em outros sites

O problema era no servidor de teste local

 

Quando hospedei funcionou perfeitamente

 

Obrigado a todos!

 

como marco esse topico como resolvido?

Compartilhar este post


Link para o post
Compartilhar em outros sites

Que bom que resolveu

 

Apenas os moderadores fazem a marcação

 

Abraços

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.