I have thousands of RTF documents with embedded OLE objects. The OLE objects need to be extracted and saved in the TOleContainer.SaveToFile() format.
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.
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?
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.