fpspreadsheet: Add test case for reading biff 5/8 from stream

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4300 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpolebasic.pas

@@ -45,12 +45,12 @@ implementation
 uses
   fpsStrings;
 
-{@@
+{@@ ----------------------------------------------------------------------------
   Writes the OLE document specified in AOLEDocument
   to the file with name AFileName. The routine will fail
   if the file already exists, or if the directory where
   it should be placed doesn't exist.
-}
+-------------------------------------------------------------------------------}
 procedure TOLEStorage.WriteOLEFile(AFileName: string;
   AOLEDocument: TOLEDocument; const AOverwriteExisting: Boolean;
   const AStreamName: String = 'Book');
@@ -61,7 +61,7 @@ begin
   begin
     if AOverwriteExisting then
       DeleteFile(AFileName)
-      // In Ubunto it seems that fmCreate does not erase an existing file.
+      // In Ubuntu it seems that fmCreate does not erase an existing file.
       // Therefore, we delete it manually
     else
       raise EStreamError.CreateFmt(rsFileAlreadyExists, [AFileName]);
@@ -74,39 +74,7 @@ begin
     RealFile.Free;
   end;
 end;
-(*
-var
-  RealFile: TFileStream;
-  fsOLE: TVirtualLayer_OLE;
-  OLEStream: TStream;
-  VLAbsolutePath: UTF8String;
-  tmpStream: TStream; // workaround to a compiler bug, see bug 22370
-begin
-  VLAbsolutePath:='/'+AStreamName; //Virtual layer always use absolute paths.
-  if FileExists(AFileName) then begin
-    if AOverwriteExisting then
-      DeleteFile(AFileName)
-      // In Ubuntu is seems that fmCreate does not erase an existing file.
-      // Therefore we delete it manually.
-    else
-      Raise EStreamError.Createfmt('File "%s" already exists.',[AFileName]);
-  end;
-  RealFile:=TFileStream.Create(AFileName,fmCreate);
-  fsOLE:=TVirtualLayer_OLE.Create(RealFile);
-  fsOLE.Format(); //Initialize and format the OLE container.
-  OLEStream:=fsOLE.CreateStream(VLAbsolutePath,fmCreate);
 
-  // work around code for the bug 22370
-  tmpStream:=AOLEDocument.Stream;
-  tmpStream.Position:=0; //Ensures it is in the begining.
-  //previous code: AOLEDocument.Stream.Position:=0; //Ensures it is in the begining.
-
-  OLEStream.CopyFrom(AOLEDocument.Stream,AOLEDocument.Stream.Size);
-  OLEStream.Free;
-  fsOLE.Free;
-  RealFile.Free;
-end;
- *)
 procedure TOLEStorage.WriteOLEStream(AStream: TStream; AOLEDocument: TOLEDocument;
   const AStreamName: String = 'Book');
 var
@@ -125,7 +93,7 @@ begin
       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);
+      OLEStream.CopyFrom(tmpStream, tmpStream.Size);
     finally
       OLEStream.Free;
     end;
@@ -134,9 +102,9 @@ begin
   end;
 end;
 
-{@@
+{@@ ----------------------------------------------------------------------------
   Reads an OLE file.
-}
+-------------------------------------------------------------------------------}
 procedure TOLEStorage.ReadOLEFile(AFileName: string;
   AOLEDocument: TOLEDocument; const AStreamName: String = 'Book');
 var
@@ -164,33 +132,9 @@ begin
     fsOLE.Initialize(); //Initialize the OLE container.
     OLEStream := fsOLE.CreateStream(VLAbsolutePath, fmOpenRead);
     try
-
-             {
-    RealFile:=nil;
-    RealFile:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
-    try
-      fsOLE:=nil;
-      fsOLE:=TVirtualLayer_OLE.Create(RealFile);
-      fsOLE.Initialize(); //Initialize the OLE container.
-      try
-        OLEStream:=nil;
-        OLEStream:=fsOLE.CreateStream(VLAbsolutePath,fmOpenRead);
-        if Assigned(OLEStream) then begin
-          if not Assigned(AOLEDocument.Stream) then begin
-            AOLEDocument.Stream:=TMemoryStream.Create;
-          end else begin
-            (AOLEDocument.Stream as TMemoryStream).Clear;
-          end;
-          AOLEDocument.Stream.CopyFrom(OLEStream,OLEStream.Size);
-        end;
-      finally
-        OLEStream.Free;
-      end;
-      }
       if Assigned(OLEStream) then begin
