Retrieving an image from a DB

Hi,

I've answered this questions a few times here on EE.  Before pasting the code again, I'll give you the tip that you can often find the answer you need by searching the Previously Asked Questions (PAQs), and then getting the answer will only cost you a few points, rather than 100.  Of course, some times you have to buy a few questions to get a good answer, but you can certainly buy a lot of questions for 100 points....

Here is a complete program for reading an image from the database and displaying it in a picturebox, and also for allowing a user to load a picture from a hard-drive and then update the database with it.  This should work with Access or SQL Server or even Oracle, provided your column is defined as the proper data type in that db.

'***************************************************************************************
' Project references the Microsoft Active Data Objects Library v 2.5
' Project component references the Common Dialog Control (named cdlg)
'
' 1 Form - frmMain
' 2 Lables and Textboxes - lblFirstName, txtFirstName, lblLastName, txtLastName
' 1 Picturebox - picPhoto
' 6 Command Buttons - cmdFind, cmdFirst, cmdPrevious, cmdNext, cmdLast, cmdUpdateImage
'
'***************************************************************************************
'***************************************************************************************

' ADO Objects
Private Conn As ADODB.Connection
Private RS As ADODB.Recordset

' Saves the project path for reading/writing temp files
Private sPath As String

' A couple of sample Connect Strings
Const SQL_SERVER_DATABASE = "Provider=SQLOLEDB;Data Source=MYSERVER; Initial Catalog=MYDATABASE; User ID=MYUSERID;Password=MYPASSWORD;"
Const ACCESS_DATABASE = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=H:\Code\ImageDB\nwind.mdb"

Private Sub cmdFind_Click()
Dim sCriteria As String
Dim vSavePlace As Variant

' Save the currently active record
    vSavePlace = RS.Bookmark
   
' Build the Search Criteria
    If txtFirstName.Text <> "" Then
        sCriteria = "FIRSTNAME LIKE '" & txtFirstName.Text & "%'"
    End If
   
    If txtLastName.Text <> "" Then
        If Len(sCriteria) = 0 Then
            sCriteria = "LASTNAME LIKE '" & txtLastName.Text & "%'"
        Else
            sCriteria = sCriteria & " AND LASTNAME LIKE '" & txtLastName.Text & "%'"
        End If
    End If
   
' Search for the record starting from the beginning of the recordset
    RS.Find sCriteria, , adSearchForward, 1
' If not found then reposition on the previously active record
    If RS.BOF Or RS.EOF Then
        MsgBox "Record Not Found"
        RS.Bookmark = vSavePlace
    End If
   
' Now, display the record
    DisplayRecord
   
End Sub

Private Sub cmdFirst_Click()
' Move to the last record.
    RS.MoveFirst
' Now, display the record
    DisplayRecord
End Sub

Private Sub cmdLast_Click()
' Move to the last record.
    RS.MoveLast
' Now, display the record
    DisplayRecord
End Sub

Private Sub cmdNext_Click()
' Move to the next record.  If you moved past the end of the recordset then reposition
    RS.MoveNext
    If RS.EOF Then
        RS.MoveLast
    End If
' Now, display the record
    DisplayRecord
End Sub

Private Sub cmdPrevious_Click()
' Move to the previoius record.  If you moved past the start of the recordset then reposition
    RS.MovePrevious
    If RS.BOF Then
        RS.MoveFirst
    End If
' Now, display the record
    DisplayRecord
End Sub

Private Sub cmdUpdateImage_Click()
   
' Prep the common dialog control
    cdlg.DialogTitle = "Update Image"
    cdlg.Filter = "JPG Files *.jpg|*.jpg|GIF Files *.gif|*.gif|BMP Files *.bmp|*.bmp|All Files *.*|*.*"
    cdlg.ShowOpen
    If cdlg.FileName <> "" Then
' If a file was choosen then try to update the record
        AddImage RS, cdlg.FileName
        RS.Update
' Now, redisplay the current record with the updated image
        DisplayRecord
    End If
 
End Sub

Private Sub AddImage(RS As ADODB.Recordset, ByVal FileName As String)
' Declare a stream object
Dim oStream As ADODB.Stream

