Ir para conteúdo
Fórum Script Brasil
  • 0

Upload De Imagens

Milena

Perguntado por Milena,

 Share

Pergunta

Milena

Milena

Postado
Postado

Sei que é uma dúvida muito frequênte ... mas inflezmente não estou coneguindo fazer upload de imanges...

CODE

uploadsDirVar = "C:\img_produtos"

Está dando erro no diretório... já tentei de tudo ... mas não consigo fazer esse upload funcionar nem localmente...

ERRO QUE ESTÁ DANDO:

Folder C:\img_produtos does not exist.

The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions.

After you correct this problem, reload the page.

Link para o comentário
Compartilhar em outros sites

17 respostass a esta questão

Posts Recomendados

  • 0
Milena

Milena

Postado
  • Autor
Postado

Ae consegui um esquema de upload que funciona smile.gif

o arquivo .asp é esse:

<html>
<head>
<title>Upload de fichier</title>
</head>
<body>

  <form method=post ENCTYPE="multipart/form-data">
    File : <input type="file" name="File1"><br>
    <input type="submit" Name="Action" value="Upload the file">
  </form>

</body>
</html>

<!---#INCLUDE FILE="upload.inc" --->

<%

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" For get the fields
  Set Fields = GetUpload()
  FilePath = Server.MapPath(".") & "\" & Fields("File1").FileName
  Fields("File1").Value.SaveAs FilePath
  'response.write(FilePath)
  response.write(FileName)
  End If

	set conexao = server.createObject("ADODB.Connection")
	strcon = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & server.MapPath("amor_arte")& ";uid = sa; pwd =;" 
	conexao.Open strcon

	Set  rsdbCon = Server.CreateObject("ADODB.RECORDSET")
	rsdbCon.ActiveConnection = conexao
	strsql = "INSERT INTO foto (Foto) VALUES ('"&FilePath& "')"
%>

Ele está fazendo o upload, e também gravando no BD, o problema é que este FilePath é o caminho completo não apenas o nome da foto... ~

Não sei como faço para inserir apenas o nome da foto : reservior.bmp

FilePath:

C:\sites\domynio\arquivos\teste\upload\reservior.bmp

Se alguém puder ajudar ... biggrin.gif

Link para o comentário
Compartilhar em outros sites
  • 0
DackAle

DackAle

Postado
Postado

Alguém sabe como faço para guardar apenas o nome da figura : reservior.bmp

e não o endereço completo:

C:\sites\domynio\arquivos\teste\upload\reservior.bmp 