-        if not AssigneD(AOLEDocument.Stream) then
+        if not Assigned(AOLEDocument.Stream) then
-          AOLEDocument.Stream := TMemoryStream.Create
+          AOLEDocument.Stream := TMemoryStream.Create else
-        else
           (AOLEDocument.Stream as TMemoryStream).Clear;
         AOLEDocument.Stream.CopyFrom(OLEStream, OLEStream.Size);
       end;
@@ -200,16 +144,11 @@ begin
   finally
     fsOLE.Free;
   end;
-  {
-  finally
-    RealFile.Free;
-  end;
-  }
 end;
 
-{@@
+{@@ ----------------------------------------------------------------------------
   Frees all internal objects storable in a TOLEDocument structure
-}
+-------------------------------------------------------------------------------}
 procedure TOLEStorage.FreeOLEDocumentData(AOLEDocument: TOLEDocument);
 begin
   if Assigned(AOLEDocument.Stream) then FreeAndNil(AOLEDocument.Stream);

components/fpspreadsheet/tests/internaltests.pas

@@ -33,6 +33,7 @@ type
     procedure TearDown; override;
 
     procedure FractionTest(AMaxDigits: Integer);
+    procedure WriteToStreamTest(AFormat: TsSpreadsheetFormat);
 
   published
     // Tests getting Excel style A1 cell locations from row/column based locations.
@@ -53,6 +54,9 @@ type
     // Test buffered stream
     procedure TestReadBufStream;
     procedure TestWriteBufStream;
+    // Test write to stream
+    procedure TestWriteToStream_Biff8;
+    procedure TestWriteToStream_Biff5;
     // Test fractions
 //    procedure FractionTest_0;
     procedure FractionTest_1;
@@ -383,6 +387,73 @@ begin
   end;
 end;
 
+procedure TSpreadInternalTests.WriteToStreamTest(AFormat: TsSpreadsheetFormat);
+var
+  myworkbook: TsWorkbook;
+  myworksheet: TsWorksheet;
+  memstream: TMemoryStream;
+  filestream: TMemoryStream;
+  tempFile: String;
+  pf, pm: Pointer;
+  i, p: Integer;
+begin
+  tempFile := GetTempFileName;
+
+  myworkbook := TsWorkbook.Create;
+  myworksheet := myworkbook.AddWorksheet('Test');
+  memstream := TMemoryStream.Create;
+  filestream := TMemoryStream.Create;
+  try
+    myworksheet.WriteText(0, 0, 'Text');
+    myworksheet.WriteNumber(0, 1, 12.345);
+    myworksheet.WriteDateTime(0, 2, now() );
+
+    // Write to file
+    myworkbook.WriteToFile(tempfile, AFormat);
+
+    // Write to memory stream
+    myworkbook.WriteToStream(memstream, AFormat);
+
+    // Determine length of "used" data, there seems to be scap at the end
+    memstream.Position := 0;
+    myworkbook.ReadFromStream(memstream, AFormat);
+    p := memstream.Position;
+
+    // Read file back into memory stream
+    filestream.LoadFromFile(tempfile);
+
+    // Compare both streams
+    CheckEquals(filestream.Size, memstream.Size, 'Stream size mismatch');
+
+    pf := filestream.Memory;
+    pm := memStream.Memory;
+    for i:=0 to p-1 do
+    begin
+      CheckEquals(PByte(pf)^, PByte(pm)^, 'Stream mismatch at position ' + IntToStr(i));
+      inc(pf);
+      inc(pm);
+    end;
+
+  finally
+    filestream.Free;
+    memstream.Free;
+    myworkbook.Free;
+  end;
+
+  DeleteFile(tempFile);
+end;
+
+procedure TSpreadInternalTests.TestWriteToStream_Biff5;
+begin
+  WriteToStreamTest(sfExcel5);
+end;
+
+procedure TSpreadInternalTests.TestWriteToStream_Biff8;
+begin
+  WriteToStreamTest(sfExcel8);
+end;
+
+
 procedure TSpreadInternalTests.TestCellString;
 var
   r,c: Cardinal;

components/fpspreadsheet/uvirtuallayer_ole.pas

@@ -531,7 +531,7 @@ procedure TVirtualLayer_OLE.Format();
 begin
   FFATIndirect.Initialize(true);
   FFATIndirect.Free;
-  FFATIndirect:=TFATIndirect.Create(FVirtualLayerStream);
+  FFATIndirect := TFATIndirect.Create(FVirtualLayerStream);
   Self.Initialize();
 end;