' Create a new instance
Set oStream = New ADODB.Stream
oStream.Type = adTypeBinary
oStream.Open

' Tell it the source of the stream
oStream.LoadFromFile FileName
 
'Load the binary object into the field value
RS.Fields("Photo").Value = oStream.Read

' Close the stream and clean house
oStream.Close
Set oStream = Nothing

End Sub

Private Sub ReadImage(RS As ADODB.Recordset, ByVal FileName As String)
' Declare a stream object
Dim oStream As ADODB.Stream

' Create a new instance
Set oStream = New ADODB.Stream
oStream.Type = adTypeBinary
oStream.Open

' Read the field value into the stream object
oStream.Write RS.Fields("Photo").Value

' Save out to a local file
oStream.SaveToFile FileName, adSaveCreateOverWrite

' Close the stream and clean house
oStream.Close
Set oStream = Nothing

End Sub

Private Sub DisplayRecord()
On Error Resume Next

' Load the textboxes on the screen from the recordset
    txtFirstName.Text = RS("FIRSTNAME").Value
    txtLastName.Text = RS("LASTNAME").Value

' Save the Photo to a local file
    ReadImage RS, sPath & "temp.dat"

' Load the local file into a picturebox
    picPhoto.Picture = LoadPicture()
    picPhoto.Picture = LoadPicture(sPath & "temp.dat")
   

End Sub

Private Sub Form_Load()
' Open your database connection
Set Conn = New ADODB.Connection
With Conn
'    .ConnectionString = SQL_SERVER_DATABASE
    .ConnectionString = ACCESS_DATABASE
    .CursorLocation = adUseClient
    .Open
End With

' Always check to make sure the Connection is valid
If Conn.State <> adStateOpen Then
    MsgBox "Failed to Open Connection", vbExclamation, "Open Connection"
    End
End If

' Open your recordset
Set RS = New ADODB.Recordset
With RS
  .Source = "Select * From Employees"
  .ActiveConnection = Conn
  .CursorType = adOpenDynamic
  .LockType = adLockOptimistic
  .Open
End With

' Always check to make sure the Recordset is valid
If RS.State <> adStateOpen Then
    MsgBox "Failed to Open Recordset", vbExclamation, "Open Recordset"
    End
End If

' if your EXE happens to be in a root directory, the path wont have a "\"
' otherwise, it will.  In either case, make sure it has one.
If Right(App.Path, 1) = "\" Then
    sPath = App.Path
Else
    sPath = App.Path & "\"
End If

' Display the first record
DisplayRecord

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next

'Close your Recordset
RS.Close
Set RS = Nothing

'Close your database connection
Conn.Close
Set Conn = Nothing

End Sub

i use this code to put the pic in the DB, is there an easy way to reverse this?

   ChunkSize = 8192
   

   If Dir$(CommonDialog1.FileName) = "" Then Err.Raise 53, , "File not found"
   
   fnum = FreeFile
   Open CommonDialog1.FileName For Binary As fnum

   bytesLeft = LOF(fnum)
   Do While bytesLeft
       bytes = bytesLeft
       If bytes > ChunkSize Then bytes = ChunkSize
       ReDim tmp(1 To bytes) As Byte
       Get #1, , tmp
       rsrecordset("pic").AppendChunk tmp
       bytesLeft = bytesLeft - bytes
   Loop
   
   Close #fnum

Here is my old example using the GetChunk method.  Both will work, but I like the new example using the stream object better....

Dim DataFile As Integer
Dim Fl As Long
Dim Fragment As Integer
Dim Chunks As Integer
Dim Chunk() As Byte
Dim I As Integer
Const ChunkSize As Integer = 16384


Private Sub ReadFromDB_Click()

     
    DataFile = FreeFile
    Open "pictemp" For Binary Access Write As DataFile
     
    Fl = RS("Photograph").ActualSize
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize

    ReDim Chunk(Fragment)
    Chunk() = RS("Photograph").GetChunk(Fragment)
    Put DataFile, , Chunk()
     
    For I = 1 To Chunks
        ReDim Buffer(ChunkSize)
        Chunk() = RS("Photograph").GetChunk(ChunkSize)
        Put DataFile, , Chunk()
    Next I
     
    Close DataFile
         
