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

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 := 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

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

7
components/fpspreadsheet/fpsstreams.pas
View File

@ -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;

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

@ -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.