From b68bbe08ef306998231d053bf3130fb667a7f188 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 27 Aug 2015 16:02:58 +0000 Subject: [PATCH] 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 | 81 +++---------------- .../fpspreadsheet/tests/internaltests.pas | 71 ++++++++++++++++ .../fpspreadsheet/uvirtuallayer_ole.pas | 2 +- 3 files changed, 82 insertions(+), 72 deletions(-) diff --git a/components/fpspreadsheet/fpolebasic.pas b/components/fpspreadsheet/fpolebasic.pas index 026646db0..f947c5e68 100644 --- a/components/fpspreadsheet/fpolebasic.pas +++ b/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 - AOLEDocument.Stream := TMemoryStream.Create - else + if not Assigned(AOLEDocument.Stream) then + AOLEDocument.Stream := TMemoryStream.Create 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); diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index 30c33343f..e6a9f9ba0 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/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; diff --git a/components/fpspreadsheet/uvirtuallayer_ole.pas b/components/fpspreadsheet/uvirtuallayer_ole.pas index bbaf6162f..b40eb93a0 100644 --- a/components/fpspreadsheet/uvirtuallayer_ole.pas +++ b/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;