End Sub

opps, at the end of that, you'd do a:

Picture1.Picture = LoadPicture("pictemp")

Fl  is always 0, should i change something on these lines?

rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic

You might try adOpenKeyset.  Here is the complete program using the Get/AppendChunk syntax.  It was written for SQL Server but also worked perfectly with Oracle and the Blob data type.

Option Explicit
Dim CMD As ADODB.Command
Dim CN As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Parm1 As ADODB.Parameter
Dim SQL As String

Dim DataFile As Integer
Dim Fl As Long
Dim Fragment As Integer
Dim Chunks As Integer
Dim Chunk() As Byte
Dim I As Integer
Const ChunkSize As Integer = 16384

Private Sub Form_Load()
Dim strConnection As String
Dim sSQL As String

    Set CN = New ADODB.Connection
    With CN
        .ConnectionTimeout = 3
        .CursorLocation = adUseClient
        .Mode = adModeReadWrite
        .IsolationLevel = adXactReadCommitted
        .Provider = "SQLOLEDB"
    End With
         
   strConnection = "Provider=SQLOLEDB;SERVER=MYDB01;" & _
                "User ID=MYUID;Password=MYPWD;database=PUBS"
     
    CN.Open strConnection, "", ""

    If CN.State <> adStateOpen Then
        MsgBox "Unable to connect"
        End
    End If
   
    Set Parm1 = New ADODB.Parameter
    With Parm1
        .Direction = adParamInput
        .Type = adVarChar
        .Size = 255
    End With
     
    sSQL = "Select * from PHOTO WHERE CAPTION = ?"
    Set CMD = New ADODB.Command
    With CMD
        .CommandText = sSQL
        .CommandType = adCmdText
        .ActiveConnection = CN
        .Parameters.Append Parm1
    End With
     
End Sub
   Private Sub LoadFromFile_Click() '
'  Locates a file and sets the Filename to this file.'
    With CommonDialog1
        .Filter = "Pictures(*.bmp;*.ico)|*.bmp;*.ico"
        .ShowOpen
        FileName = .FileName
    End With
   End Sub

Private Sub LoadWavFromFile_Click()
'  Locates a file and sets the Filename to this file.'
    With CommonDialog1
        .Filter = "Sounds(*.wav)|*.wav|All (*.*)|*.*"
        .ShowOpen
        WavFileName = .FileName
    End With
   ' Set properties needed by MCI to open.
   MMControl1.Notify = False
   MMControl1.Wait = True
   MMControl1.Shareable = False
   MMControl1.DeviceType = "WaveAudio"
   MMControl1.FileName = WavFileName
   ' Open the MCI WaveAudio device.
   MMControl1.Command = "Open"
End Sub

Private Sub ReadFromDB_Click()
     
    If Len(NameWanted) = 0 Then
        NameWanted = InputBox("Enter name wanted", "Animal")
    End If
     
    Parm1.Value = NameWanted
    Set Rs = CMD.Execute
     
    If Rs.State <> adStateOpen Then
        MsgBox "Cant open result set"
        Exit Sub
    End If
     
    If Rs.EOF Or Rs.BOF Then
        MsgBox "Cant find picture by that name"
        Exit Sub
    End If
     
    DataFile = 1
    Open "pictemp" For Binary Access Write As DataFile
     
    Fl = Rs("Photograph").ActualSize
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize

    ReDim Chunk(Fragment)
    Chunk() = Rs("Photograph").GetChunk(Fragment)
    Put DataFile, , Chunk()
     
    For I = 1 To Chunks
        ReDim Buffer(ChunkSize)
        Chunk() = Rs("Photograph").GetChunk(ChunkSize)
        Put DataFile, , Chunk()
    Next I
     
    Close DataFile
     
    FileName = "pictemp"
    FileName_Change

    DataFile = 2
    MMControl1.Command = "Close"

    Open "wavtemp.wav" For Binary Access Write As DataFile
     
    Fl = Rs("Sound").ActualSize
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize

    ReDim Chunk(Fragment)
    Chunk() = Rs("Sound").GetChunk(Fragment)
    Put DataFile, , Chunk()
     
    For I = 1 To Chunks
        ReDim Buffer(ChunkSize)
        Chunk() = Rs("Sound").GetChunk(ChunkSize)
        Put DataFile, , Chunk()
    Next I
     
    Close DataFile
     
    WavFileName = "wavtemp.wav"
    WavFileName_Change

