Вставка картинки в таблицу Access через OLE (VB6)

Формулировка задачи:

Есть таблица в Access 2003 с полем объекта OLE, в котором хранятся картинки jpg. И есть форма с OLE куда картинка загружается из базы. Я не могу понять как сделать связь в обратную сторону, чтобы через форму в таблицу загружать картинку, при добавлении новой записи или изменении существующей. Заранее благодарен за помощь. P.S. мои знания vb равны 6 часам, так что сильно не бейте.

Решение задачи: «Вставка картинки в таблицу Access через OLE (VB6)»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (lpString1 As Any, lpString2 As Any, ByVal iMaxLength As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (hGlobal As Any, ByVal fDeleteOnResume As Long, ppstr As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, riid As Any, lplpObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, pclsid As Any) As Long
 
Private Const IID_IPicture As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
 
Private Const OBJECT_SIGNATURE = &H1C15
Private Const OBJECT_HEADER_SIZE = 20
 
Private Type PT
    Width               As Integer
    Height              As Integer
End Type
Private Type OBJECTHEADER
   Signature            As Integer         '0x1c15
   HeaderSize           As Integer
   ObjectType           As Long
   NameLen              As Integer
   ClassLen             As Integer
   NameOffset           As Integer
   ClassOffset          As Integer
   ObjectSize           As PT
End Type
Private Type OLEHEADER
   OleVersion           As Long
   Format               As Long
   OleTypeNameLength    As Long
End Type
 
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim z()         As Byte
    Dim f           As Field
    Dim p           As Long
    Dim guid(15)    As Byte
    Dim pic         As IPicture
    Dim stm     As IUnknown
    Dim dat()   As Byte
 
    If pRecordset.EOF Or pRecordset.BOF Then Exit Sub
    
    Set f = pRecordset.Fields(3)
    
    CLSIDFromString StrPtr(IID_IPicture), guid(0)
 
    
    If f.ActualSize > OBJECT_HEADER_SIZE Then
        Dim hdr     As OBJECTHEADER
        Dim Name    As String
        Dim Class   As String
    
        z = f.Value
        
        Open "D:\Temp\Temp.dat" For Binary As 1
        Put 1, , z
        Close 1
    
        memcpy hdr, z(0), OBJECT_HEADER_SIZE
        
        If hdr.Signature <> OBJECT_SIGNATURE Then
            ' Сырые данные
            
            If CreateStreamOnHGlobal(z(0), False, stm) = 0 Then
                OleLoadPicture stm, UBound(z) + 1, False, guid(0), pic
                Set picPictureBox = pic
                Set stm = Nothing
            End If
        Else
            ' OLE обертка
            Name = Space(hdr.NameLen - 1)
            lstrcpyn ByVal Name, z(hdr.NameOffset), hdr.NameLen
            Class = Space(hdr.ClassLen - 1)
            lstrcpyn ByVal Class, z(hdr.ClassOffset), hdr.ClassLen
            
            Dim olehdr  As OLEHEADER
            Dim typName As String
            Dim size(2) As Long
            
            memcpy olehdr, z(hdr.HeaderSize), Len(olehdr)
            p = hdr.HeaderSize + 12
            typName = Space(olehdr.OleTypeNameLength - 1)
            lstrcpyn ByVal typName, z(p), olehdr.OleTypeNameLength
            p = p + olehdr.OleTypeNameLength
            
            Select Case typName
            Case "PBrush"
                memcpy size(0), z(p), 12
                ReDim dat(size(2) - 1)
                memcpy dat(0), z(p + 12), size(2)
            Case "Package"
                Dim l       As Long
                Dim fName   As String
                Dim fPath   As String
                Dim Path    As String
                ' Получаем имя файла
                p = p + 14
                l = lstrlen(z(p))
                fName = Space(l)
                lstrcpyn ByVal fName, z(p), l + 1
                ' Получаем полный путь
                p = p + l + 1
                l = lstrlen(z(p))
                fPath = Space(l)
                lstrcpyn ByVal fPath, z(p), l + 1
                p = p + l + 5
                GetMem4 z(p), l
                Path = Space(l - 1)
                p = p + 4
                lstrcpyn ByVal Path, z(p), l
                p = p + l
                GetMem4 z(p), l
                ReDim dat(l - 1)
                memcpy dat(0), z(p + 4), l
            End Select
            
            If CreateStreamOnHGlobal(dat(0), False, stm) = 0 Then
                OleLoadPicture stm, size(2), False, guid(0), pic
                Set stm = Nothing
            End If
            
            Set picPictureBox = pic
        End If
    End If
End Sub
                        