************************************
*Recopilado por el Buho de la Web:
*http://www.terra.es/personal2/sfortiz/
************************************

Graba Imagen en BD
==================
 
Sub GrabaImagenEnBD(f As adodb.Field, NombreImagen As String)
Dim Fichero As Integer

Dim LongitudFichero As Long
Const TamañoBuffer = 1024
Dim TamañoMinimo As Long
Dim Bloques As Long
Dim x() As Byte
Dim i As Long

On Error GoTo ErrorGrabaImagenEnBD
Fichero = FreeFile
Open NombreImagen For Binary Access Read As Fichero

LongitudFichero = LOF(Fichero)
Bloques = Int(LongitudFichero / TamañoBuffer)
TamañoMinimo = LongitudFichero Mod TamañoBuffer

ReDim x(TamañoMinimo)
Get Fichero, , x()
f.AppendChunk x()

ReDim x(TamañoBuffer)
For i = 1 To Bloques
    Get Fichero, , x()
    f.AppendChunk x()
Next
Close Fichero
Exit Sub
ErrorGrabaImagenEnBD:
    MuestraError   "GrabaImagenEnBD", Err, Error
End Sub

 
Coge Imagen de BD
=================
 
Sub CogeImagenDeBD(f As adodb.Field, NombreImagen As String)
Dim Fichero As Integer
Const TamañoBuffer = 1024
Dim TamañoMinimo As Long
Dim Bloques As Long
Dim x() As Byte
Dim i As Long

On Error GoTo ErrorCogeImagenDeBD
Fichero = FreeFile
Open NombreImagen For Binary Access Write As Fichero

Bloques = Int(f.ActualSize / TamañoBuffer)
TamañoMinimo = f.ActualSize Mod TamañoBuffer
x() = f.GetChunk(TamañoMinimo)
Put Fichero, , x()
For i = 1 To Bloques
    x() = f.GetChunk(TamañoBuffer)
    Put Fichero, , x()
Next
Close Fichero
Exit Sub
ErrorCogeImagenDeBD:
    MuestraError "CogeImagenDeBD", Err, Error
End Function

 
Form_Load
 
Private Sub Form_Load()

Adodc2.Refresh
Adodc2.Recordset.AddNew

Call GrabaImagenEnBD(Adodc2.Recordset!imagen, App.Path & "\imagen.bmp")
Adodc2.Recordset.Update
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
    Adodc2.Recordset.MoveLast
    Call CogeImagenDeBD(Adodc2.Recordset!imagen, App.Path & "\temp.bmp")
End If
Picture1.Picture = LoadPicture(App.Path & "\temp.bmp")
Adodc2.Refresh
Adodc2.Recordset.MoveFirst

End Sub

 
  

    Source: geocities.com/es/ensolva/Descargas/Documentos

               ( geocities.com/es/ensolva/Descargas)                   ( geocities.com/es/ensolva)                   ( geocities.com/es)