如何将OLE对象从TJvRichEdit复制到没有OLE服务器的TOleContainer

Question

任务

我有数千个带有嵌入式OLE对象的RTF文档。需要提取OLE对象并以TOleContainer.SaveToFile()格式保存。

当前解决方案

将每个RTF文件加载到TJvRichEdit控件中并循环浏览其OLE对象。可以将这些对象加载到TOleContainer中，然后保存到磁盘。

问题

如果我的计算机上没有安装特定的OLE服务器，则代码TOleContainer.CreateObjectFromInfo()将失败并显示错误“无效的FORMATETC结构”。

是否有另一种方法可以将OLE对象从TJvRichEdit控件复制到不需要安装OLE服务器的TOleContainer？

代码

uses ActiveX, JvRichEdit, RichEdit, ComObj; 
---- 
{ used to iterate through OLE objects } 
type 
  _ReObject = record 
    cbStruct: DWORD; 
    cp: ULONG; 
    clsid: TCLSID; 
    poleobj: IOleObject; 
    pstg: IStorage; 
    polesite: IOleClientSite; 
    sizel: TSize; 
    dvAspect: Longint; 
    dwFlags: DWORD; 
    dwUser: DWORD; 
  end; 
  TReObject = _ReObject; 

  IRichEditOle = interface(IUnknown) 
    ['{00020d00-0000-0000-c000-000000000046}'] 
    function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall; 
    function GetObjectCount: HResult; stdcall; 
    function GetLinkCount: HResult; stdcall; 
    function GetObject(iob: Longint; out reobject: TReObject; 
        dwFlags: DWORD): HResult; stdcall; 
    function InsertObject(var reobject: TReObject): HResult; stdcall; 
    function ConvertObject(iob: Longint; rclsidNew: TIID; 
        lpstrUserTypeNew: LPCSTR): HResult; stdcall; 
    function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall; 
    function SetHostNames(lpstrContainerApp: LPCSTR; 
        lpstrContainerObj: LPCSTR): HResult; stdcall; 
    function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall; 
    function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall; 
    function HandsOffStorage(iob: Longint): HResult; stdcall; 
    function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall; 
    function InPlaceDeactivate: HResult; stdcall; 
    function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; 
    function GetClipboardData(var chrg: TCharRange; reco: DWORD; 
        out dataobj: IDataObject): HResult; stdcall; 
    function ImportDataObject(dataobj: IDataObject; cf: TClipFormat; 
        hMetaPict: HGLOBAL): HResult; stdcall; 
  end; 

{ Note: 'ole' is a TOleContainer and 're' is a TJvRichEdit }

procedure TForm1.Button1Click(Sender: TObject); 
var 
  reOle: IRichEditOle; 
  reObj: TReObject; 
  oData: IDataObject; 
  oInfo: TCreateInfo; 
  i, cnt: Integer; 
begin 
  if dlgOpen.Execute then 
  begin 
    re.Clear;
    re.Lines.LoadFromFile(dlgOpen.FileName); 

    if SendMessage(re.Handle, EM_GETOLEINTERFACE, 0, Longint(@reOle)) <> 0 then 
      try 
        if not Assigned(reOle) then 
          raise Exception.Create('Failed to retrieve IRichEditOle'); 

        cnt := reOle.GetObjectCount; 

        // cycle through objects 
        for i := 0 to cnt - 1 do 
        begin
          // initialize 'reObj' structure
          FillChar(reObj, SizeOf(reObj), 0); 
          reObj.cbStruct := SizeOf(reObj); 

          // get OLE object
          OleCheck(reOle.GetObject(i, reObj, 7)); 
          try 
            // get the OLE object's data
            reObj.poleobj.QueryInterface(IDataObject, oData); 
            if Assigned(oData) then 
              try 
                // needed for some OLE servers (like MSPaint)
                OleRun(oData); 

                // initialize TCreateInfo object
                oInfo.CreateType := ctFromData; 
                oInfo.ShowAsIcon := False; 
                oInfo.IconMetaPict := 0; 
                oInfo.DataObject := oData; 
                try 
                  ole.DestroyObject;
                  ole.CreateObjectFromInfo(oInfo); // <- this is where it fails
                  ole.SaveToFile([a filename]);
                finally 
                  oInfo.DataObject := nil; 
                end; 
              finally 
                oData := nil; 
              end; 
          finally 
            reObj.poleobj := nil; 
          end; 
        end; 
      finally 
        reOle := nil; 
      end; 
  end; 
end;

Answer 1

OLE要求OLE server出现;没有办法避免它。

OLE使用ActiveX自动化来嵌入已激活的服务器，并且为了使用它，服务器必须首先在那里。您无法自动执行未安装的操作。