Private Function LoadFileToArray(ByVal sFileName As String) As Byte()
'Функция загрузки (двоичного) файла в байтовый массив
 Dim nFile As Integer
 nFile = FreeFile()
 FileLen sFileName
 Open sFileName For Binary Access Read Lock Write As #nFile
 ReDim LoadFileToArray(0 To LOF(nFile) - 1) As Byte
 Get #nFile, , LoadFileToArray
 Close #nFile
End Function

Public Function LoadPictureFromByteArray(bPicData() As Byte) As IPictureDisp
 Dim lResult As Long
 Dim oStream As IUnknown
 Dim IID_IPictureDisp As GUID
 lResult = CreateStreamOnHGlobal(bPicData(LBound(bPicData)), FALSE_BOOL, _
                                 oStream)
 If lResult < S_OK Then Exit Function
 With IID_IPictureDisp
    .data1 = &H7BF80981
    .data2 = &HBF32
    .data3 = &H101A
    .data4(0) = &H8B
    .data4(1) = &HBB
   ' .Data4(2) = &H0 '
    .data4(3) = &HAA
    '.Data4(4) = &H0 '
    .data4(5) = &H30
    .data4(6) = &HC
    .data4(7) = &HAB
 End With
 lResult = OleLoadPicture(oStream, UBound(bPicData) - LBound(bPicData) + 1, _
                          TRUE_BOOL, IID_IPictureDisp, LoadPictureFromByteArray)
End Function

Private Function FindJPEGSignature(bBuffer() As Byte) As Long
Dim i As Long
For i = 1 To UBound(bBuffer) - 3
 If bBuffer(i) = &HFF Then
    If bBuffer(i + 1) = &HD8 Then
       If bBuffer(i + 2) = &HFF Then
          If bBuffer(i + 3) = &HE0 Then
             FindJPEGSignature = i
             Exit Function
          End If
       End If
    End If
 End If
Next i
If i = 0 Then FindJPEGSignature = -1
If i = UBound(bBuffer) - 2 Then FindJPEGSignature = -1
End Function

bFile = LoadFileToArray(rs!d3d)
 Dim cbSignOfs As Long
 cbSignOfs = FindJPEGSignature(bFile)
 If cbSignOfs < 0 Then Exit Function
 If cbSignOfs > 0 Then
    CopyMemory bFile(0), bFile(cbSignOfs), UBound(bFile) + 1 - cbSignOfs
 End If
 Set sbor.Image1.Picture = LoadPictureFromByteArray(bFile)

Set sbor.Image1.Picture = LoadPictureFromByteArray(bFile)