pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Fix option boBufStream writing defective ods and xlsx files.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3444 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-07 12:52:26 +00:00
parent c575126fa0
commit b9dc9a801f
5 changed files with 55 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
components/fpspreadsheet/examples/fpsspeedtest/mainform.lfm
View File

@ -1,11 +1,11 @@
object Form1: TForm1 object Form1: TForm1
Left = 445 Left = 445
Height = 546 Height = 562
Top = 178 Top = 178
Width = 739 Width = 764
Caption = 'fpsSpeedTest' Caption = 'fpsSpeedTest'
ClientHeight = 546 ClientHeight = 562
ClientWidth = 739 ClientWidth = 764
KeyPreview = True KeyPreview = True
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
@ -13,25 +13,25 @@ object Form1: TForm1
LCLVersion = '1.3' LCLVersion = '1.3'
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 28
Top = 523 Top = 534
Width = 739 Width = 764
Panels = <> Panels = <>
end end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 42 Height = 52
Top = 0 Top = 0
Width = 739 Width = 764
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 42 ClientHeight = 52
ClientWidth = 739 ClientWidth = 764
TabOrder = 1 TabOrder = 1
object BtnWrite: TButton object BtnWrite: TButton
Left = 8 Left = 8
Height = 29 Height = 29
Top = 8 Top = 12
Width = 75 Width = 75
Caption = 'Write' Caption = 'Write'
OnClick = BtnWriteClick OnClick = BtnWriteClick
@ -39,9 +39,9 @@ object Form1: TForm1
end end
object LblCancel: TLabel object LblCancel: TLabel
Left = 208 Left = 208
Height = 30 Height = 40
Top = 6 Top = 6
Width = 309 Width = 385
Caption = 'Press ESC to cancel when current file is completely written.'#13#10'This may take some time...' Caption = 'Press ESC to cancel when current file is completely written.'#13#10'This may take some time...'
ParentColor = False ParentColor = False
Visible = False Visible = False
@ -49,7 +49,7 @@ object Form1: TForm1
object BtnRead: TButton object BtnRead: TButton
Left = 96 Left = 96
Height = 29 Height = 29
Top = 8 Top = 12
Width = 75 Width = 75
Caption = 'Read' Caption = 'Read'
OnClick = BtnReadClick OnClick = BtnReadClick
@ -58,27 +58,27 @@ object Form1: TForm1
end end
object ParameterPanel: TPanel object ParameterPanel: TPanel
Left = 0 Left = 0
Height = 477 Height = 478
Top = 46 Top = 56
Width = 150 Width = 182
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 477 ClientHeight = 478
ClientWidth = 150 ClientWidth = 182
TabOrder = 2 TabOrder = 2
object CbVirtualModeOnly: TCheckBox object CbVirtualModeOnly: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 8 Top = 8
Width = 114 Width = 142
Caption = 'Virtual mode only' Caption = 'Virtual mode only'
TabOrder = 0 TabOrder = 0
end end
object RgContent: TRadioGroup object RgContent: TRadioGroup
Left = 8 Left = 8
Height = 84 Height = 88
Top = 40 Top = 40
Width = 136 Width = 160
AutoFill = True AutoFill = True
Caption = 'Content' Caption = 'Content'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -89,7 +89,7 @@ object Form1: TForm1
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 66 ClientHeight = 66
ClientWidth = 132 ClientWidth = 156
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
'Strings' 'Strings'
@ -102,7 +102,7 @@ object Form1: TForm1
Left = 8 Left = 8
Height = 137 Height = 137
Top = 140 Top = 140
Width = 136 Width = 160
AutoFill = True AutoFill = True
Caption = 'File formats: ' Caption = 'File formats: '
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -113,8 +113,8 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 119 ClientHeight = 115
ClientWidth = 132 ClientWidth = 156
Items.Strings = ( Items.Strings = (
'ods' 'ods'
'xlsx' 'xlsx'
@ -131,7 +131,7 @@ object Form1: TForm1
Left = 8 Left = 8
Height = 177 Height = 177
Top = 295 Top = 295
Width = 136 Width = 160
AutoFill = True AutoFill = True
Caption = 'Row count' Caption = 'Row count'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -142,8 +142,8 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 159 ClientHeight = 155
ClientWidth = 132 ClientWidth = 156
Items.Strings = ( Items.Strings = (
'10k' '10k'
'20k' '20k'
@ -162,16 +162,16 @@ object Form1: TForm1
object Bevel1: TBevel object Bevel1: TBevel
Left = 0 Left = 0
Height = 4 Height = 4
Top = 42 Top = 52
Width = 739 Width = 764
Align = alTop Align = alTop
Shape = bsTopLine Shape = bsTopLine
end end
object Memo: TMemo object Memo: TMemo
Left = 150 Left = 182
Height = 477 Height = 478
Top = 46 Top = 56
Width = 589 Width = 582
Align = alClient Align = alClient
Font.Height = -12 Font.Height = -12
Font.Name = 'Courier New' Font.Name = 'Courier New'

5
components/fpspreadsheet/examples/fpsspeedtest/mainform.pas
View File

@ -270,7 +270,10 @@ begin
fname := CONTENT_PREFIX[RgContent.ItemIndex] + copy(fname, 1, pos(' ', fname)-1); fname := CONTENT_PREFIX[RgContent.ItemIndex] + copy(fname, 1, pos(' ', fname)-1);
fname := FDir + fname + '_' + IntToStr(idx); 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 for k := 0 to CgFormats.Items.Count-1 do
begin begin

13
components/fpspreadsheet/fpsopendocument.pas
View File

@ -2253,8 +2253,6 @@ end;
{ Creates the streams for the individual data files. Will be zipped into a { Creates the streams for the individual data files. Will be zipped into a
single xlsx file. } single xlsx file. }
procedure TsSpreadOpenDocWriter.CreateStreams; procedure TsSpreadOpenDocWriter.CreateStreams;
var
dir: String;
begin begin
if (boBufStream in Workbook.Options) then begin if (boBufStream in Workbook.Options) then begin
FSMeta := TBufStream.Create(GetTempFileName('', 'fpsM')); FSMeta := TBufStream.Create(GetTempFileName('', 'fpsM'));
@ -2263,16 +2261,7 @@ begin
FSContent := TBufStream.Create(GetTempFileName('', 'fpsC')); FSContent := TBufStream.Create(GetTempFileName('', 'fpsC'));
FSMimeType := TBufStream.Create(GetTempFileName('', 'fpsMT')); FSMimeType := TBufStream.Create(GetTempFileName('', 'fpsMT'));
FSMetaInfManifest := TBufStream.Create(GetTempFileName('', 'fpsMIM')); FSMetaInfManifest := TBufStream.Create(GetTempFileName('', 'fpsMIM'));
{ end else begin
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;
FSMeta := TMemoryStream.Create; FSMeta := TMemoryStream.Create;
FSSettings := TMemoryStream.Create; FSSettings := TMemoryStream.Create;
FSStyles := TMemoryStream.Create; FSStyles := TMemoryStream.Create;

7
components/fpspreadsheet/fpsstreams.pas
View File

@ -224,7 +224,11 @@ end;
@param Count Number of bytes to read from the stream @param Count Number of bytes to read from the stream
@return Number of bytes that were read from the stream.} @return Number of bytes that were read from the stream.}
function TBufStream.Read(var Buffer; Count: Longint): Longint; function TBufStream.Read(var Buffer; Count: Longint): Longint;
var
p: Int64;
begin begin
p := GetPosition; // Save stream position
// Case 1: Memory stream is empty // Case 1: Memory stream is empty
if FMemoryStream.Size = 0 then begin if FMemoryStream.Size = 0 then begin
CreateFileStream; CreateFileStream;
@ -237,7 +241,7 @@ begin
exit; exit;
end; 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 if FMemoryStream.Position + Count <= FMemoryStream.Size then begin
Result := FMemoryStream.Read(Buffer, Count); Result := FMemoryStream.Read(Buffer, Count);
exit; exit;
@ -246,6 +250,7 @@ begin
// Case 3: Memory stream is not empty but contains only part of the bytes requested // Case 3: Memory stream is not empty but contains only part of the bytes requested
if IsWritingMode then begin if IsWritingMode then begin
FlushBuffer; FlushBuffer;
FFileStream.Position := p;
Result := FFileStream.Read(Buffer, Count); Result := FFileStream.Read(Buffer, Count);
end else begin end else begin
FillBuffer; FillBuffer;

13
components/fpspreadsheet/tests/internaltests.pas
View File

@ -52,7 +52,7 @@ type
procedure ReadDateAsUTF8; procedure ReadDateAsUTF8;
// Test buffered stream // Test buffered stream
procedure TestReadBufStream; procedure TestReadBufStream;
procedure TestBufStream; procedure TestWriteBufStream;
// Virtual mode tests for all file formats // Virtual mode tests for all file formats
procedure TestVirtualMode_BIFF2; procedure TestVirtualMode_BIFF2;
@ -64,8 +64,8 @@ type
procedure TestVirtualMode_BIFF2_BufStream; procedure TestVirtualMode_BIFF2_BufStream;
procedure TestVirtualMode_BIFF5_BufStream; procedure TestVirtualMode_BIFF5_BufStream;
procedure TestVirtualMode_BIFF8_BufStream; procedure TestVirtualMode_BIFF8_BufStream;
//procedure TestVirtualMode_ODS_BufStream; procedure TestVirtualMode_ODS_BufStream;
//procedure TestVirtualMode_OOXML_BufStream; procedure TestVirtualMode_OOXML_BufStream;
end; end;
implementation implementation
@ -174,7 +174,7 @@ begin
MyWorkbook.Free; MyWorkbook.Free;
end; end;
procedure TSpreadInternalTests.TestBufStream; procedure TSpreadInternalTests.TestWriteBufStream;
const const
BUFSIZE = 1024; BUFSIZE = 1024;
var var
@ -480,7 +480,7 @@ procedure TSpreadInternalTests.TestVirtualMode_BIFF8_BufStream;
begin begin
TestVirtualMode(sfExcel8, true); TestVirtualMode(sfExcel8, true);
end; end;
(*
procedure TSpreadInternalTests.TestVirtualMode_ODS_BufStream; procedure TSpreadInternalTests.TestVirtualMode_ODS_BufStream;
begin begin
TestVirtualMode(sfOpenDocument, true); TestVirtualMode(sfOpenDocument, true);
@ -490,11 +490,12 @@ procedure TSpreadInternalTests.TestVirtualMode_OOXML_BufStream;
begin begin
TestVirtualMode(sfOOXML, true); TestVirtualMode(sfOOXML, true);
end; end;
*)
initialization initialization
// Register so these tests are included in a full run // Register so these tests are included in a full run
RegisterTest(TSpreadInternalTests); RegisterTest(TSpreadInternalTests);
end. end.