Imágenes en bases de datos usando ADO

(Ejemplo con el ADO Datacontrol)

Actualizado el 11/Jul/2001


Esto es una adaptación a ADO del ejemplo publicado anteriormente para DAO sin el data control.
Aunque en DAO con el DATACONTROL no hay que hacer nada especial para leer y guardar imágenes de una base de datos, sin embargo con ADO no es tan automático, al menos no en lo que a guardar la imagen en la base se refiere.
Así que he tomado el código usado en el ejemplo antes mencionado y lo he modificado para usar con ADO.
Aquí te muestro el código del módulo BAS así como el código del formulario de prueba.

El formulario de prueba tiene un ADO datacontrol, un TextBox para mostrar el campo Nombre y un pictureBox para mostrar las imágenes, además de un CommonDialog para seleccionar las imágenes a insertar en el campo.
También tiene tres botones, uno para crear un nuevo registro, otro para guardar (actualizar) la información y un último botón para modificar la imagen del registro activo.
Al final te pongo un link con el código completo y una base de datos Access 97 y otra de Access 2000 para que pruebes.
Para usar una base u otra, simplemente comenta la asignación correspondiente a ConnectionString del DATA.

El código del módulo BAS:

Nota:
El método LeerBinary no se usa en este ejemplo, ya que el ADO Datacontrol actualiza automáticamente los controles ligados a las imágenes guardadas en las bases de datos.


'------------------------------------------------------------------------------
' Código para grabar y leer imágenes en campos de bases             ( 9/Abr/98)
' Adaptado para usarlo con ADO                                      (11/Jul/01)
'
' Adaptado de un par de ejemplos de la ayuda de VB5
'
' ©Guillermo 'guille' Som, 1998-2001
' mensaje@elguille.info
'------------------------------------------------------------------------------
Option Explicit

Private nFile As Long
Private Chunk() As Byte
Private Const mBuffer As Long = 16384&

Public Sub LeerBinary(ADOField As ADODB.Field, unPicture As PictureBox)
    ' Leer la imagen del campo de la base y asignarlo al Picture
    '--------------------------------------------
    ' Este procedimiento no es necesario usarlo
    ' si el Picture está ligado a un data control
    '--------------------------------------------
    Dim nChunks As Long
    Dim nSize As Long
    Dim Fragment As Long
    Dim i As Long
    '
    ' Se usa un fichero temporal para guardar la imagen
    nFile = FreeFile
    Open "pictemp" For Binary Access Write As nFile
    '
    ' Calcular los trozos completos y el resto
    nSize = ADOField.ActualSize
    nChunks = Int(nSize / mBuffer)
    Fragment = nSize Mod mBuffer
    Chunk() = ADOField.GetChunk(Fragment)
    Put nFile, , Chunk()
    For i = 1 To nChunks
        Chunk() = ADOField.GetChunk(mBuffer)
        Put nFile, , Chunk()
    Next
    Close nFile
    Erase Chunk
    ' Ahora se carga esa imagen en el control
    unPicture.Picture = LoadPicture("pictemp")
    
    ' Ya no necesitamos el fichero, así que borrarlo
    On Error Resume Next
    If Len(Dir$("pictemp")) Then
        Kill "pictemp"
    End If
    Err = 0
End Sub

Public Sub GuardarBinary(ADOField As ADODB.Field, unPicture As PictureBox)
    ' Guardar el contenido del Picture en el campo de la base
    Dim i As Long
    Dim Fragment As Long
    Dim nSize As Long
    Dim nChunks As Long
    '
    ' Guardar el contenido del picture en un fichero temporal
    SavePicture unPicture.Picture, "pictemp"
    
    ' Leer el fichero y guardarlo en el campo
    nFile = FreeFile
    Open "pictemp" For Binary Access Read As nFile
    nSize = LOF(nFile)    ' Longitud de los datos en el archivo
    If nSize = 0 Then
        Close nFile
        Exit Sub
    End If
    '
    ' Calcular el número de trozos y el resto
    nChunks = nSize \ mBuffer
    Fragment = nSize Mod mBuffer
    ReDim Chunk(Fragment)
    '
    Get nFile, , Chunk()
    ADOField.AppendChunk Chunk()
    ReDim Chunk(mBuffer)
    For i = 1 To nChunks
        Get nFile, , Chunk()
        ADOField.AppendChunk Chunk()
    Next i
    Close nFile
    '
    ' Ya no necesitamos el fichero, así que borrarlo
    On Local Error Resume Next
    If Len(Dir$("pictemp")) Then
        Kill "pictemp"
    End If
    Err = 0
End Sub

El código del formulario de prueba:


'------------------------------------------------------------------------------
' Acceso a una base de datos con imágenes desde ADO                 (11/Jul/01)
'
' Revisado para ADO por: Guillermo 'guille' Som, 2001
'------------------------------------------------------------------------------
Option Explicit
Private Const mBuffer As Long = 1024&

Private Sub Command1_Click()
    ' Nuevo
    Text1.Text = "Nuevo"
    Command1.Enabled = False
    Command2.Enabled = True
    Text1.Enabled = True
    Data2.Recordset.AddNew
    CommonDialog1.ShowOpen
    Picture1.Picture = LoadPicture(CommonDialog1.FileName)
End Sub

Private Sub Command2_Click()
    ' Grabar
    GuardarBinary Data2.Recordset.Fields(Picture1.DataField), Picture1
    Data2.Recordset.Update
    Command1.Enabled = True
    Command2.Enabled = False
    Text1.Enabled = False
End Sub

Private Sub Command3_Click()
    ' Modificar la imagen del registro actual
    CommonDialog1.ShowOpen
    Picture1.Picture = LoadPicture(CommonDialog1.FileName)
    ' guardar
    Command2_Click
End Sub

Private Sub Form_Load()
    ' Asignar la base de datos y el recordset
    '
    ' Para bases de datos Access 97
    Data2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & App.Path & "\bd1.mdb"
    ' Para bases de datos Access 97 / 2000
    'Data2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\bd2000.mdb"
    '
    Data2.RecordSource = "SELECT * FROM [Sample Table]"
    '
    ' Estos valores están asignados en tiempo de diseño
    '
    CommonDialog1.Filter = "*.bmp; *.gif|*.bmp; *.gif"
    '
    Set Picture1.DataSource = Data2
    Picture1.DataField = "Picture Field"
    Picture1.DataFormat.Type = fmtPicture ' 2 (fmtPicture)
    '
    Set Text1.DataSource = Data2
    Text1.DataField = "Name"
    Text1.DataFormat.Type = fmtGeneral
End Sub

El código de ejemplo y las dos bases de datos de prueba (ImagenesADO.zip 187 KB)


la Luna del Guille o... el Guille que está en la Luna... tanto monta...