delphi - 在我的应用程序中显示 Microsoft Access "OLE Object"

Question

我有一个包含 OLE 对象字段的 Access 数据库。我需要将该字段的内容提取为图像。最初放置在 OLE 字段中的类型无关紧要。我只需要一张代表该对象外观的图像。

这样做的主要目标是从 OLE 对象字段转移到存储在 blob 字段中的更标准的图像。

我找到了一些解析 blob 并尝试提取底层文件的示例代码。我真的在寻找能够按预期使用 OLE 对象的东西，而不是试图绕过它们。

stackoverflow上有两个类似的问题:
Converting an OLE Image Object from MS Access for use in .NET
Extract OLE Object (pdf) from Access DB

我打开这个问题主要是为了发布我当前的 Delphi 代码，看看是否有比我当前的代码更好的方法，如果没有，可以帮助其他人。

我使用的是 Delphi 2007，但任何语言的代码都会有所帮助。

Answer 1

以下是我正在使用的解决方案。起点来自 Ms Access Ole Fields on the about.com site .

一些注意事项:

• Access 似乎使用 OLE1 标准而不是 OLE2 来存储对象。除了上面提到的帖子外，我在任何地方都找不到对此的任何确认。
• Access 在 OLE1 字段前面附加了自己的 header 。同样，我没有找到帖子以外的任何文档。
• 我找不到直接使用 OLE1 对象的方法，我需要将它转换为 OLE2 对象。为了做到这一点，我需要 OLE1 流，它似乎没有在任何地方的 VCL 或 Win API 中实现。实现直接取自帖子，我不能说我理解它所做的一切。

一旦您有了 IOLEObject，您就可以使用 OleDraw 函数在您自己的 Canvas 上绘图。那时你有一个图像并且可以运行。如果您只想显示对象，可以使用 TOLEContainer 组件并让它处理绘图。

这是使用单位的代码。我有一个 ADO 表，其中包含一个名为 AdoTable1Photo 的 TBlobField 类型的字段对象。

procedure TForm2.ADOTable1AfterScroll(DataSet: TDataSet);
var
  Bmp: TBitmap;
  Jpg: TJpegImage;

  OleObject: IOleObject;
  DataObject: IDataObject;
  CreateInfo: TCreateInfo;
begin

  if AdoTable1Photo.BlobSize = 0 then
    exit;

  OleObject := OleFieldToObject(AdoTable1Photo);

  // If you want to save out an image file draw let the ole object draw to
  // a bitmap canvas and then save the results.  Could be used for converting
  // a field to a true image blob instead of a OLE Object type.
  Bmp := TBitmap.Create();
  Jpg := TJpegImage.Create();

  try
    DrawOleOnBmp(OleObject, Bmp);
    Jpg.Assign(Bmp);
    Jpg.SaveToFile('C:\temp\test.jpg');
  finally
    Bmp.Free;
    Jpg.Free;
  end;

  // If just trying to display the results without converting you can attach
  // the OleObject to a OleContainer component that will handle the drawing.
  // I could not find an easy way to do this directly.  I needed to use the
  // IDataObject interace with the CreateInfo record.

  if Succeeded(OleObject.QueryInterface(IDataObject, DataObject)) then
  begin
    // Load the OLE Container control by using the IDataObject
    CreateInfo.CreateType := ctFromData;
    CreateInfo.ShowAsIcon := false;
    CreateInfo.DataObject := DataObject;
    OleContainer.CreateObjectFromInfo(CreateInfo);
  end;

  OleObject := nil;
end;

这里是将字段转换为 IOleObject 的单元。困难的部分是提取流，拆分出 header 并将其转换为 OLE2 对象。完成后，我实际上只使用了两个函数:OLELoad 和 OLEDraw。

unit MSAccessOleObject;

