ذخیره عکس در

خوب دوستان یه سوال داشتم من یه بانک اطلاعاتی از نوع اکسس دارم .

تو وی بی برای ثبت نام فیلد های مختلفی هست از جمله نام و.......

من میخواستم هنگام پر کردن فیلد ها عکس طرف هم ذخیره کنم مشکلم الان ذخیره کردن عکس تو اکسس هست
و میخوام در قسمت سرچ وقتی زد علی (اگر در پایگاه داده ) بود عکسشم بیاره واگر زد محسن همانند علی عکس محسن رو بیاره
ممنون میشم کمک کنید تا یه جاهایی رفتم مثل اینکه picturebox به پایگاه ربط بدم و فیلد هم از نوع ole گرفتم

اگر ممکن هست این یه تکه کد رو بنویسید

این ها به درد می خورن؟

نقل قول:

---

'Saves the image Filename (any kind Pict

' urebox supports: jpg, gif, ico, bmp, wmf

' ..) in to
'the current record of the recordset rsI

' mg, using the field FieldName (must be a

' memo field!!!)
'USE: SaveImage("c:\sample.gif", rs)

Public Sub SaveImage(Filename As String, rsImg As Recordset, Optional FieldName As String = "Image")

On Error Goto EH
Dim fh As Integer
Dim strFile As String
If rsImg.BOF Or rsImg.EOF Then Err.Raise vbObjectError + 1, "SaveImage", "EOF or BOF encountered"
fh = FreeFile
Open Filename For Binary Access Read As fh
strFile = String(LOF(fh), " ")
Get fh, , strFile
Close fh
rsImg(FieldName) = strFile
Exit Sub
EH:
End Sub

'Reads the image (any kind Picturebox su

' pports: jpg, gif, ico, bmp, wmf..) from

'
'the current record of the recordset rsI

' mg, using the field FieldName, and retur

' ns it.
'USE: picture1.picture=ReadImage(rsImg)

Public Function ReadImage(rsImg As Recordset, Optional FieldName As String = "Image") As IPictureDisp

On Error Goto EH
Dim strFile As String
Dim fh As Integer
If rsImg.BOF Or rsImg.EOF Then Err.Raise vbObjectError + 2, "EeadImage", "EOF or BOF encountered"
ChDir App.Path
strFile = rsImg(FieldName)
fh = FreeFile
Open GetTempDir & "tmpimage.temp" For Binary Access Write As fh
Put #fh, , strFile
Close fh
Set LeerImagen = LoadPicture(GetTempDir & "tmpimage.temp")
Kill GetTempDir & "tmpimage.temp"
Exit Function
EH:
End Function


Private Function GetTempDir() As String

GetTempDir = String(255, " ")
GetTempPath 255, GetTempDir
GetTempDir = Left(Trim(GetTempDir), Len(Trim(GetTempDir)) - 1)
End Function

---

کد:

---

***************************************

' ************************
' Abstract: Writes a BLOB datafield to a

' file. If the Data Field is
'big I would recommend that you set bUse

' Stream = False.
'
' Input: strFullPath: Full path to the d

' estination file
'objField: Field object that contains th

' e BLOB data.
'bUseStream: (Optional) True = Use Strea

' m methode, False = Use GetChunk
'lngChunkSize: (Optional) Specifies the

' Chunk size to fetch with each GetChunk
'
' Output: True on success, False on fail

' ure
'***************************************

' ************************

Public Function BLOBToFile(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean

    On Error Resume Next
    Dim objStream As ADODB.Stream
    Dim intFreeFile As Integer
    Dim lngBytesLeft As Long
    Dim lngReadBytes As Long
    Dim byBuffer() As Byte

    If bUseStream Then
        Set objStream = New ADODB.Stream

        With objStream
            .Type = adTypeBinary
            .Open
            .Write objField.Value
            .SaveToFile strFullPath, adSaveCreateOverWrite
        End With


        DoEvents
        Else

            If Dir(strFullPath) <> "" Then
                Kill strFullPath
            End If

            lngBytesLeft = objField.ActualSize
            intFreeFile = FreeFile
            Open strFullPath For Binary As #intFreeFile

            Do Until lngBytesLeft <= 0
                lngReadBytes = lngBytesLeft

                If lngReadBytes > lngChunkSize Then
                    lngReadBytes = lngChunkSize
                End If

                byBuffer = objField.GetChunk(lngReadBytes)
                Put #intFreeFile, , byBuffer
                lngBytesLeft = lngBytesLeft - lngReadBytes

                DoEvents
                Loop

                Close #intFreeFile
            End If


            If Err.Number <> 0 Or Err.LastDllError <> 0 Then
                BLOBToFile = False
            Else
                BLOBToFile = True
            End If

        End Function

        '***************************************

        ' ************************
        ' Abstract: Writes a binary file to a BL

        ' OB datafield. If the file
        'is big I would recommend that you set b

        ' UseStream = False.
        '
        ' Input: strFullPath: Full path to the s

        ' ource file
        'objField: Field object that will contai

        ' n the BLOB data.
        'bUseStream: (Optional) True = Use Strea

        ' m methode, False = Use GetChunk
        'lngChunkSize: (Optional) Specifies the

        ' Chunk size to fetch with each GetChunk
        '
        ' Output: True on success, False on fail

        ' ure
        '***************************************

        ' ************************

Public Function FileToBLOB(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean

    On Error Resume Next
    Dim objStream As ADODB.Stream
    Dim intFreeFile As Integer
    Dim lngBytesLeft As Long
    Dim lngReadBytes As Long
    Dim byBuffer() As Byte
    Dim varChunk As Variant

    If bUseStream Then
        Set objStream = New ADODB.Stream

        With objStream
            .Type = adTypeBinary
            .Open
            .LoadFromFile strFullPath
            objField.Value = .Read(adReadAll)
        End With

    Else

        With objField
            '<<--If the field does not support

            ' Long Binary data'-->>
            '<<--then we cannot load the data

            ' into the field.-->>

            If (.Attributes And adFldLong) <> 0 Then
                intFreeFile = FreeFile
                Open strFullPath For Binary Access Read As #intFreeFile
                lngBytesLeft = LOF(intFreeFile)

                Do Until lngBytesLeft <= 0

                    If lngBytesLeft > lngChunkSize Then
                        lngReadBytes = lngChunkSize
                    Else
                        lngReadBytes = lngBytesLeft
                    End If

                    ReDim byBuffer(lngReadBytes)
                    Get #intFreeFile, , byBuffer()
                    objField.AppendChunk byBuffer()
                    lngBytesLeft = lngBytesLeft - lngReadBytes

                    DoEvents
                    Loop

                    Close #intFreeFile
                Else
                    Err.Raise -10000, "FileToBLOB", "The Database Field does Not support Long Binary Data."
                End If

            End With

        End If

       

        If Err.Number <> 0 Or Err.LastDllError <> 0 Then
            FileToBLOB = False
        Else
            FileToBLOB = True
        End If

    End Function

---

میشه یه توضیح دربتره کد ها بدبد

خودم یه کد ساده تری نوشتم تا ساعت 2 شب بیدار موندم و نوشتم ممنون از راهنمایی

سلام سونامی عزیز
میشه کدی که خودت نوشتی را بزاری.
ممنون میشم :11: