From b9dc9a801fac6fd62fc22efdc32b5fc2894ddb2a Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 7 Aug 2014 12:52:26 +0000 Subject: [PATCH] fpspreadsheet: Fix option boBufStream writing defective ods and xlsx files. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3444 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/fpsspeedtest/mainform.lfm | 74 +++++++++---------- .../examples/fpsspeedtest/mainform.pas | 5 +- components/fpspreadsheet/fpsopendocument.pas | 13 +--- components/fpspreadsheet/fpsstreams.pas | 7 +- .../fpspreadsheet/tests/internaltests.pas | 13 ++-- 5 files changed, 55 insertions(+), 57 deletions(-) diff --git a/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm b/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm index c14a76b9f..ea521d9f2 100644 --- a/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm +++ b/components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm @@ -1,11 +1,11 @@ object Form1: TForm1 Left = 445 - Height = 546 + Height = 562 Top = 178 - Width = 739 + Width = 764 Caption = 'fpsSpeedTest' - ClientHeight = 546 - ClientWidth = 739 + ClientHeight = 562 + ClientWidth = 764 KeyPreview = True OnCloseQuery = FormCloseQuery OnCreate = FormCreate @@ -13,25 +13,25 @@ object Form1: TForm1 LCLVersion = '1.3' object StatusBar: TStatusBar Left = 0 - Height = 23 - Top = 523 - Width = 739 + Height = 28 + Top = 534 + Width = 764 Panels = <> end object Panel1: TPanel Left = 0 - Height = 42 + Height = 52 Top = 0 - Width = 739 + Width = 764 Align = alTop BevelOuter = bvNone - ClientHeight = 42 - ClientWidth = 739 + ClientHeight = 52 + ClientWidth = 764 TabOrder = 1 object BtnWrite: TButton Left = 8 Height = 29 - Top = 8 + Top = 12 Width = 75 Caption = 'Write' OnClick = BtnWriteClick @@ -39,9 +39,9 @@ object Form1: TForm1 end object LblCancel: TLabel Left = 208 - Height = 30 + Height = 40 Top = 6 - Width = 309 + Width = 385 Caption = 'Press ESC to cancel when current file is completely written.'#13#10'This may take some time...' ParentColor = False Visible = False @@ -49,7 +49,7 @@ object Form1: TForm1 object BtnRead: TButton Left = 96 Height = 29 - Top = 8 + Top = 12 Width = 75 Caption = 'Read' OnClick = BtnReadClick @@ -58,27 +58,27 @@ object Form1: TForm1 end object ParameterPanel: TPanel Left = 0 - Height = 477 - Top = 46 - Width = 150 + Height = 478 + Top = 56 + Width = 182 Align = alLeft BevelOuter = bvNone - ClientHeight = 477 - ClientWidth = 150 + ClientHeight = 478 + ClientWidth = 182 TabOrder = 2 object CbVirtualModeOnly: TCheckBox Left = 8 - Height = 19 + Height = 24 Top = 8 - Width = 114 + Width = 142 Caption = 'Virtual mode only' TabOrder = 0 end object RgContent: TRadioGroup Left = 8 - Height = 84 + Height = 88 Top = 40 - Width = 136 + Width = 160 AutoFill = True Caption = 'Content' ChildSizing.LeftRightSpacing = 6 @@ -89,7 +89,7 @@ object Form1: TForm1 ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 ClientHeight = 66 - ClientWidth = 132 + ClientWidth = 156 ItemIndex = 0 Items.Strings = ( 'Strings' @@ -102,7 +102,7 @@ object Form1: TForm1 Left = 8 Height = 137 Top = 140 - Width = 136 + Width = 160 AutoFill = True Caption = 'File formats: ' ChildSizing.LeftRightSpacing = 6 @@ -113,8 +113,8 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 119 - ClientWidth = 132 + ClientHeight = 115 + ClientWidth = 156 Items.Strings = ( 'ods' 'xlsx' @@ -131,7 +131,7 @@ object Form1: TForm1 Left = 8 Height = 177 Top = 295 - Width = 136 + Width = 160 AutoFill = True Caption = 'Row count' ChildSizing.LeftRightSpacing = 6 @@ -142,8 +142,8 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 159 - ClientWidth = 132 + ClientHeight = 155 + ClientWidth = 156 Items.Strings = ( '10k' '20k' @@ -162,16 +162,16 @@ object Form1: TForm1 object Bevel1: TBevel Left = 0 Height = 4 - Top = 42 - Width = 739 + Top = 52 + Width = 764 Align = alTop Shape = bsTopLine end object Memo: TMemo - Left = 150 - Height = 477 - Top = 46 - Width = 589 + Left = 182 + Height = 478 + Top = 56 + Width = 582 Align = alClient Font.Height = -12 Font.Name = 'Courier New' diff --git a/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas b/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas index 8c1409cf6..464506abd 100644 --- a/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas +++ b/components/fpspreadsheet/examples/fpsspeedtest/mainform.pas @@ -270,7 +270,10 @@ begin fname := CONTENT_PREFIX[RgContent.ItemIndex] + copy(fname, 1, pos(' ', fname)-1); fname := FDir + fname + '_' + IntToStr(idx); - Log := Log + ' ' + format('%5.1f ', [(GetTickCount - Tm) / 1000]); + if Idx in [2, 4] then + Log := Log + ' - ' // No build time in virtual mode + else + Log := Log + ' ' + format('%5.1f ', [(GetTickCount - Tm) / 1000]); for k := 0 to CgFormats.Items.Count-1 do begin diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index b57180c48..08a50b940 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -2253,8 +2253,6 @@ end; { Creates the streams for the individual data files. Will be zipped into a single xlsx file. } procedure TsSpreadOpenDocWriter.CreateStreams; -var - dir: String; begin if (boBufStream in Workbook.Options) then begin FSMeta := TBufStream.Create(GetTempFileName('', 'fpsM')); @@ -2263,16 +2261,7 @@ begin FSContent := TBufStream.Create(GetTempFileName('', 'fpsC')); FSMimeType := TBufStream.Create(GetTempFileName('', 'fpsMT')); FSMetaInfManifest := TBufStream.Create(GetTempFileName('', 'fpsMIM')); - { - dir := IncludeTrailingPathDelimiter(GetTempDir); - FSMeta := TFileStream.Create(GetTempFileName(dir, 'fpsM'), fmCreate+fmOpenRead); - FSSettings := TFileStream.Create(GetTempFileName(dir, 'fpsS'), fmCreate+fmOpenRead); - FSStyles := TFileStream.Create(GetTempFileName(dir, 'fpsSTY'), fmCreate+fmOpenRead); - FSContent := TFileStream.Create(GetTempFileName(dir, 'fpsC'), fmCreate+fmOpenRead); - FSMimeType := TFileStream.Create(GetTempFileName(dir, 'fpsMT'), fmCreate+fmOpenRead); - FSMetaInfManifest := TFileStream.Create(GetTempFileName(dir, 'fpsMIM'), fmCreate+fmOpenRead); - } - end else begin; + end else begin FSMeta := TMemoryStream.Create; FSSettings := TMemoryStream.Create; FSStyles := TMemoryStream.Create; diff --git a/components/fpspreadsheet/fpsstreams.pas b/components/fpspreadsheet/fpsstreams.pas index 793dc3a28..0f0bdef70 100644 --- a/components/fpspreadsheet/fpsstreams.pas +++ b/components/fpspreadsheet/fpsstreams.pas @@ -224,7 +224,11 @@ end; @param Count Number of bytes to read from the stream @return Number of bytes that were read from the stream.} function TBufStream.Read(var Buffer; Count: Longint): Longint; +var + p: Int64; begin + p := GetPosition; // Save stream position + // Case 1: Memory stream is empty if FMemoryStream.Size = 0 then begin CreateFileStream; @@ -237,7 +241,7 @@ begin exit; end; - // Case 2: All "Count" bytes are contained in memory stream + // Case 2: All "Count" bytes are contained in memory stream starting at current position if FMemoryStream.Position + Count <= FMemoryStream.Size then begin Result := FMemoryStream.Read(Buffer, Count); exit; @@ -246,6 +250,7 @@ begin // Case 3: Memory stream is not empty but contains only part of the bytes requested if IsWritingMode then begin FlushBuffer; + FFileStream.Position := p; Result := FFileStream.Read(Buffer, Count); end else begin FillBuffer; diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index 691c211d3..b0d20edeb 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -52,7 +52,7 @@ type procedure ReadDateAsUTF8; // Test buffered stream procedure TestReadBufStream; - procedure TestBufStream; + procedure TestWriteBufStream; // Virtual mode tests for all file formats procedure TestVirtualMode_BIFF2; @@ -64,8 +64,8 @@ type procedure TestVirtualMode_BIFF2_BufStream; procedure TestVirtualMode_BIFF5_BufStream; procedure TestVirtualMode_BIFF8_BufStream; - //procedure TestVirtualMode_ODS_BufStream; - //procedure TestVirtualMode_OOXML_BufStream; + procedure TestVirtualMode_ODS_BufStream; + procedure TestVirtualMode_OOXML_BufStream; end; implementation @@ -174,7 +174,7 @@ begin MyWorkbook.Free; end; -procedure TSpreadInternalTests.TestBufStream; +procedure TSpreadInternalTests.TestWriteBufStream; const BUFSIZE = 1024; var @@ -480,7 +480,7 @@ procedure TSpreadInternalTests.TestVirtualMode_BIFF8_BufStream; begin TestVirtualMode(sfExcel8, true); end; - (* + procedure TSpreadInternalTests.TestVirtualMode_ODS_BufStream; begin TestVirtualMode(sfOpenDocument, true); @@ -490,11 +490,12 @@ procedure TSpreadInternalTests.TestVirtualMode_OOXML_BufStream; begin TestVirtualMode(sfOOXML, true); end; - *) + initialization // Register so these tests are included in a full run RegisterTest(TSpreadInternalTests); + end.