gistfile1.vb

Option Explicit
'3 Methods to store photos or (OLE) Ojects into MS-Access 2003 database .
'This would also apply to Oracle, SqlServer or any database engine supports BLOB .
'More Support (http://evry1falls.freevar.com) ... Visit Me .!
'Using ADO2.8
Dim CN As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim Rs_Stream As New ADODB.Stream
Const conChunkSize = 100
Dim Ctrl, Ctrl1 As Control
Dim PicNm, StrTempPic As String
Dim Isize, nHand As Integer
Dim Chunk() As Byte
Dim lngImgSiz, lngOffset As Long
Private Sub RetrieveBlob()
'The BLOB Method
StrTempPic = App.Path & "\Temp.jpg"
      If Len(Dir(StrTempPic)) > 0 Then
         Kill StrTempPic
      End If
'Open the temporary file to save the BLOB to
      nHand = FreeFile
      Open StrTempPic For Binary As #nHand
'Read the binary data into the byte variable array
      lngImgSiz = RS("PhotoBLOB").ActualSize
      Do While lngOffset < lngImgSiz
      Chunk() = RS("PhotoBLOB").GetChunk(conChunkSize)
         Put #nHand, , Chunk()
         lngOffset = lngOffset + conChunkSize
      Loop
      Close #nHand
'After loading the image, get rid of the temporary file
      Picture1.Picture = LoadPicture(StrTempPic)
      Kill StrTempPic
End Sub
Private Sub ReadPic()
'The Binary Method
Set Rs_Stream = Nothing
StrTempPic = App.Path & "/Temp.JPG"
Rs_Stream.Type = adTypeBinary
Rs_Stream.Open
Rs_Stream.Write RS!PhotoBLOB.Value
                'Check the size of the ado stream to make sure there is data
                    If Rs_Stream.Size > 0 Then
        'Write the content of the stream object to a file
        'The file will br created if doesn't exists. Otherwise over writes the existing file
        Rs_Stream.SaveToFile StrTempPic, adSaveCreateOverWrite
        'Load the temp Picture into the Image control
        Picture1.Picture = LoadPicture(App.Path & "\Temp.JPG")
                    End If
End Sub
Private Sub Command1_Click()
With CDL1
    .Filter = ("Photo JPG (*.JPG) | *.JPG|All Files (*.*)|*.*")
    .ShowOpen
    PicNm = .FileName
End With
Picture1.Picture = LoadPicture(PicNm)
End Sub
Private Sub Command2_Click()
If (optImageType(0).Value = True) Then 'Save as file pointer
    RS.AddNew
      RS("PhotoTitle") = Trim$(TxtFnm.Text & TxtLnm.Text)
      RS("Fname") = Trim$(TxtFnm.Text)
      RS("Lname") = Trim$(TxtLnm.Text)
      RS("PhotoPath") = PicNm
    RS.Update
      MsgBox ("Updated Successfully Using File Pointer Method")
      
ElseIf (optImageType(1).Value = True) Then 'Save as Binary Info

    Rs_Stream.Type = adTypeBinary
    Rs_Stream.Open
    Rs_Stream.LoadFromFile PicNm
        If Rs_Stream.Size > 0 Then
            RS.AddNew
      RS("PhotoTitle") = Trim$(TxtFnm.Text & TxtLnm.Text)
      RS("Fname") = Trim$(TxtFnm.Text)
      RS("Lname") = Trim$(TxtLnm.Text)
      RS("PhotoBLOB") = Rs_Stream.Read
            RS.Update
      MsgBox ("Updated Successfully Using Streaming Method")
            Rs_Stream.Close
            Set Rs_Stream = Nothing
        End If
        
