From 05237dd7a2e768d8a1f608b049b3913c193bb8ce Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 27 Aug 2015 10:30:38 +0000 Subject: [PATCH] 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 --- components/fpspreadsheet/fpolebasic.pas | 68 ++++++++++++++-- components/fpspreadsheet/fpsstrings.pas | 1 + components/fpspreadsheet/xlsbiff5.pas | 100 ++++++++++++++--------- components/fpspreadsheet/xlsbiff8.pas | 104 +++++++++++++++--------- 4 files changed, 191 insertions(+), 82 deletions(-) diff --git a/components/fpspreadsheet/fpolebasic.pas b/components/fpspreadsheet/fpolebasic.pas index 058442aee..026646db0 100644 --- a/components/fpspreadsheet/fpolebasic.pas +++ b/components/fpspreadsheet/fpolebasic.pas @@ -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. diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index ac3e9bffe..5745aa493 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -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.'; diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index b72d95b08..3452b08e2 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -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 diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 9ae24a15d..d9f001dd6 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -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 @@ -2096,11 +2063,74 @@ begin WriteEOF(AStream); end; - + { Cleanup } 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