End Sub

Private Sub SaveToDB_Click()
Dim UpdateMode As Boolean
    UpdateMode = False
     
    Set Rs = New ADODB.Recordset
    Set Rs.ActiveConnection = CN
    Rs.CursorType = adOpenKeyset
    Rs.LockType = adLockBatchOptimistic
         
'    Set Rs = CMD.Execute
    Rs.Open "SELECT * FROM PHOTO WHERE CAPTION = '" & NameWanted & "'"
     
    If Rs.State <> adStateOpen Then
        MsgBox "Cant open result set"
        Exit Sub
    End If
     
    If Rs.EOF Or Rs.BOF Then
        UpdateMode = False
    Else
        UpdateMode = True
    End If

    If Rs.Supports(adUpdate) = False Then
        MsgBox "Cant write to result set"
        Exit Sub
    End If
     
    If Not UpdateMode Then
        Rs.AddNew
    End If
     
    Rs("Caption").Value = NameWanted
   
    DataFile = 1
    Open FileName For Binary Access Read As DataFile
    Fl = LOF(DataFile)    ' Length of data in file
     
    If Fl = 0 Then
        Close DataFile
        Exit Sub
    End If
     
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize
     
    Rs("Photograph").AppendChunk Null
    ReDim Chunk(Fragment)
    Get DataFile, , Chunk()
    Rs("Photograph").AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
     
    For I = 1 To Chunks
        Get DataFile, , Chunk()
        Rs("Photograph").AppendChunk Chunk()
    Next I
     
    Close DataFile
     
    DataFile = 2
    Open WavFileName For Binary Access Read As DataFile
    Fl = LOF(DataFile)    ' Length of data in file
     
    If Fl = 0 Then
        Close DataFile
        Exit Sub
    End If
     
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize
     
    Rs("Sound").AppendChunk Null
    ReDim Chunk(Fragment)
    Get DataFile, , Chunk()
    Rs("Sound").AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
     
    For I = 1 To Chunks
        Get DataFile, , Chunk()
        Rs("Sound").AppendChunk Chunk()
    Next I
     
    Close DataFile
     
    Rs.UpdateBatch
End Sub
Private Sub FileName_Change()
    Picture1.Picture = LoadPicture(FileName)
End Sub

Private Sub WavFileName_Change()
On Error Resume Next
   MMControl1.Command = "Close"
   MMControl1.Notify = False
   MMControl1.Wait = True
   MMControl1.Shareable = False
   MMControl1.DeviceType = "WaveAudio"
   MMControl1.FileName = WavFileName
   ' Open the MCI WaveAudio device.
   MMControl1.Command = "Open"
End Sub

ping

Hello

 see this article from microsoft msdn

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnvbpj01/html/gs0102.asp

and here's a sample project to do that also
http://www.freevbcode.com/ShowCode.Asp?ID=589 

Still there Andy?

yes, i'm just looking through the code to find a solution that will work for me....

There has got to be a different way then writing it to a file before loading it.

There may be, but then you loose the advantage of using LoadPicture.  LoadPicture is smart enough to load all of the major file types into a VB Picturebox.  This allows you to store jpg, gif, bmp etc. in the database in their native formats.  If you wrote directly from a picturebox to the database, you might be able to read directly back into the picturebox, but I don't have the code for this.

I've done a lot of research on this and even Microsoft recommends the temp file approach.  And, after using this in several production applications, I find that it works reliably well, and it is fast enough for most applications.

So, I've given you two different programs that answer your original question, don't you think it's time to close this one out :)

I still can't get this code to work, I am running a MYSQL DB ... not sure it that throws a wrench in to it.?

Can you show your current code?  If you were successful in using AppendChunk to put the data into the database, then the GetChunk should be successful in retrieving it.

Did you try the stream example against your database?  It should be as simple as changing the connect string, the table and column name, and then you could run it.

