سؤال

Task

I have thousands of RTF documents with embedded OLE objects. The OLE objects need to be extracted and saved in the TOleContainer.SaveToFile() format.

Current Solution

Load each RTF file into a TJvRichEdit control and cycle through its OLE objects. These objects can be loaded into a TOleContainer and then saved to disk.

Problem

If my computer doesn't have a particular OLE server installed on it, the code TOleContainer.CreateObjectFromInfo() fails with the error "Invalid FORMATETC structure".

Is there another way to copy the OLE object from the TJvRichEdit control to a TOleContainer that does not require the OLE server to be installed?

Code

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;
هل كانت مفيدة؟

المحلول

OLE requires the OLE server to be present; there's no way to avoid it.

OLE uses ActiveX automation with embedding of the activated server, and to work with it the server has to be there in the first place. You can't automate something that isn't installed.

مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top