quebra = split(FilePath,"\")

nome = quebra(ubound(quebra))

Set  rsdbCon = Server.CreateObject("ADODB.RECORDSET")
rsdbCon.ActiveConnection = conexao
strsql = "INSERT INTO foto (Foto) VALUES ('" & nome & "')"

wink.gif

Link para o comentário
Compartilhar em outros sites
  • 0
Guest Skyler

Guest Skyler

Postado
Postado

Olá Milena, tudo bem? Gostaria de saber se é no Microsoft Access que você cria o BD? e qual é tipo do campo que você armazena a imagem? é objeto OLE?

De fato o "For Get ", "Fields" e o "GetUpload" eu nunca vi, será que você pode me dizer aonde posso me informar melhor sobre estas instruções???

Estou muito interessado, pois nunca vi um código tão limpo pra fazer o upload de um arquivo, meu PARABÉNS.

Link para o comentário
Compartilhar em outros sites
  • 0
Guest Guest

Guest Guest

Postado
Postado
De fato o "For Get ", "Fields" e o "GetUpload" eu nunca vi, será que você pode me dizer aonde posso me informar melhor sobre estas instruções???

Você está usando um componete????

Link para o comentário
Compartilhar em outros sites
  • 0
Milena

Milena

Postado
  • Autor
Postado

Olá, desculpe, mas sou super iniciante, e não foi eu quem desenvolveu este código...

Eu utilizei a página .ASP que postei acima ....

No meu Banco de Dados coloquei um campo TEXTO , onde guardo o nome da imagem... para poder vizualizá-la depois em outras páginas....

o código da página que é incluida na .asp :

upload.inc

<script RUNAT=SERVER LANGUAGE=VBSCRIPT>
Const IncludeType = 2

'Vous pouvez utiliser ce composant d'upload pourr :
' 1. Uploader de petits fichiers sur le serveur (sauvegarde via les FileSystem object)
' 2. Uploader des fichiers binaires/texte de n'importe quelle taille sur une base de données serveur (RS("BinField") = Upload("FormField").Value)


'restriction de la taille de l'upload
Dim UploadSizeLimit

'********************************** Méthode GetUpload **********************************
'Cette fonction lit les champs de formulaires en entrée binaire et les renvoie en tant qu'objet du dictionnaire.

Function GetUpload()
  Dim Result
  Set Result = Nothing
  If Request.ServerVariables("REQUEST_METHOD") = "POST" Then  'la méthode REQUEST doit être POST
    Dim CT, PosB, Boundary, Length, PosE
    CT = Request.ServerVariables("HTTP_Content_Type")	' lit le header
    If LCase(Left(CT, 19)) = "multipart/form-data" Then	'qui doit être de type "multipart/form-data"

      
      PosB = InStr(LCase(CT), "boundary=") 'Finds boundary
      If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary

      '****** Erreur sur IE5.01 - doublement des entêtes http
      PosB = InStr(LCase(CT), "boundary=") 
      If PosB > 0 then 'Patch pour l'erreur IE
        PosB = InStr(Boundary, ",")
        If PosB > 0 Then Boundary = Left(Boundary, PosB - 1)
      end if
      '****** Erreur sur IE5.01 - doublement des entêtes http

      Length = CLng(Request.ServerVariables("HTTP_Content_Length"))
      If "" & UploadSizeLimit <> "" Then
        UploadSizeLimit = CLng(UploadSizeLimit)
        If Length > UploadSizeLimit Then
          Request.BinaryRead (Length)
          Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length, 0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit, 0) & "B"
          Exit Function
        End If
      End If
      
      If Length > 0 And Boundary <> "" Then 
        Boundary = "--" & Boundary
        Dim Head, Binary
        Binary = Request.BinaryRead(Length) 'lit les données à partir du poste client
        
       
        Set Result = SeparateFields(Binary, Boundary)
        Binary = Empty 'Mise à jour des variables
      Else
        Err.Raise 10, "GetUpload", "longueur nulle ."
      End If
    Else
      Err.Raise 11, "GetUpload", "Pas de fichier joint."
    End If
  Else
    Err.Raise 1, "GetUpload", "Mauvaise méthode de request."
  End If
  Set GetUpload = Result
End Function

'********************************** SeparateFields **********************************
Function SeparateFields(Binary, Boundary)
  Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
  Dim Fields
  Boundary = StringToBinary(Boundary)

  PosOpenBoundary = InStrB(Binary, Boundary)
  PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

  Set Fields = CreateObject("Scripting.Dictionary")
  Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
    'Entête et fichier source
    Dim HeaderContent, FieldContent, bFieldContent
    'entêtes
    Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
    'variable
    Dim Field, TwoCharsAfterEndBoundary
    'Fin de l'entête
    PosEndOfHeader = InStrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

    'Séparation des champs de l'entêter
    HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)
    
    'séparation du contenu
    bFieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

    'séparation des champs d'entête de l'entêter
    GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

    'Creation d'un champs et attribution des paramètres
    Set Field = CreateUploadField()'See the JS function bellow
    Set FieldContent = CreateBinaryData(bFieldContent,LenB(bFieldContent))
'    FieldContent.ByteArray = bFieldContent
'    FieldContent.Length = LenB(bFieldContent)

    Field.Name = FormFieldName
    Field.ContentDisposition = Content_Disposition
    Field.FilePath = SourceFileName
    Field.FileName = GetFileName(SourceFileName)
    Field.ContentType = Content_Type
    Field.Length = FieldContent.Length
    Set Field.Value = FieldContent

'	response.write "<br>:" & FormFieldName
    Fields.Add FormFieldName, Field

    'Dernière borne ?
    TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
    isLastBoundary = TwoCharsAfterEndBoundary = "--"

    If Not isLastBoundary Then 'Putain!!! Pas la dernière... on avance jusqu'au champ suivant.
      PosOpenBoundary = PosCloseBoundary
      PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary)
    End If
  Loop
  Set SeparateFields = Fields