interface
uses ActiveX, Windows, Classes, ComObj, DB, Graphics;

  // This file is a modified version of the source code posted here:
  // http://forums.about.com/ab-delphi/messages?lgnF=y&msg=1865.1

  //-----------------------------------------------------------------------------
  // Converted from Ole.h
  // 
  // Used inside from OleConvertOLESTREAMToIStorage OLE Function
  // As far I know the Access Converts the OLE2 objects in OLE1 Objects
  //
  // So for read this Kind of field we must covert the OLE1 format
  // to OLE2 format so we need the OleConvertOLESTREAMToIStorage
  // and to write an OLE object to Field we need the
  // OleConvertIStorageToOLESTREAM OLE function.
  // The code here is only for reading "Ole Object" fields, but it coudld adapted
  // to write them as well. 
  //
  // OLE.h define a OLE stream that uses a vtable and callback functions. I
  // could not find a class in the VCL that implemented the OLE v1 Stream.
  type
    POleStreamVtbl = ^TOleStreamVtbl;
    TOleStreamVtbl = record
      Get: Pointer;
      Put: Pointer;
    end;

    POle1Stream = ^TOle1Stream;
    TOle1Stream = record
      pvt: POleStreamVtbl;
      lpData: Pointer; // Link to Data in .MDB file
      dwSize: Integer; // OLE Stream length (relative to position)
    end;

    POleStream = ^TPOleStream;
    TPOleStream = record
      lpstbl: POleStreamVtbl;
    end;

  //-----------------------------------------------------------------------------
  //    Microsoft Access Field Header
  //
  //  Access adds header information in front of the actual OLE stream.
  //  We need to read it to get the size in order to find the start of
  //  the actual OLE stream.
  type
    TKind=record
      case Integer of
        0: (oot: DWord); // OLE Object type code (OT_LINK, OT_EMBEDDED, OT_STATIC)
        1: (lobjTyp: LongInt); // in our case: OT_EMBEDDED
      end;

    PAccessOleObjectHeader=^TAccessOleObjectHeader;
    TAccessOleObjectHeader = record
      typ: WORD;       // Type signature (0x1C15)
      cbHdr: WORD;     // sizeof(struct OLEOBJECTHEADER) + cchName +cchClass
      lobjType: TKind; // OLE Object Type Code (OT_STATIC, OT_LINKED,OT_EMBEDDED)
      cchName: WORD;   // Count of characters in object Name (CchSz(szName) + 1))
      cchClass: WORD;  // Count of characters in class Name  (CchSz(szClss) + 1))
      ibName: WORD;    // Offset of object name in structure  (sizeof(OLEOBJECTHEADER)
      ibClass: WORD;   // Offset of class name in structure  (ibName +cchName)
      ptSize: TSmallPoint; // Original size of Object (MM_HIMETRIC)
    end;


  function CreateOle1Stream(pStm: IStream; dwSize: Integer): POle1Stream;
  procedure DeleteOle1Stream(var Ole1Stream: POle1Stream);

  // Callback Functions for OLE1 Stream
  function Get(OleStream: POLESTREAM; Pb:Pointer; cb:Integer): Integer; stdcall;
  function Put(OleStream: POLESTREAM; const Pb:Pointer; cb:Integer): Integer; stdcall;

  function OleFieldToObject(AdoField: TBlobField): IOleObject;
  procedure DrawOleOnBmp(Ole: IOleObject; Bmp: TBitmap);

implementation

uses Sysutils;

{
  CreateOle1Stream
  ---------------------------------------------------------------------------
}
function CreateOle1Stream(pStm:IStream; dwSize:Integer): POLE1Stream;
var
  cb: Int64;
begin
  Result := new(POle1Stream);
  Result.pvt := new(POleStreamVtbl);
  Result.pvt.Get := @Get;
  Result.pvt.Put := @Put;
  Result.dwSize := dwSize;
  Result.lpData := Pointer(pStm);

  // Seek to the start of the stream
  IStream(Result.lpData).Seek(0,STREAM_SEEK_SET,cb);
end;


{
  DeleteOle1Stream
  ---------------------------------------------------------------------------
}
procedure DeleteOle1Stream(var Ole1Stream: POle1Stream); // Dispose then OLE1 Stream
begin
  if Ole1Stream = Nil then
    exit;

  Dispose(Ole1Stream^.pvt);
  Dispose(Ole1Stream);
end;

{
  Put
  ---------------------------------------------------------------------------
  Callback function for Ole1Stream
}
function Put(OleStream: POLESTREAM; const Pb:Pointer; cb:Integer): Integer; stdcall;
Var
  pStream: POle1Stream;
  ulBytesWritten: longInt;
begin
  pStream:=POle1Stream(OleStream);

  if (pStream = Nil) or (pStream^.lpData=Nil) or (pb=Nil) then
  begin
    Result:=0;
    exit;
  end;

  ulBytesWritten:=0;
  if IStream(pStream^.lpData).Write(Pb,cb,@ulBytesWritten) <> S_OK then
  begin
    Result:=0;
    exit;
  end;

  pStream^.dwSize:=pStream^.dwSize+ulBytesWritten;
  Result:=cb;
end;

{
  Get
  ---------------------------------------------------------------------------
  Callback function for Ole1Stream
}
function Get(OleStream: POLESTREAM; Pb: Pointer; cb: Integer): Integer; stdcall;
Var
  pStream: POle1Stream;
  ulBytesRead: LongInt;
