Save/Retrieve Image From SQL Server Database Using Ado 2.5 Stream Object

Category:

Database

Type:

Snippets

Difficulty:

Intermediate

Author:

Michael P. Gerety

Version Compatibility: Visual Basic 6

More information:

*** NOTE *** You MUST Use ActiveX Data Objects 2.5 or HIGHER

I had been trying to use the AppendChunk()/GetChunk() functions with SQL Server 7.0 to no avail as when I did a select statement on my table which housed a column of type "Image", the dataType and Format were "unsupported" by VB.

Using the ADO Stream object it is much easier to get/retrieve image data from a SQL Server Database. Below is a very simplified version of my code.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'*************************************************************** '* Save/Retrieve Image Data From SQL Server DataBase Using '* ADOStream Objects. '*************************************************************** '* Code By: Michael P. Gerety '*************************************************************** Dim rstRecordset As ADODB.Recordset Dim cnnConnection As ADODB.Connection Dim strStream As ADODB.Stream

Code:

'*Setup:
'*Create a form and place 3 command buttons named:
'*cmdLoad, cmdSelectSave, and cmdClear
'*Place a CommonDialog Control Named Dialog
'*Place an ImageBox (or PictureBox) named Image1

'** The field type in Sql Server must be "Image"
'** Everywhere you see "***" in the code is where you must enter 
'** your own data.

Private Sub cmdClear_Click()
    Image1.Picture = Nothing
    
End Sub

Private Sub cmdLoad_Click()
    If Not LoadPictureFromDB(rstRecordset) Then
        MsgBox "Invalid Data Or No Picture In DB"
    End If
End Sub

Private Sub cmdSelectSave_Click()
    'Open Dialog Box
    With dlgDialog
        .DialogTitle = "Open Image File...."
        .Filter = "Image Files (*.gif; *.bmp)| *.gif;*.bmp"
        .CancelError = True
procReOpen:
         .ShowOpen
         
        If .FileName = "" Then
            MsgBox "Invalid filename or file not found.", _
                vbOKOnly + vbExclamation, "Oops!"
            GoTo procReOpen
        Else
            If Not SavePictureToDB(rstRecordset, .FileName) Then
                MsgBox "Save was unsuccessful :(", vbOKOnly + _
                        vbExclamation, "Oops!"
                Exit Sub
            End If
        End If
            
    End With
End Sub

Private Sub Form_Load()
    Set cnnConnection = New ADODB.Connection
    Set rstRecordset = New ADODB.Recordset

cnnConnection.Open ("Provider=SQLOLEDB; " & _
        "data Source=**YourServer**;" & _
        "Initial Catalog=**YourDatabase**; " & _
        "User Id=**YourUID**;Password=***YourPass***")
    rstRecordset.Open "Select * from YourTable", cnnConnection, _
         adOpenKeyset, adLockOptimistic

End Sub

Public Function LoadPictureFromDB(RS As ADODB.Recordset)

On Error GoTo procNoPicture
    
    'If Recordset is Empty, Then Exit
    If RS Is Nothing Then
        GoTo procNoPicture
    End If
    
    Set strStream = New ADODB.Stream
    strStream.Type = adTypeBinary
    strStream.Open
    
    strStream.Write RS.Fields("**YourImageField**").Value

strStream.SaveToFile "C:\Temp.bmp", adSaveCreateOverWrite
    Image1.Picture = LoadPicture("C:\Temp.bmp")
    Kill ("C:\Temp.bmp")
    LoadPictureFromDB = True

procExitFunction:
    Exit Function
procNoPicture:
    LoadPictureFromDB = False
    GoTo procExitFunction
End Function

Public Function SavePictureToDB(RS As ADODB.Recordset, _
    sFileName As String)

On Error GoTo procNoPicture
    Dim oPict As StdPicture
    
    Set oPict = LoadPicture(sFileName)
    
    'Exit Function if this is NOT a picture file
    If oPict Is Nothing Then
        MsgBox "Invalid Picture File!", vbOKOnly, "Oops!"
        SavePictureToDB = False
        GoTo procExitSub
    End If
    
    RS.AddNew

Set strStream = New ADODB.Stream
    strStream.Type = adTypeBinary
    strStream.Open
    strStream.LoadFromFile sFileName
    RS.Fields("***YourImageField***").Value = strStream.Read
    
    Image1.Picture = LoadPicture(sFileName)
    SavePictureToDB = True

procExitSub:
    Exit Function
procNoPicture:
    SavePictureToDB = False
    GoTo procExitSub
End Function