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

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

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.

View File

@ -39,6 +39,7 @@ resourcestring
rsIncorrectParamCount = 'Funtion %s requires at least %d and at most %d parameters.';
rsCircularReference = 'Circular reference found when calculating worksheet formulas';
rsFileNotFound = 'File "%s" not found.';
rsFileAlreadyExists = 'File "%s" already exists.';
rsWorksheetNotFound = 'Worksheet "%s" not found.';
rsWorksheetNotFound1 = 'Worksheet not found.';
rsInvalidWorksheetName = '"%s" is not a valid worksheet name.';

View File

@ -96,6 +96,7 @@ type
TsSpreadBIFF5Writer = class(TsSpreadBIFFWriter)
protected
procedure InternalWriteToStream(AStream: TStream);
{ Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
@ -1077,49 +1078,13 @@ begin
FCodePage := Excel5Settings.CodePage;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF5 file to the disc
The BIFF 5 writer overrides this method because BIFF 5 is written as
an OLE document, and our current OLE document writing method involves:
1 - Writing the BIFF data to a memory stream
2 - Write the memory stream data to disk using COM functions
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
Stream: TStream;
OutputStorage: TOLEStorage;
OLEDocument: TOLEDocument;
begin
if (boBufStream in Workbook.Options) then begin
Stream := TBufStream.Create
end else
Stream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create;
try
WriteToStream(Stream);
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := Stream;
OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting);
finally
Stream.Free;
OutputStorage.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF5 record structure
Be careful as this method doesn't write the OLE part of the document,
just the BIFF records
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream);
procedure TsSpreadBIFF5Writer.InternalWriteToStream(AStream: TStream);
var
CurrentPos: Int64;
Boundsheets: array of Int64;
@ -1197,6 +1162,67 @@ begin
SetLength(Boundsheets, 0);
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF5 file to the disc
The BIFF 5 writer overrides this method because BIFF 5 is written as
an OLE document, and our current OLE document writing method involves:
1 - Writing the BIFF data to a memory stream
2 - Write the memory stream data to disk using COM functions
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
stream: TStream;
OutputStorage: TOLEStorage;
OLEDocument: TOLEDocument;
begin
if (boBufStream in Workbook.Options) then
stream := TBufStream.Create else
stream := TMemoryStream.Create;
try
InternalWriteToStream(stream);
OutputStorage := TOLEStorage.Create;
try
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := stream;
OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting);
finally
OutputStorage.Free;
end;
finally
stream.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF5 record structure to a stream containing the OLE
envelope of the document.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream);
var
OutputStorage: TOLEStorage;
OLEDocument: TOLEDocument;
stream: TStream;
begin
if (boBufStream in Workbook.Options) then
stream := TBufStream.Create else
stream := TMemoryStream.Create;
try
InternalWriteToStream(stream);
OutputStorage := TOLEStorage.Create;
try
OLEDocument.Stream := stream;
OutputStorage.WriteOLEStream(AStream, OLEDocument);
finally
OutputStorage.Free;
end;
finally
stream.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 5 BOF record

View File

@ -124,6 +124,8 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
protected
function GetPrintOptions: Word; override;
procedure InternalWriteToStream(AStream: TStream);
{ Record writing methods }
procedure WriteBOF(AStream: TStream; ADataType: Word);
function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64;
@ -1978,48 +1980,13 @@ Begin
Result := Result or $0200;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF8 file to the disc
The BIFF 8 writer overrides this method because BIFF 8 is written
as an OLE document, and our current OLE document writing method involves:
1 - Writing the BIFF data to a memory stream
2 - Write the memory stream data to disk using COM functions
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
Stream: TStream;
OutputStorage: TOLEStorage;
OLEDocument: TOLEDocument;
begin
if (boBufStream in Workbook.Options) then begin
Stream := TBufStream.Create
end else
Stream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create;
try
WriteToStream(Stream);
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := Stream;
OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting, 'Workbook');
finally
Stream.Free;
OutputStorage.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF8 record structure to a stream
Be careful as this method doesn't write the OLE part of the document,
just the BIFF records
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream);
procedure TsSpreadBIFF8Writer.InternalWriteToStream(AStream: TStream);
const
isBIFF8 = true;
var
@ -2101,6 +2068,69 @@ begin
SetLength(Boundsheets, 0);
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF8 file to the disc
The BIFF 8 writer overrides this method because BIFF 8 is written
as an OLE document, and our current OLE document writing method involves:
1 - Writing the BIFF data to a memory stream
2 - Write the memory stream data to disk using COM functions
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
Stream: TStream;
OutputStorage: TOLEStorage;
OLEDocument: TOLEDocument;
begin
if (boBufStream in Workbook.Options) then begin
Stream := TBufStream.Create
end else
Stream := TMemoryStream.Create;
try
InternalWriteToStream(Stream);
OutputStorage := TOLEStorage.Create;
try
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := Stream;
OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting, 'Workbook');
finally
OutputStorage.Free;
end;
finally
Stream.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel BIFF8 record structure to a stream containing the OLE
envelope of the document.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream);
var
OutputStorage: TOLEStorage;
OLEDocument: TOLEDocument;
stream: TStream;
begin
if (boBufStream in Workbook.Options) then
stream := TBufStream.Create else
stream := TMemoryStream.Create;
try
InternalWriteToStream(stream);
OutputStorage := TOLEStorage.Create;
try
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := stream;
OutputStorage.WriteOLEStream(AStream, OLEDocument, 'Workbook');
finally
OutputStorage.Free;
end;
finally
stream.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 8 BOF record