this is my code to put the pic in the DB...

    Dim rsrecordset As ADODB.Recordset
    Set adodataconn = New ADODB.Connection
    adodataconn.CursorLocation = adUseClient
    adodataconn.Open "Driver={MySql};Server=my.com;Port=3306;Option=132072;Stmt=;Database=DB", "UserName", "Password"
    Set rsrecordset = New ADODB.Recordset
    rsrecordset.CursorType = adOpenStatic
    rsrecordset.CursorLocation = adUseServer
    rsrecordset.LockType = adLockOptimistic
    rsrecordset.Source = "Select * From tblInfo"
    rsrecordset.ActiveConnection = adodataconn
    rsrecordset.Open
        rsrecordset.AddNew
        Dim vwrite As String
        Dim myData As Byte
       
        Dim varchunk As Variant
        Dim ingoffset As Long
        Dim conchunksize
        Dim inglogosize As Long
        Dim recNum As Long
       
       
    Open CommonDialog1.Filename For Binary As #1
    Dim tmp() As Byte
    Dim ChunkSize As Long
    ChunkSize = 8192
   

     If Dir$(CommonDialog1.Filename) = "" Then Err.Raise 53, , "File not found"
   
   fnum = FreeFile
   Open CommonDialog1.Filename For Binary As fnum

   bytesLeft = LOF(fnum)
   Do While bytesLeft
       bytes = bytesLeft
       If bytes > ChunkSize Then bytes = ChunkSize
       ReDim tmp(1 To bytes) As Byte
       Get #1, , tmp
       rsrecordset("Logo").AppendChunk tmp
       bytesLeft = bytesLeft - bytes
   Loop
   
   Close #fnum
       
        rsrecordset.Update
       
        rsrecordset.Close
        adodataconn.Close

Can you show the code that you're using to update the database that you claim is not working?

Sorry, can you show the code that you're using to read from the database that you claim is not working....

Dim DataFile As Integer
Dim Fl As Long
Dim Fragment As Integer
Dim Chunks As Integer
Dim Chunk() As Byte
Dim I As Integer
Const ChunkSize As Integer = 16384


Private Sub ReadFromDB_Click()
    Dim rsrecordset As ADODB.Recordset
    Set adodataconn = New ADODB.Connection
    adodataconn.CursorLocation = adUseClient
    adodataconn.Open "Driver={Mysql};Server=SERVER;Port=3306;Option=132072;Stmt=;Database=DB", "test", "testPW"
    Set rsrecordset = New ADODB.Recordset
    rsrecordset.CursorType = adOpenKeyset
    rsrecordset.CursorLocation = adUseServer
    rsrecordset.LockType = adLockOptimistic
    rsrecordset.Source = "Select * From tblInfo"
    rsrecordset.ActiveConnection = adodataconn
    rsrecordset.Open

   
   DataFile = FreeFile
   Open "c:\pictemp" For Binary Access Write As DataFile
   
   Fl = rsrecordset("pic").ActualSize
   Chunks = Fl \ ChunkSize
   Fragment = Fl Mod ChunkSize

   ReDim Chunk(Fragment)
   Chunk() = rsrecordset("pic").GetChunk(Fragment)
   Put DataFile, , Chunk()
   
   For I = 1 To Chunks
       ReDim Buffer(ChunkSize)
       Chunk() = rsrecordset("pic").GetChunk(ChunkSize)
       Put DataFile, , Chunk()
   Next I
   
   Close DataFile
   
    rsrecordset.Close
    adodataconn.Close
End Sub

thanks, i'll check in to it.

i get a mutiple step error when i try your sample code with the stream...

Which instruction did it generate the error?  Was it the stream open statement?  In MySQL are there different types of blob data types?  You mentioned medium blob, is there a plain blob or large blob data type.  It's possible that the adodb driver is just not able to do this with that data type....

In Oracle, this code works fine on the blob data type, and in SQL Server it works with the Image data type.

What was the result of using the modified chunk code?  If it failed, did it fail on the first GetChunk, or somewhere down the road from that?

Hi AndySulz,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept mdougan's comment(s) as an answer.

AndySulz, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer

per recommendation

SpideyMod
Community Support Moderator @Experts Exchange