Siderite's Blog

and has 0 comments
Ok, so I am doing a lot of Access for a friend. And I got into a problem that I was sure had a simple solution somewhere. Apparently it does not. The documentation for the issue is either not existant or buggy and the "helping" comments usually are trying to tell you you are wrong without trying to give a workable solution or directing you to some commercial solution. So this is for the people trying to solve the following problem: You have images embedded in an Ole Object field in a table, the images are jpg or whatever format and they appear to the table editor as Package and you want to display those images in an Image control in an Access Form via VB, without binding anything. Also, I am using Access 2007.

The first thing you are going to find when googling is that putting images in the database is a bad idea. Whenever you see this, close the page. People will give you their solution, which is store the URL of the image in the database. We don't want that, for various reasons.

After googling some more, you will find there is no solution involving the Image control, but rather only Bound or Unbound Ole Object Frames. We don't want that either.

The only solution left, since the Image control does not support direct content, but only a path to an image, is to read the binary data from the field, store it in a temporary file, then display it. When looking for this you will get to a Microsoft knowledge base article, which does most of the work, but is buggy! You see, the FileData variable they use in the WriteBLOB function is defined as a string, and it should be defined as a byte array.

Also, you want to retrieve the data from the record as binary data and so you want to use CurrentDb.OpenRecordset("MyQuery") and you get a stupid error like "Run-time error '3061': Too few parameters. Expected 1.". This is because your query has a form parameter and it just fails. There are some solutions for this, but what I basically did was to read the ID of the record in a variable using normal DLookup, then write a new SQL query inline: CurrentDb.OpenRecordset("SELECT Picture FROM MyTable WHERE ID=" & id).

When you finally make it to save the binary data in a file, you notice that the file is not what you wanted, instead it is a little bigger and starts with some mambo jumbo containing the word Package again. That means that, in order to get the file we want, you need to decode the OLE package format.

And here is where I come from, with the following code:

' Declarations that should go at the beginning of your code file
' ==========================
Const BlockSize = 32768
Const UNIQUE_NAME = &H0