begin
  pStream := POle1Stream(OleStream);
  if (pStream=Nil) or (pStream^.lpData=Nil) or (pStream^.dwSize < cb)
  then
  begin
    Result := 0;
    exit;
  end;

  ulBytesRead := 0;
  if IStream(pStream^.lpData).Read(pb, cb, @ulBytesRead) <> S_OK then
  begin
    Result := 0;
    exit;
  end;

  pStream^.dwSize := pStream^.dwSize-ulBytesRead;
  Result := cb;

end;

{
  OleFieldToObject
  ---------------------------------------------------------------------------
  Pass in the ADO field of the "OLE Object" type and get the IOleObject
  interface back.  You can then attached that object to a OleContanier and
  let it draw itself or use the DrawOleOnBmp function to get your own bitmap
  that can be used by itself.
}
function OleFieldToObject(AdoField: TBlobField): IOleObject;
var

  AccessHeader: TAccessOleObjectHeader;

  FullAdoStream: TMemoryStream;
  ObjectStream: TMemoryStream;

  StreamAdapter: TStreamAdapter;
  StreamInterface: IStream;
  Ole1Stream: POle1Stream;

  OleBytes: ILockBytes;
  OleStorage: IStorage;
  OleObject: IOleObject;

begin

  FullAdoStream := nil;
  ObjectStream := nil;
  StreamAdapter := nil;
  StreamInterface := nil;
  Ole1Stream := nil;

  try
    // We need a IStorage Interface that will be used to load the OLEObject
    OleCheck( CreateILockBytesOnHGlobal(0, true, OleBytes) );
    OleCheck( StgCreateDocfileOnILockBytes(OleBytes,
      STGM_Create or STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_DIRECT,  0, OleStorage) );


    // We need to get the data out of the field.  Microsoft Access stores a OLE1 field
    // and not the current OLE2 format.  It also adds it's own header on the object.
    // We need to - extract the stream, remove the header, wrap the stream in an
    // IStreamInterface, wrap that inside and OLE1Stream object.

    FullAdoStream := TMemoryStream.Create();
    AdoField.SaveToStream(FullAdoStream);

    FullAdoStream.Seek(0, soBeginning);
    FullAdoStream.ReadBuffer(AccessHeader, sizeof(TAccessOleObjectHeader));

    // We could check if AccessHeader.typ = $1C15 but if the format is not
    // right something will go wrong later.


    // Seek past the header and then copy the rest of the stream to a new stream.
    FullAdoStream.Seek(AccessHeader.cbHdr, soBeginning);
    ObjectStream := TMemoryStream.Create();
    ObjectStream.CopyFrom(FullAdoStream, FullAdoStream.Size - FullAdoStream.Position);

    StreamAdapter := TStreamAdapter.Create(ObjectStream, soReference);
    StreamInterface := StreamAdapter as IStream;
    Ole1Stream := CreateOle1Stream(StreamInterface, ObjectStream.Size);

    // Now convert the OLE1 stream to OLE2 (IStorage) and load the IOleObject
    // This function seems to be slow, but I can't find anything to change
    // or any other function to use. 
    OleCheck( OleConvertOLESTREAMToIStorage(Ole1Stream, OleStorage, Nil) );
    OleCheck( OleLoad(OleStorage, IOleObject, nil, OleObject) );

  finally
    DeleteOle1Stream(Ole1Stream);
    StreamInterface := nil;
    StreamAdapter := nil;
    ObjectStream.Free;
    FullAdoStream.Free;
  end;

  result := OleObject;

end;


{
  DrawOleOnBmp
  ---------------------------------------------------------------------------
  Take a OleObject and draw it to a bitmap canvas.  The bitmap will be sized
  to match the normal size of the OLE Object.
}
procedure DrawOleOnBmp(Ole: IOleObject; Bmp: TBitmap);
var
  ViewObject2: IViewObject2;
  ViewSize: TPoint;
  AdjustedSize: TPoint;

  DC: HDC;
  R: TRect;
begin

  if Succeeded(Ole.QueryInterface(IViewObject2, ViewObject2)) then
  begin
    ViewObject2.GetExtent(DVASPECT_CONTENT, -1, nil, ViewSize);

    DC := GetDC(0);
    AdjustedSize.X := MulDiv(ViewSize.X, GetDeviceCaps(DC, LOGPIXELSX), 2540);
    AdjustedSize.Y := MulDiv(ViewSize.Y, GetDeviceCaps(DC, LOGPIXELSY), 2540);
    ReleaseDC(0, DC);

    Bmp.Height := AdjustedSize.Y;
    Bmp.Width := AdjustedSize.X;

    SetRect(R, 0, 0, Bmp.Width, Bmp.Height);

    OleDraw(Ole, DVASPECT_CONTENT, Bmp.Canvas.Handle, R);
  end
  else
  begin
    raise Exception.Create('Could not get the IViewObject2 interfact on the OleObject');
  end;

end;

end.