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

@@ -33,14 +33,18 @@ type
   TOLEStorage = class
   private
   public
-    procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: UTF8String='Book');
+    procedure WriteOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean = False; const AStreamName: String='Book');
-    procedure ReadOLEFile(AFileName: string; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='Book');
+    procedure WriteOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: String='Book');
-    procedure ReadOLEStream(AStream: TStream; AOLEDocument: TOLEDocument; const AStreamName: UTF8String='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.

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.';

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
 

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