pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Fix writing of OLE structure ignored by sfExcel5 and sfExcel8 in "WriteToStream" (issue #0028573)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4299 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-27 10:30:38 +00:00
parent 2941a83e64
commit 05237dd7a2
4 changed files with 191 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
components/fpspreadsheet/fpolebasic.pas
View File

@ -33,14 +33,18 @@ type
TOLEStorage = class
private
public
procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: UTF8String='Book');
procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
procedure ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: String='Book');
procedure WriteOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: String='Book');
procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: String='Book');
procedure ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: String='Book');
procedure FreeOLEDocumentData(AOLEDocument: TOLEDocument);
end;
implementation
uses
fpsStrings;
{@@
Writes the OLE document specified in AOLEDocument
to the file with name AFileName. The routine will fail
@ -49,7 +53,28 @@ implementation
}
procedure TOLEStorage.WriteOLEFile(AFileName: string;
AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean;
const AStreamName: UTF8String);
const AStreamName: String = 'Book');
var
RealFile: TFileStream;
begin
if FileExists(AFileName) then
begin
if AOverwriteExisting then
DeleteFile(AFileName)
// In Ubunto it seems that fmCreate does not erase an existing file.
// Therefore, we delete it manually
else
raise EStreamError.CreateFmt(rsFileAlreadyExists, [AFileName]);
end;
RealFile := TFileStream.Create(AFileName, fmCreate);
try
WriteOLEStream(RealFile, AOLEDocument, AStreamName);
finally
RealFile.Free;
end;
end;
(*
var
RealFile: TFileStream;
fsOLE: TVirtualLayer_OLE;
@ -81,16 +106,43 @@ begin
fsOLE.Free;
RealFile.Free;
end;
*)
procedure TOLEStorage.WriteOLEStream(AStream: TStream; AOLEDocument: TOLEDocument;
const AStreamName: String = 'Book');
var
fsOLE: TVirtualLayer_OLE;
VLAbsolutePath: String;
OLEStream: TStream;
tmpStream: TStream; // workaround to compiler bug, see bug 22370
begin
VLAbsolutePath := '/' + AStreamName; // Virtual layer always uses absolute paths
fsOLE := TVirtualLayer_OLE.Create(AStream);
try
fsOLE.Format; // Initialize and format the OLE container;
OLEStream := fsOLE.CreateStream(VLAbsolutePath, fmCreate);
try
// woraround for bug 22370
tmpStream := AOLEDocument.Stream;
tmpStream.Position := 0; // Ensures that stream is at the beginning
// previous code: AOLEDocument.Stream.Position := 0;
OLEStream.CopyFrom(AOLEDocument.Stream, AOLEDocument.Stream.Size);
finally
OLEStream.Free;
end;
finally
fsOLE.Free;
end;
end;
{@@
Reads an OLE file.
}
procedure TOLEStorage.ReadOLEFile(AFileName: string;
AOLEDocument: TOLEDocument; const AStreamName: UTF8String);
AOLEDocument: TOLEDocument; const AStreamName: String = 'Book');
var
RealFile: TFileStream;
begin
RealFile:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
RealFile := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
ReadOLEStream(RealFile, AOLEDocument, AStreamName);
finally
@ -100,13 +152,13 @@ end;
procedure TOLEStorage.ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument;
const AStreamName: UTF8String = 'Book');
const AStreamName: String = 'Book');
var
fsOLE: TVirtualLayer_OLE;
OLEStream: TStream;
VLAbsolutePath: UTF8String;
begin
VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths.
VLAbsolutePath := '/' + AStreamName; //Virtual layer always use absolute paths.
fsOLE := TVirtualLayer_OLE.Create(AStream);
try
fsOLE.Initialize(); //Initialize the OLE container.