Private Declare Function GetTempPathA Lib "kernel32" _
   (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
    
Private Declare Function GetTempFileNameA Lib "kernel32" _
    (ByVal lpszPath As String, ByVal lpPrefixString As String, _
     ByVal wUnique As Long, ByVal lpTempFileName As String) _
     As Long
' ==========================

' Get a temporary file name
Public Function GetTempFileName() As String

   Dim sTmp    As String
   Dim sTmp2   As String

   sTmp2 = GetTempPath
   sTmp = Space(Len(sTmp2) + 256)
   Call GetTempFileNameA(sTmp2, "", UNIQUE_NAME, sTmp)
   GetTempFileName = Left$(sTmp, InStr(sTmp, Chr$(0)) - 1)

End Function

' Get a temporary file path in the temporary files folder
Private Function GetTempPath() As String
  
   Dim sTmp       As String
   Dim i          As Integer

   i = GetTempPathA(0, "")
   sTmp = Space(i)

   Call GetTempPathA(i, sTmp)
   GetTempPath = AddBackslash(Left$(sTmp, i - 1))

End Function

' Add a trailing backslash is not already there
Private Function AddBackslash(s As String) As String

   If Len(s) > 0 Then
      If Right$(s, 1) <> "\" Then
         AddBackslash = s + "\"
      Else
         AddBackslash = s
      End If
   Else
      AddBackslash = "\"
   End If

End Function

' Write binary data from a recordset into a temporary file and return the file name
Function WriteBLOBToFile(T As DAO.Recordset, sField As String)
    Dim NumBlocks As Integer, DestFile As Integer, i As Integer
    Dim FileLength As Long, LeftOver As Long
    Dim FileData() As Byte
    Dim RetVal As Variant
 
    On Error GoTo Err_WriteBLOB
 
    ' Get the size of the field.
    FileLength = T(sField).FieldSize()
    If FileLength = 0 Then
        WriteBLOBToFile = Null
        Exit Function
    End If
    
    'read Package format
    Dim pos As Integer
    pos = 70 ' Go to position 70
    Do ' read a string that ends in a 0 byte
        FileData = T(sField).GetChunk(pos, 1)
        pos = pos + 1
    Loop Until FileData(0) = 0
    Do ' read a string that ends in a 0 byte
        FileData = T(sField).GetChunk(pos, 1)
        pos = pos + 1
    Loop Until FileData(0) = 0
    pos = pos + 8 ' ignore 8 bytes
    Do ' read a string that ends in a 0 byte
        FileData = T(sField).GetChunk(pos, 1)
        pos = pos + 1
    Loop Until FileData(0) = 0
    ' Get the original file size
    FileData = T(sField).GetChunk(pos, 4)
    FileLength = CLng(FileData(3)) * 256 * 256 * 256 + _
       CLng(FileData(2)) * 256 * 256 + _
       CLng(FileData(1)) * 256 + CLng(FileData(0))
    ' Read the original file data from the current position
    pos = pos + 4
 
    ' Calculate number of blocks to write and leftover bytes.
    NumBlocks = FileLength \ BlockSize
    LeftOver = FileLength Mod BlockSize
 
    ' Get a temporary file name
    Dim Destination As String
    Destination = GetTempFileName()
    
    ' Remove any existing destination file.
    DestFile = FreeFile
    Open Destination For Output As DestFile
    Close DestFile
 
    ' Open the destination file.
    Open Destination For Binary As DestFile
 
    ' SysCmd is used to manipulate the status bar meter.
    RetVal = SysCmd(acSysCmdInitMeter, "Writing BLOB", FileLength / 1000)
 
    ' Write the leftover data to the output file.
    FileData = T(sField).GetChunk(pos, LeftOver)
    Put DestFile, , FileData
 
    ' Update the status bar meter.
    RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
 
    ' Write the remaining blocks of data to the output file.
    For i = 1 To NumBlocks
        ' Reads a chunk and writes it to output file.
        FileData = T(sField).GetChunk(pos + (i - 1) * BlockSize _
           + LeftOver, BlockSize)
        Put DestFile, , FileData
 
        RetVal = SysCmd(acSysCmdUpdateMeter, _
        ((i - 1) * BlockSize + LeftOver) / 1000)
    Next i
 
    ' Terminates function
    RetVal = SysCmd(acSysCmdRemoveMeter)
    Close DestFile
    WriteBLOBToFile = Destination
    Exit Function
 
Err_WriteBLOB:
    WriteBLOBToFile = Null
    Exit Function
 
End Function


The function is used like this:

Dim id As String
id = DLookup("ID", "MyTableQueryWithFormCriteria", "")
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Picture FROM MyTable WHERE ID=" & id)
Dim filename As String
filename = Nz(WriteBLOBToFile(rs, "Picture"), "")
imgMyImage.Picture = filename


So, MyTable is a fictional table that contains an ID field and a Picture field of type OLE Object. MyTableQueryWithFormCriteria is a query used inside the form to get the data for the current form. It contains the MyTable table and selects at least the ID field. The WriteBLOBToFile function creates a temporary file, writes the binary data in the OLE Object field in it and returns the file's filename, so that we can feed it in the Image control.

The trick in the WriteBLOBToFile function is that, at least in my case with Access 2007, the binary data in the field is stored in a "Package". After looking at it I have determined that its format is like this:
  1. A 0x40 (64) byte header
  2. A 4 byte length
  3. A 2 byte (version?) field
  4. A string (characters ended with a 0 byte)
  5. Another string
  6. 8 bytes that I cared not to decode
  7. Another string
  8. The size of the packaged file (the original) in a 4 byte UInt32
  9. The data in the original file
  10. Some other rubbish that I ignored

The function thus goes to 64+6=70, reads 2 strings, moves 8 bytes, reads another string, then reads the length of the data and saves that much from the current position.

The examples in the pages I found said nothing about this except that you need an OLE server for a specific format in order to read the field, etc, but all of them suggested to save the binary data as if it were the original file. Maybe in some cases this happends, or maybe it is related to the version of MS Access.