
Wrapper around OLE objects?
Sorry rather terse as time is short, but this is what you want.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Const CON_CHUNK_SIZE as Long = 32768
Private Const OBJECT_SIGNATURE = &H1C15
Private Const OBJECT_HEADER_SIZE = 20
Private Const CHECKSUM_SIGNATURE = &HFE05AD00
Private Const CHECKSUM_STRING_SIZE = 4
Private Type PT
Width As Integer
Height As Integer
End Type
' OBJECTHEADER : Contains relevant information about object.
'
Private Type OBJECTHEADER
Signature As Integer ' Type signature (0x1c15).
HeaderSize As Integer ' Size of header (sizeof(struct
' OBJECTHEADER) + cchName +
' cchClass).
ObjectType As Long ' OLE Object type code (OT_STATIC,
' OT_LINKED, OT_EMBEDDED).
NameLen As Integer ' Count of characters in object
' name (CchSz(szName) + 1).
ClassLen As Integer ' Count of characters in class
' name (CchSz(szClass) + 1).
NameOffset As Integer ' Offset of object name in
' structure (sizeof(OBJECTHEADER)).
ClassOffset As Integer ' Offset of class name in
' structure (ibName + cchName).
ObjectSize As PT ' Original size of object (see
' code below for value).
OleInfo(256) As Byte
End Type
Public Function ExtractOleDoc(rsObjStore As DAO.Recordset, strOsField As
String) as Boolean
'
' Parameters
' rsObjStore Recordset position at desired record
' strOsField Name of the field containing the OLE/Memo Object
On Error GoTo ExtractOleDoc_Err1
Dim bytArr(1 To CON_CHUNK_SIZE) As Byte ' Output byte array buffer
Dim strBuf As String ' Chunk buffer as getChunk
only works with UniCode strings
Dim lngPtr As Long ' File pointer
Dim lngFieldSize As Long ' Number of bytes in field
Dim lngLength As Long ' Buffer length
Dim objHeader As OBJECTHEADER
'
' Chunk buffer
strBuf = String$(CON_CHUNK_SIZE, Chr$(0))
'
With rsObjStore(strOsField)
lngFieldSize = .FieldSize
'
strBuf = .GetChunk(0, OBJECT_HEADER_SIZE + 512) ' Read enough to
get the header
'
' Convert to Unicode so that VBA can convert it back again for the
CopyMemory call
' !!
strBuf = StrConv(strBuf, vbUnicode)
CopyMemory objHeader, ByVal strBuf, OBJECT_HEADER_SIZE
lngPtr = objHeader.HeaderSize + 24 + objHeader.ClassLen
Do
strBuf = .GetChunk(lngPtr, CON_CHUNK_SIZE)
'
lngLength = LenB(strBuf)
If lngLength Then
'
For lngByte = 1 To lngLength
bytArr(lngByte) = AscB(MidB(strBuf, lngByte, 1))
Next lngByte
... and so on.
<--
Roger
Quote:
>I have ole objects in an Access database that I've put in using bound
object
>frames. When I dump these blobs (ie, look at the bytes in the field),
>there's clearly a wrapper around the original source file.
>How do I remove this wrapper? I want to get to the original file and save
>it somewhere on the file system.
>--Andres.