ElseIf (optImageType(2).Value = True) Then
        nHand = FreeFile
        If PicNm = "" Then MsgBox "Please Choose Some Pic": Exit Sub
    Open PicNm For Binary Access Read As #nHand
        Isize = LOF(nHand)
            If nHand = 0 Then
                MsgBox "Invalid Photo"
                Close #nHand
                Exit Sub
            End If
        ReDim Chunk(Isize)
    Get #nHand, , Chunk()
    RS.AddNew
    RS("PhotoTitle") = Trim$(TxtFnm.Text & TxtLnm.Text)
    RS("Fname") = Trim$(TxtFnm.Text)
    RS("Lname") = Trim$(TxtLnm.Text)
    RS("PhotoBlob").AppendChunk (Chunk())
    RS("Method") = optImageType(2).Index
    RS.Update
    MsgBox ("Stored Using BLOB Method")
Else
    MsgBox ("Please choose a method")
    Exit Sub
End If
End Sub
Private Sub Command3_Click()
On Error Resume Next
RS.MoveFirst
    TxtFnm.Text = RS("Fname")
    TxtLnm.Text = RS("Lname")
        If RS("Fname").Value = "Mohamed" Then
            optImageType(1).Value = True
            ReadPic
        ElseIf RS("Method") = 2 Then
            optImageType(2).Value = True
            RetrieveBlob
        Else
            optImageType(0).Value = True
            Picture1.Picture = LoadPicture(RS("PhotoPath"))
        End If
End Sub
Private Sub Command4_Click()
On Error Resume Next
If RS.EOF Then
    MsgBox ("Last Record Reached")
    Exit Sub
End If
        RS.MoveNext
    TxtFnm.Text = RS("Fname")
    TxtLnm.Text = RS("Lname")
        If RS("Fname").Value = "Mohamed" Then
            optImageType(1).Value = True
            ReadPic
        ElseIf RS("Method") = 2 Then
            optImageType(2).Value = True
            RetrieveBlob
        Else
            optImageType(0).Value = True
            Picture1.Picture = LoadPicture(RS("PhotoPath"))
        End If
End Sub
Private Sub Command5_Click()
'On Error Resume Next
If RS.BOF Then
    MsgBox ("First Record Reached")
    Exit Sub
End If
        RS.MovePrevious
    TxtFnm.Text = RS("Fname")
    TxtLnm.Text = RS("Lname")
        If RS("Fname").Value = "Mohamed" Then
            optImageType(1).Value = True
            ReadPic
        ElseIf RS("Method") = 2 Then
            optImageType(2).Value = True
            RetrieveBlob
        Else
            optImageType(0).Value = True
            Picture1.Picture = LoadPicture(RS("PhotoPath"))
        End If
                End Sub
Private Sub Command6_Click()
On Error Resume Next
        RS.MoveLast
    TxtFnm.Text = RS("Fname")
    TxtLnm.Text = RS("Lname")
        If RS("Fname").Value = "Mohamed" Then
            optImageType(1).Value = True
            ReadPic
        ElseIf RS("Method") = 2 Then
            optImageType(2).Value = True
            RetrieveBlob
        Else
            optImageType(0).Value = True
            Picture1.Picture = LoadPicture(RS("PhotoPath"))
        End If
End Sub
Private Sub Command7_Click()
For Each Ctrl In Me.Controls
    If TypeOf Ctrl Is TextBox Then
        For Each Ctrl1 In Me.Controls
            If TypeOf Ctrl1 Is Image Then
            Ctrl1.Picture = LoadPicture("")
        Ctrl.Text = Trim("")
            End If
        Next
    End If
Next
End Sub
Private Sub Command8_Click()
RS.Close
CN.Close
Set RS = Nothing
Set CN = Nothing
Set Rs_Stream = Nothing
End
End Sub
Private Sub Form_Load()
'Open DataBase MyBase.mdb from wahtever Application Directory
If CN.State = 1 Then CN.Close
CN.Open ("Provider = Microsoft.Jet.OleDB.4.0 ; Data Source = " & App.Path & "/MyBase.MDB")
'Open Table MyInfo
If RS.State = 1 Then RS.Close
RS.CursorLocation = adUseClient
RS.Open ("Select * from MyInfo"), CN, adOpenDynamic, adLockOptimistic
End Sub