End Function

'********************************** Utilities **********************************

'Separation des champs d'entête de l'entête uploadé
Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
  Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))

  Name = (SeparateField(Head, "name=", ";")) 'ltrim
  If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)

  FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
  If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)

  Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function

'Separation du champ entre sStart et sEnd
Function SeparateField(From, ByVal sStart, ByVal sEnd)
  Dim PosB, PosE, sFrom
  sFrom = LCase(From)
  PosB = InStr(sFrom, sStart)
  If PosB > 0 Then
    PosB = PosB + Len(sStart)
    PosE = InStr(PosB, sFrom, sEnd)
    If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
    If PosE = 0 Then PosE = Len(sFrom) + 1
    SeparateField = Mid(From, PosB, PosE - PosB)
  Else
    SeparateField = Empty
  End If
End Function

'Separation du nom de fichier du chemin
Function GetFileName(FullPath)
  Dim Pos, PosF
  PosF = 0
  For Pos = Len(FullPath) To 1 Step -1
    Select Case Mid(FullPath, Pos, 1)
      Case "/", "\": PosF = Pos + 1: Pos = 0
    End Select
  Next
  If PosF = 0 Then PosF = 1
  GetFileName = Mid(FullPath, PosF)
End Function



Function BinaryToStringSimple(Binary)
  Dim I, S
  For I = 1 To LenB(Binary)
    S = S & Chr(AscB(MidB(Binary, I, 1)))
  Next
  BinaryToStringSimple = S
End Function

Function BinaryToString(Binary)
'	BinaryToString = RSBinaryToString(Binary)
'	Exit Function


  dim cl1, cl2, cl3, pl1, pl2, pl3
  Dim L', nullchar
  cl1 = 1
  cl2 = 1
  cl3 = 1
  L = LenB(Binary)
  
  Do While cl1<=L
    pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
    cl1 = cl1 + 1
    cl3 = cl3 + 1
    if cl3>300 then
      pl2 = pl2 & pl3
      pl3 = ""
      cl3 = 1
      cl2 = cl2 + 1
      if cl2>200 then
        pl1 = pl1 & pl2
        pl2 = ""
        cl2 = 1
      End If
    End If
  Loop
  BinaryToString = pl1 & pl2 & pl3
End Function


Function RSBinaryToString(xBinary)

	Dim Binary

	if vartype(xBinary)=8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary

  Dim RS, LBinary
  Const adLongVarChar = 201
  Set RS = CreateObject("ADODB.Recordset")
  LBinary = LenB(Binary)

	if LBinary>0 then
  RS.Fields.Append "mBinary", adLongVarChar, LBinary
  RS.Open
  RS.AddNew
  	RS("mBinary").AppendChunk Binary 
  RS.Update
  RSBinaryToString = RS("mBinary")
	Else
  RSBinaryToString = ""
	End If
End Function

Function MultiByteToBinary(MultiByte)
  Dim RS, LMultiByte, Binary
  Const adLongVarBinary = 205
  Set RS = CreateObject("ADODB.Recordset")
  LMultiByte = LenB(MultiByte)
	if LMultiByte>0 then
  RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
  RS.Open
  RS.AddNew
  	RS("mBinary").AppendChunk MultiByte & ChrB(0)
  RS.Update
  Binary = RS("mBinary").GetChunk(LMultiByte)
	End If
  MultiByteToBinary = Binary
End Function



Function StringToBinary(String)
  Dim I, B
  For I=1 to len(String)
    B = B & ChrB(Asc(Mid(String,I,1)))
  Next
  StringToBinary = B
End Function


Function vbsSaveAs(FileName, ByteArray)
  Dim FS, TextStream
  Set FS = CreateObject("Scripting.FileSystemObject")

  Set TextStream = FS.CreateTextFile(FileName)

    TextStream.Write BinaryToString(ByteArray) ' BinaryToString is in upload.inc.
  TextStream.Close
End Function


</SCRIPT>
<script RUNAT=SERVER LANGUAGE=JSCRIPT>

function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
  this.Name = null
  this.ContentDisposition = null
  this.FileName = null
  this.FilePath = null
  this.ContentType = null
  this.Value = null
  this.Length = null
}


