Autor Tema: Descargar Una Imagen A Una Bd (Leído 2531 veces)

oonai · « **en:** Viernes 6 de Enero de 2006, 16:28 »

Salud2 y feliz año 2006 a la comunidad de este foro. Mi pregunta es sencilla, pero despues de muchos tragos. la cabeza no da mas... Estoy creando un periodico vecinal, ya camina en su totalidad, ahora deseo que el usuario que esta creando la noticia, descarge a la bd access una imagen de su seleccion. Esta rutina no ha funcionado. Deseo saber si alguin conoce algun sitio dende explique esta rutina con detenimiento. GRAcias

oonai

Sigon intentando algunas ideas , pero aun no logro el objetivo.... Requiero Ayuda

Mollense

La verdad es que nunca he guardado una imágen en una BD, lo que he hecho es subir una imágen que el usuario posée en su dísco y guardarla en el servidor al mismo tiempo que la registraba en la base de datos.

La forma de hacerlo hera agregando...

enctype="multipart/form-data"

dentro de la declaración del Form en el que se encontraban varios Input del tipo File

luego de que el usuario precionaba el botón submit, la página que lo recibía leía byte por byte extrallendo el típo de archivo el tamaño etc, etc.

Para esto utilizaba algo como esto:

Código: Text

 
&#60;%On Error Resume Next%&#62;
&#60;%
  Class miGrua
    Public sub TomarDatos()
      dim Datos, cantidadBytes, posActual, posSiguiente, largoPalabra
      dim nombre, datosArchivo, tipo
      cantidadBytes=Request.TotalBytes
      Datos = Request.BinaryRead(cantidadBytes)   
      posActual=1
             
      'impr Datos,  cantidadBytes
      'Response.write &#34;&#60;br&#62;&#60;br&#62;&#60;br&#62;&#34;  
        
      'Extraer nombre del album
      posActual = InStrB(posActual, Datos, aBinario(&#34;NombreAlbum&#34;)) + 13
      posActual = InStrB(posActual, Datos, aBinario(Chr(13))) + 2
      posSiguiente=InStrB(posActual, Datos, aBinario(&#34;---&#34;)) - 2
      largoPalabra=posSiguiente-posActual    
      NombreAlbum = aCadena(MidB(Datos, posActual,largoPalabra))
          
      'Extraer tipo de album
      posActual = InStrB(posActual, Datos, aBinario(&#34;TipoAlbum&#34;)) + 11
      posActual = InStrB(posActual, Datos, aBinario(Chr(13))) + 2
      posSiguiente=InStrB(posActual, Datos, aBinario(&#34;---&#34;)) - 2
      largoPalabra=posSiguiente-posActual    
      TipoAlbum = aCadena(MidB(Datos, posActual,largoPalabra))
      'Response.write &#34;Alb: &#34; & TipoAlbum & &#34;&#60;br&#62;&#34;
      'Response.write &#34;Alb&#34; & NombreAlbum & &#34;&#60;br&#62;&#34;
 
      'Registrar el nuevo album
      codigoAlbum = RegistrarAlbum(NombreAlbum, Session(&#34;Usuario&#34;),TipoAlbum)
      if(codigoAlbum=-1)then
        Response.write &#34;&#60;br&#62; Error interno: Imposible guardar el album &#60;br&#62;&#34; 
        ObjectContext.SetAbort
        exit sub
      end if
      
      Response.write &#34;&#60;h2&#62;Sus recuerdos están seguros en su&#60;BR&#62;ESPACIO PERSONAL&#60;/h2&#62;&#34;
      
      Response.write &#34;&#60;table align=Center border=1&#62;&#34;
        Response.write &#34;&#60;tr&#62;&#60;td colspan=2 align=center&#62;&#60;b&#62;&#34; & NombreAlbum & &#34;&#60;/b&#62;&#60;/td&#62;&#60;/tr&#62;&#34;
      do until posActual=10 or posActual&#62;=cantidadBytes
        posActual = InStrB(posActual, Datos, aBinario(&#34;filename=&#34;)) + 10
        if(posActual&#62;10)then
          'Extraer nombre de la imagen
          posSiguiente=InStrB(posActual, Datos, aBinario(&#34;Content-Type&#34;))-3
          largoPalabra=posSiguiente-posActual    
          nombre = aCadena(MidB(Datos, posActual,largoPalabra))
          nombre = Right(nombre, Len(nombre)-InStrRev(nombre,&#34;&#092;&#34;))
          'Response.write nombre & &#34;&#60;br&#62;&#34;
          
          'Extraer tipo de archivo  (.gif, .jpj, etc)
          tipo = Right(nombre, Len(nombre)-InStrRev(nombre,&#34;.&#34;)+1)
          'Response.write tipo & &#34;&#60;br&#62;&#34;                            
                 
          'Quitar extención al nombre
          nombre = Left(nombre, Len(nombre)-Len(tipo))
          'Response.write nombre & &#34;&#60;br&#62;&#34;
          
          'Extraer datos de archivo
          posActual = InStrB(posActual, Datos, aBinario(&#34;Content-Type&#34;)) + 14
          posActual = InStrB(posActual, Datos, aBinario(Chr(13))) + 2
          posSiguiente=InStrB(posActual, Datos, aBinario(&#34;---&#34;)) - 2
          largoPalabra=posSiguiente-posActual
          largoDatos=largoPalabra
          datosArchivo = MidB(Datos, posActual,largoPalabra)
          'impr datosArchivo,  largoPalabra
          'Response.write &#34;&#60;br&#62;&#34;
                
          
          'Extraer tipo de la imagen (Publica o privada)
          posActual = InStrB(posActual, Datos, aBinario(&#34;TipoImagen&#34;))
          posActual = InStrB(posActual, Datos, aBinario(&#34;P&#34;))
          posSiguiente=InStrB(posActual, Datos, aBinario(&#34;---&#34;)) - 2
          largoPalabra=posSiguiente-posActual    
          TipoImagen = aCadena(MidB(Datos, posActual,largoPalabra))
          'Response.write TipoImagen & &#34;&#60;br&#62;&#34;
          
          if(Len(datosArchivo)&#62;1)then
            'Guardar los Archivos de imagen
            guardarArchivo nombre, datosArchivo, largoDatos, tipo, TipoImagen, exito
            'Registrar los Archivos de imagen en la base de datos
            if(exito=&#34;OK&#34;)then
              codigo=RegistrarImagen(codigoAlbum, nombre & tipo, TipoImagen)
              if(codigo=-1)then
                Response.write &#34;&#60;br&#62; Error interno: Imposible guardar la imagen &#60;br&#62;&#34; 
                ObjectContext.SetAbort
                exit sub
              end if
            end if
          end if
        end if
      loop
      Response.write &#34;&#60;/table&#62;&#34; 
      ObjectContext.SetComplete
      %&#62;    
      &#60;!--#include file= &#34;includes&#092;Error.inc&#34;--&#62;
      &#60;%
    end sub
    
    Private Function aBinario ( str ) 
      Dim i, strbuf 
      for i = 1 to Len(str) 
        strbuf = strbuf & ChrB (AscB (Mid(str, i, 1)))
      next 
      aBinario = strbuf 
    End Function
 
    Private Function aCadena ( bin ) 
      Dim i, bytebuf 
      for i = 1 to LenB(bin) 
        bytebuf = bytebuf & Chr(AscB(MidB(bin, i, 1)))
      next 
      aCadena = bytebuf 
    End Function 
    
    Private Sub impr( bin, bytes ) 
      Dim i, bytebuf 
      for i = 1 to bytes
        Response.write Server.HTMLEncode(ChrB(AscB(MidB(bin, i, 1))))
      next 
    End Sub 
    
    Private Sub guardarArchivo(byRef nombre, byRef datos, bytes, ext, TipoImagen, byRef result)
      dim ruta, archivo, aceptar, aux, subindice         
      
      select case(lCase(ext))
        case &#34;.gif&#34;
          aceptar=&#34;si&#34;
        case &#34;.jpg&#34;
          aceptar=&#34;si&#34;
        case else
          aceptar=&#34;no&#34;
      end select
      
      if(aceptar=&#34;no&#34;)then
        Response.write &#34;Formato no permitido: &#34; & ext & &#34;&#60;br&#62;&#34;
        result=&#34;NO&#34;
        exit sub
      end if
      
      ruta=request.serverVariables(&#34;APPL_PHYSICAL_PATH&#34;) & &#34;Archivos&#092;&#34;
      archivo = ruta & nombre  & ext
      
      set confile = createObject(&#34;scripting.filesystemobject&#34;)
      
      subindice=1
      aux=&#34;&#34;      
      do while(confile.fileExists(archivo))
        aux = nombre & subindice
        subindice=subindice+1
        archivo = ruta & aux & ext
      loop    
      if(aux&#60;&#62;&#34;&#34;)then nombre=aux
      'Response.write archivo & &#34;&#60;br&#62;&#34;
      
      set fich = confile.CreateTextFile(archivo, true) 
      for i=3 to bytes
        c=Chr(AscB(midB(datos,i,1)))
        fich.write(c) 
      next 
      fich.close()
      Response.write &#34;&#60;tr&#62;&#34;
        Response.write &#34;&#60;td&#62;&#34; & nombre & ext & &#34;, &#34; & tamanio(bytes)      
        Response.write &#34;&#60;br&#62;&#34; & TipoImagen  & &#34;&#60;/td&#62;&#34;
        Response.write &#34;&#60;td align=center&#62;&#60;img src=Archivos/&#34; & nombre & ext & &#34; WIDTH=120 HEIGHT=100&#62;&#60;/td&#62;&#34;
      Response.write &#34;&#60;tr&#62;&#34; 
      
      Set confile=Nothing
      set fich=Nothing 
      
      %&#62;    
      &#60;!--#include file= &#34;includes&#092;Error.inc&#34;--&#62;
      &#60;%
      
      result=&#34;OK&#34;
    End Sub
    
    Private Function tamanio( bytes ) 
      Dim MB, KB, m, z
      m=1024*1024
      MB=0
      KB=0
      do while(bytes&#62;m)
        MB=MB+1
        bytes=bytes-m
      loop
      do while(bytes&#62;1024)
        KB=KB+1
        bytes=bytes-1024
      loop
      z=&#34;&#34;
      if(MB&#62;0)then z = MB & &#34; MB &#34;
      if(KB&#62;0)then z = z & KB & &#34; KB &#34;
      if(bytes&#62;0)then z = z & bytes & &#34; bytes&#34;
      tamanio=z
    End Function
          
    
    Private Function RegistrarAlbum(nombreAlbum, usuario, TipoAlbum)
 
      Const adOpenKeyset = 1
      Const adLockOptimistic = 3
  
      Set Conn = Server.CreateObject(&#34;ADODB.Connection&#34;)
      if(Conn.state)then
        Conn.Close()
      end if
      Conn.Open(&#34;DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=&#34; & Server.MapPath(&#34;&#092;bd.mdb&#34;))
  
      'Ver si existe el album
      sqlTxt = &#34;SELECT CodigoAlbum FROM Albunes WHERE NombreAlbum = '&#34; & nombreAlbum & &#34;'&#34;
      set rs=createobject(&#34;ADODB.Recordset&#34;)
      if(rs.state)then
        rs.Close()
      end if
      rs.LockType = adLockOptimistic
      rs.Open sqltxt, Conn
      
      'Si no existe, crearlo
      if(rs.eof)then 
        if(rs.state)then
          rs.Close()
        end if
        sqltxt=&#34;INSERT INTO Albunes(NombreAlbum,Usuario,TipoAlbum) Values(&#34;
        sqltxt=sqltxt & &#34;'&#34; & nombreAlbum & &#34;'&#34;
        sqltxt=sqltxt & &#34;,'&#34; & usuario & &#34;'&#34;
        sqltxt=sqltxt & &#34;,'&#34; & TipoAlbum & &#34;')&#34;
 
        Set Cmd  = CreateObject(&#34;ADODB.Command&#34;)
        Cmd.CommandText = sqltxt
        Cmd.ActiveConnection=Conn
        Cmd.Execute
        Set Cmd=Nothing         
        
        'Ver si está correctamente registrado
        sqlTxt = &#34;SELECT CodigoAlbum FROM Albunes WHERE NombreAlbum = '&#34; & nombreAlbum & &#34;'&#34;
        set rs=createobject(&#34;ADODB.Recordset&#34;)
        if(rs.state)then
          rs.Close()
        end if
        rs.LockType = adLockOptimistic
        rs.Open sqltxt, Conn
        if(rs.eof)then
          codigo=-1
        else
          codigo=rs.Fields(&#34;CodigoAlbum&#34;)
          Response.write &#34;&#60;h2&#62;&#60;B&#62;Un nuevo album a sido creado.&#60;/B&#62;&#60;/h2&#62;&#34;
        end if
      else
        codigo=rs.Fields(&#34;CodigoAlbum&#34;)
        Response.write &#34;&#60;h2&#62;&#60;B&#62;El album ya existe, las imagenes serán anexadas a éste.&#60;/B&#62;&#60;/h2&#62;&#34;
      end if           
            
      Set Conn=Nothing
      set rs=Nothing
      
      %&#62;    
      &#60;!--#include file= &#34;includes&#092;Error.inc&#34;--&#62;
      &#60;%
      
      RegistrarAlbum=codigo
      
    End Function
    
    
    Private Function RegistrarImagen(codigoAlbum, imagen, TipoImagen)
      
      Const adOpenKeyset = 1
      Const adLockOptimistic = 3
  
      Set Conn = Server.CreateObject(&#34;ADODB.Connection&#34;)
      if(Conn.state)then
        Conn.Close()
      end if
      Conn.Open(&#34;DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=&#34; & Server.MapPath(&#34;&#092;bd.mdb&#34;))
  
      sqltxt=&#34;INSERT INTO Imagenes(codigoAlbum,imagen,TipoImagen) Values(&#34;
      sqltxt=sqltxt & &#34;'&#34; & codigoAlbum & &#34;'&#34;
      sqltxt=sqltxt & &#34;,'&#34; & imagen & &#34;'&#34;
      sqltxt=sqltxt & &#34;,'&#34; & TipoImagen & &#34;')&#34;
      'Response.Write sqltxt & &#34;&#60;BR&#62;&#34;
      
      Set Cmd  = CreateObject(&#34;ADODB.Command&#34;)
      Cmd.CommandText = sqltxt
      Cmd.ActiveConnection=Conn
      Cmd.Execute
      Set Cmd=Nothing
      
      sqlTxt = &#34;SELECT CodigoAlbum FROM Imagenes WHERE CodigoAlbum = &#34; & codigoAlbum & &#34; AND imagen = '&#34; & imagen & &#34;'&#34;
      'Response.Write sqltxt & &#34;&#60;BR&#62;&#34;
      
      set rs=createobject(&#34;ADODB.Recordset&#34;)
      if(rs.state)then
        rs.Close()
      end if
      rs.LockType = adLockOptimistic
      rs.Open sqltxt, Conn
      if(rs.eof)then
        codigo=-1
      else
        codigo=rs.Fields(&#34;CodigoAlbum&#34;)
      end if
  
      Set Conn=Nothing
      set rs=Nothing
      
      %&#62;    
      &#60;!--#include file= &#34;includes&#092;Error.inc&#34;--&#62;
      &#60;%
      
      RegistrarImagen=codigo
    End Function  
  end class
%&#62;
 
 

Bueno....ya se fue un poco extenso no?

Nos veremos

SoloCodigo

Autor Tema: Descargar Una Imagen A Una Bd (Leído 2531 veces)

oonai

Descargar Una Imagen A Una Bd

oonai

Re: Descargar Una Imagen A Una Bd

Mollense

Re: Descargar Una Imagen A Una Bd