function CreateBinaryData(Binary, mLength){ return new bin_Init(Binary, mLength) }
function bin_Init(Binary, mLength){
  this.ByteArray = Binary
  this.Length = mLength
  this.String = BinaryToString(Binary)
  this.SaveAs = jsSaveAs
}
//function jsBinaryToString(){
//  return BinaryToString(this.ByteArray)
//};
function jsSaveAs(FileName){
  return vbsSaveAs(FileName, this.ByteArray)
}
//Simulate ByteArray class by JS/VBS - end

</SCRIPT>

Milena

Link para o comentário
Compartilhar em outros sites
  • 0
Milena

Milena

Postado
  • Autor
Postado

Voltando ao assunto....

O meu upload está funcionando corretamente, je estou conseguindo exibir uma foto na tela...

Mas não quero simplismente gravar, no banco, as fotos tem que ter um vínculo com os produtos.

Então queria fazer o seguinte:


codigo=request.form("codigo") 

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" For get the fields
 Set Fields = GetUpload()
 FilePath = Server.MapPath(".") & "\" & Fields("File1").FileName
 Fields("File1").Value.SaveAs FilePath
 'response.write(FilePath)
 response.write(FileName)
 End If

	set conexao = server.createObject("ADODB.Connection")
	strcon = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & server.MapPath("Figuras")& ";uid = sa; pwd =;" 
	conexao.Open strcon

	dim quebra, nome

	quebra = split(FilePath,"\")
	nome = quebra(ubound(quebra))

	Set  rsdbCon = Server.CreateObject("ADODB.RECORDSET")
	rsdbCon.ActiveConnection = conexao
	strsql = "INSERT INTO foto (Foto, Codigo) VALUES ('"&nome& "', '"&codigo&"')"
	rsdbcon.open strsql

Dá erro dizendo que não posso utilizar o request.form

tem alguma outra forma de eu pegar esse valor?

Link para o comentário
Compartilhar em outros sites
  • 0
DackAle

DackAle

Postado
Postado

qual o nome do objeto que se cria para fazer o upload ???

por exemplo se você cria o

set upload = bla bla

tenta upload.form("campo")

porque para você recuperar dados de formulario quando utiliza o metodo de envio de arquivos juntos muda, é o nome do objeto.form("nome_do_campo")

qualquer coisa postae se não entender =)

Link para o comentário
Compartilhar em outros sites
  • 0
Milena

Milena

Postado
  • Autor
Postado

Gente me desculpe voltar no assunto ....

Mas estou com problemas,

da primeira vez que abro a página upload.asp

ele me mostra esse erro:

Erro de tempo de execução do Microsoft VBScript erro '800a0009' 

Subscrito fora do intervalo: 'ubound(...)' 

/arquivos/amor_arte/projetos/web/secoes/adm/hp/upload.asp, line 46
Ele está dando erro na linha 46 , mas acredito que ela não está interferindo em nada, pois mesmo antes de eu adicionar esta linha no código este mesmo erro já ocorria. Um detalhe importante é que : Este erro só aparece da primeira vez que insiro a imagem, depois não aparece mais... 

 If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" For get the fields
 Set Fields = GetUpload()
 FilePath = Server.MapPath(".") & "\" & Fields("File1").FileName
 Fields("File1").Value.SaveAs FilePath
 'response.write(FilePath)
 response.write(FileName)

 End If

	set conexao = server.createObject("ADODB.Connection")
	strcon = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & server.MapPath("Figuras")& ";uid = sa; pwd =;" 
	conexao.Open strcon

	dim quebra, nome

	quebra = split(FilePath,"\")
	nome = quebra(ubound(quebra))

	codigo =  request.QueryString("codigo")
  'response.write(codigo)

	Set  rsdbCon = Server.CreateObject("ADODB.RECORDSET")
	rsdbCon.ActiveConnection = conexao
	strsql = "INSERT INTO foto (Foto, Codigo) VALUES ('"&nome& "','"&codigo& "')"
	rsdbcon.open strsql

Link para o comentário
Compartilhar em outros sites
Visitante
Este tópico está impedido de receber novos posts.
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,7k
×
×
  • Criar Novo...