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

fpspreadsheet: Readers/writers now use memory streams by default. Add workbook option boFileStream to enforce usage of file streams. Improve fpsSpeadtest, add csv speed test.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4327 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-09-11 17:19:26 +00:00
parent f4978d3ec8
commit bf2d6f4417
7 changed files with 272 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,11 +1,11 @@
object Form1: TForm1
Left = 445
Height = 593
Height = 676
Top = 178
Width = 780
Width = 785
Caption = 'fpsSpeedTest'
ClientHeight = 593
ClientWidth = 780
ClientHeight = 676
ClientWidth = 785
KeyPreview = True
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
@@ -15,19 +15,19 @@ object Form1: TForm1
object StatusBar: TStatusBar
Left = 0
Height = 23
Top = 570
Width = 780
Top = 653
Width = 785
Panels = <>
end
object Panel1: TPanel
Left = 0
Height = 52
Top = 0
Width = 780
Width = 785
Align = alTop
BevelOuter = bvNone
ClientHeight = 52
ClientWidth = 780
ClientWidth = 785
TabOrder = 1
object BtnWrite: TButton
Left = 8
@@ -42,7 +42,7 @@ object Form1: TForm1
Left = 184
Height = 39
Top = 6
Width = 488
Width = 493
Anchors = [akTop, akLeft, akRight]
AutoSize = False
Caption = 'Press ESC to cancel when current file is completely written.'#13#10'This may take some time...'
@@ -60,7 +60,7 @@ object Form1: TForm1
TabOrder = 1
end
object BtnSaveResults: TButton
Left = 680
Left = 685
Height = 29
Top = 12
Width = 91
@@ -72,12 +72,12 @@ object Form1: TForm1
end
object ParameterPanel: TPanel
Left = 0
Height = 514
Height = 597
Top = 56
Width = 182
Align = alLeft
BevelOuter = bvNone
ClientHeight = 514
ClientHeight = 597
ClientWidth = 182
TabOrder = 2
object CbVirtualModeOnly: TCheckBox
@@ -114,7 +114,7 @@ object Form1: TForm1
end
object CgFormats: TCheckGroup
Left = 8
Height = 137
Height = 156
Top = 140
Width = 160
AutoFill = True
@@ -127,7 +127,7 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 117
ClientHeight = 136
ClientWidth = 156
Items.Strings = (
'ods'
@@ -135,16 +135,17 @@ object Form1: TForm1
'xls (BIFF 8)'
'xls (BIFF 5)'
'xls (BIFF 2)'
'csv'
)
TabOrder = 2
Data = {
050000000202020202
06000000020202020202
}
end
object CgRowCount: TCheckGroup
Left = 8
Height = 177
Top = 295
Top = 312
Width = 160
AutoFill = True
Caption = 'Row count'
@@ -172,12 +173,28 @@ object Form1: TForm1
0700000002020202020202
}
end
object CbSingleCol: TCheckBox
Left = 16
Height = 19
Top = 480
Width = 96
Caption = 'Single column'
object RgColCount: TRadioGroup
Left = 8
Height = 80
Top = 504
Width = 160
AutoFill = True
Caption = 'Column count'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 60
ClientWidth = 156
ItemIndex = 2
Items.Strings = (
'1'
'10'
'100'
)
TabOrder = 4
end
end
@@ -185,15 +202,15 @@ object Form1: TForm1
Left = 0
Height = 4
Top = 52
Width = 780
Width = 785
Align = alTop
Shape = bsTopLine
end
object Memo: TMemo
Left = 182
Height = 514
Height = 597
Top = 56
Width = 598
Width = 603
Align = alClient
Font.Height = -12
Font.Name = 'Courier New'

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

@@ -21,11 +21,11 @@ type
CgFormats: TCheckGroup;
CgRowCount: TCheckGroup;
CbVirtualModeOnly: TCheckBox;
CbSingleCol: TCheckBox;
LblCancel: TLabel;
Panel1: TPanel;
Memo: TMemo;
ParameterPanel: TPanel;
RgColCount: TRadioGroup;
RgContent: TRadioGroup;
SaveDialog: TSaveDialog;
StatusBar: TStatusBar;
@@ -43,6 +43,8 @@ type
FCurFormat: TsSpreadsheetFormat;
FErrCounter: Integer;
FErrLog: TStringList;
procedure BoldCheckgroup(AGroup: TCheckGroup);
procedure BoldRadiogroup(AGroup: TRadioGroup);
procedure EnableControls(AEnable: Boolean);
function GetRowCount(AIndex: Integer): Integer;
procedure ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
@@ -78,6 +80,7 @@ const
fmtXLS8 = 2;
fmtXLS5 = 3;
fmtXLS2 = 4;
fmtCSV = 5;
rc10k = 0;
rc20k = 1;
@@ -90,10 +93,10 @@ const
CONTENT_PREFIX: array[0..2] of Char = ('S', 'N', 'M');
CONTENT_TEXT: array[0..2] of string = ('strings only', 'numbers only', '50% strings and 50% numbers');
FORMAT_EXT: array[0..4] of String = ('.ods', '.xlsx', '.xls', '_b5.xls', '_b2.xls');
SPREAD_FORMAT: array[0..4] of TsSpreadsheetFormat = (sfOpenDocument, sfOOXML, sfExcel8, sfExcel5, sfExcel2);
FORMAT_EXT: array[0..5] of String = ('.ods', '.xlsx', '.xls', '_b5.xls', '_b2.xls', '.csv');
SPREAD_FORMAT: array[0..5] of TsSpreadsheetFormat = (sfOpenDocument, sfOOXML, sfExcel8, sfExcel5, sfExcel2, sfCSV);
COLCOUNT = 100;
COLCOUNT: array[0..2] of Integer = (1, 10, 100);
function LeftPad(AText: String; ALength: Integer): String;
begin
@@ -149,13 +152,10 @@ var
MyWorkbook: TsWorkbook;
Tm: DWord;
fName, s: String;
i, j: Integer;
k: Integer;
F: File;
ok: Boolean;
begin
Unused(idx);
s := Trim(Log);
s := Trim(Log); // needed for file name generation
Log := Log + ' ';
try
if FEscape then begin
@@ -163,57 +163,63 @@ begin
exit;
end;
for i := 0 to CgFormats.Items.Count-1 do begin
for k := 0 to CgFormats.Items.Count-1 do begin
if FEscape then begin
Log := 'Test aborted';
exit;
end;
if not CgFormats.Checked[i] then
if not CgFormats.Checked[k] then
continue;
FCurFormat := SPREAD_FORMAT[i];
FCurFormat := SPREAD_FORMAT[k];
StatusMsg('Reading ' + GetFileFormatName(FCurFormat));
ok := false;
for j:=1 to 4 do begin
if FEscape then begin
Log := 'Test aborted';
exit;
end;
fName := FDir + CONTENT_PREFIX[RgContent.ItemIndex] + Copy(s, 1, Pos(' ', s)-1) + '_' + IntToStr(j) + FORMAT_EXT[i];
if not FileExists(fname) then
continue;
AssignFile(F, fname);
Reset(F);
if FileSize(F) = 0 then
continue;
CloseFile(F);
MyWorkbook := TsWorkbook.Create;
try
Application.ProcessMessages;
MyWorkbook.Options := Options;
if boVirtualMode in Options then
MyWorkbook.OnReadCellData := @ReadCellDataHandler;
Tm := GetTickCount;
try
MyWorkbook.ReadFromFile(fname, SPREAD_FORMAT[i]);
Log := Log + format('%5.1f ', [(GetTickCount - Tm) / 1000]);
ok := true;
break;
except
on E:Exception do begin
inc(FErrCounter);
FErrLog.Add(Format('[%d] = %s', [FErrCounter, E.Message]));
end;
end;
finally
MyWorkbook.Free;
end;
if (SPREAD_FORMAT[k] = sfCSV) and (idx in [2, 4, 6, 8]) then
begin
Log := Log + ' - '; // No virtual mode for CSV
continue;
end;
fName := FDir + CONTENT_PREFIX[RgContent.ItemIndex] + Copy(s, 1, Pos(' ', s)-1) + '_' + IntToStr(idx) + FORMAT_EXT[k];
if not FileExists(fname) then
begin
inc(FErrCounter);
FErrLog.Add(Format('[%d] = File not found.', [FErrCounter]));
Log := Log + LeftPad(Format('[%d]',[FErrCounter]),5) + ' ';
continue;
end;
AssignFile(F, fname);
Reset(F);
if FileSize(F) = 0 then
begin
inc(FErrCounter);
FErrLog.Add(Format('[%d] = File size zero.', [FErrCounter]));
Log := Log + LeftPad(Format('[%d]',[FErrCounter]),5) + ' ';
continue;
end;
CloseFile(F);
MyWorkbook := TsWorkbook.Create;
try
Application.ProcessMessages;
MyWorkbook.Options := Options;
if boVirtualMode in Options then
MyWorkbook.OnReadCellData := @ReadCellDataHandler;
Tm := GetTickCount;
try
MyWorkbook.ReadFromFile(fname, SPREAD_FORMAT[k]);
Log := Log + format('%5.1f ', [(GetTickCount - Tm) / 1000]);
except
on E:Exception do begin
inc(FErrCounter);
FErrLog.Add(Format('[%d] = %s', [FErrCounter, E.Message]));
Log := Log + LeftPad(Format('[%d]',[FErrCounter]),5) + ' ';
end;
end;
finally
MyWorkbook.Free;
end;
if not ok then Log := Log + LeftPad(Format('[%d]',[FErrCounter]),5) + ' ';
end;
finally
@@ -240,10 +246,7 @@ begin
exit;
end;
if CbSingleCol.Checked then
numCols := 1
else
numCols := COLCOUNT;
numCols := COLCOUNT[RgColCount.ItemIndex];
MyWorksheet := MyWorkbook.AddWorksheet('Sheet1');
MyWorkbook.Options := Options;
@@ -302,10 +305,10 @@ begin
fname := CONTENT_PREFIX[RgContent.ItemIndex] + copy(fname, 1, pos(' ', fname)-1);
fname := FDir + fname + '_' + IntToStr(idx);
if Idx in [2, 4] then
if Idx in [2, 4, 6, 8] then
Log := Log + ' - ' // No build time in virtual mode
else
Log := Log + ' ' + format('%5.1f ', [(GetTickCount - Tm) / 1000]);
Log := Log + ' ' + Format('%5.1f ', [(GetTickCount - Tm) / 1000]);
for k := 0 to CgFormats.Items.Count-1 do
begin
@@ -323,8 +326,12 @@ begin
try
Application.ProcessMessages;
Tm := GetTickCount;
MyWorkbook.WriteToFile(fname + FORMAT_EXT[k], SPREAD_FORMAT[k], true);
Log := Log + Format('%5.1f ', [(GetTickCount - Tm) / 1000]);
if (SPREAD_FORMAT[k] = sfCSV) and (Idx in [2, 4, 6, 8]) then
Log := Log + ' - ' // No virtual mode for CSV
else begin
MyWorkbook.WriteToFile(fname + FORMAT_EXT[k], SPREAD_FORMAT[k], true);
Log := Log + Format('%5.1f ', [(GetTickCount - Tm) / 1000]);
end;
except
on E: Exception do
Log := Log + ' xxxx ';
@@ -354,6 +361,24 @@ begin
Result := StrToInt(s) * 1000;
end;
procedure TForm1.BoldCheckgroup(AGroup: TCheckGroup);
var
i: Integer;
begin
for i:=0 to AGroup.ControlCount-1 do
TCheckbox(AGroup.Controls[i]).ParentFont := false;
AGroup.Font.Style := [fsBold];
end;
procedure TForm1.BoldRadiogroup(AGroup: TRadioGroup);
var
i: Integer;
begin
for i:=0 to AGroup.ControlCount-1 do
TRadioButton(AGroup.Controls[i]).ParentFont := false;
AGroup.Font.Style := [fsBold];
end;
procedure TForm1.BtnReadClick(Sender: TObject);
var
i, len: Integer;
@@ -367,26 +392,28 @@ begin
EnableControls(false);
FErrLog.Clear;
if CbSingleCol.Checked then numCols := 1 else numCols := COLCOUNT;
numCols := COLCOUNT[RgColCount.ItemIndex];
Memo.Append ('Running: Reading TsWorkbook from various file formats');
Memo.Append (' Worksheet contains ' + CONTENT_TEXT[RgContent.ItemIndex]);
Memo.Append (' (Times in seconds)');
//'----------- .ods .xlsx biff8 biff5 biff2');
//'Rows x Cols Options Build Write Write Write Write Write'
s := '-------------------------------- ';
s := '--------------------------------------- ';
if CgFormats.Checked[fmtODS] then s := s + ' .ods ';
if CgFormats.Checked[fmtXLSX] then s := s + '.xlsx ';
if CgFormats.Checked[fmtXLS8] then s := s + 'biff8 ';
if CgFormats.Checked[fmtXLS5] then s := s + 'biff5 ';
if CgFormats.Checked[fmtXLS2] then s := s + 'biff2';
if CgFormats.Checked[fmtXLS2] then s := s + 'biff2 ';
if CgFormats.Checked[fmtCSV] then s := s + ' .csv';
Memo.Append(TrimRight(s));
s := 'Rows x Cols Options ';
s := 'Rows x Cols Options ';
if CgFormats.Checked[fmtODS] then s := s + ' Read ';
if CgFormats.Checked[fmtXLSX] then s := s + ' Read ';
if CgFormats.Checked[fmtXLS8] then s := s + ' Read ';
if CgFormats.Checked[fmtXLS5] then s := s + ' Read ';
if CgFormats.Checked[fmtXLS2] then s := s + ' Read';
if CgFormats.Checked[fmtXLS2] then s := s + ' Read ';
if CgFormats.Checked[fmtCSV] then s := s + ' Read';
s := TrimRight(s);
Memo.Append(s);
len := Length(s);
@@ -402,15 +429,19 @@ begin
rows := GetRowCount(i);
s := Format('%7.0nx%d', [1.0*rows, numCols]);
if numCols < 10 then s := s + ' ' else if numCols < 100 then s := s + ' ';
if CbVirtualModeOnly.Checked then begin
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(4, s + ' [boVM, boBS ]', [boVirtualMode, boBufStream]);
RunReadTest(6, s + ' [boVM, boFS]', [boVirtualMode, boFileStream]);
end else begin
RunReadTest(1, s + ' [ ]', []);
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(3, s + ' [ boBS]', [boBufStream]);
RunReadTest(4, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
RunReadTest(1, s + ' [ ]', []);
RunReadTest(2, s + ' [boVM ]', [boVirtualMode]);
RunReadTest(3, s + ' [ boBS ]', [boBufStream]);
RunReadTest(4, s + ' [boVM, boBS ]', [boVirtualMode, boBufStream]);
RunReadTest(5, s + ' [ boFS]', [boFileStream]);
RunReadTest(6, s + ' [boVM, boFS]', [boVirtualMode, boFileStream]);
end;
Memo.Append(DupeString('-', len));
@@ -444,26 +475,28 @@ begin
FEscape := false;
EnableControls(false);
FErrLog.Clear;
if CbSingleCol.Checked then numCols := 1 else numCols := COLCOUNT;
numCols := COLCOUNT[RgColCount.ItemIndex];
Memo.Append ('Running: Building TsWorkbook and writing to different file formats');
Memo.Append (' Worksheet contains ' + CONTENT_TEXT[RgContent.ItemIndex]);
Memo.Append (' (Times in seconds)');
//'----------- .ods .xlsx biff8 biff5 biff2');
//'Rows x Cols Options Build Write Write Write Write Write'
s := '-------------------------------- ';
s := '--------------------------------------- ';
if CgFormats.Checked[fmtODS] then s := s + ' .ods ';
if CgFormats.Checked[fmtXLSX] then s := s + '.xlsx ';
if CgFormats.Checked[fmtXLS8] then s := s + 'biff8 ';
if CgFormats.Checked[fmtXLS5] then s := s + 'biff5 ';
if CgFormats.Checked[fmtXLS2] then s := s + 'biff2';
if CgFormats.Checked[fmtXLS2] then s := s + 'biff2 ';
if CgFormats.Checked[fmtCSV] then s := s + ' .csv';
Memo.Append(TrimRight(s));
s := 'Rows x Cols Options Build ';
s := 'Rows x Cols Options Build ';
if CgFormats.Checked[fmtODS] then s := s + 'Write ';
if CgFormats.Checked[fmtXLSX] then s := s + 'Write ';
if CgFormats.Checked[fmtXLS8] then s := s + 'Write ';
if CgFormats.Checked[fmtXLS5] then s := s + 'Write ';
if CgFormats.Checked[fmtXLS2] then s := s + 'Write';
if CgFormats.Checked[fmtXLS2] then s := s + 'Write ';
if CgFormats.Checked[fmtCSV] then s := s + 'Write';
s := TrimRight(s);
len := Length(s);
Memo.Append(s);
@@ -478,14 +511,18 @@ begin
continue;
Rows := GetRowCount(i);
s := Format('%7.0nx%d', [1.0*Rows, numCols]);
if numCols < 10 then s := s + ' ' else if numCols < 100 then s := s + ' ';
if CbVirtualModeOnly.Checked then begin
RunWriteTest(2, Rows, s + ' [boVM ]', [boVirtualMode]);
RunWriteTest(4, Rows, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
RunWriteTest(2, Rows, s + ' [boVM ]', [boVirtualMode]);
RunWriteTest(4, Rows, s + ' [boVM, boBS ]', [boVirtualMode, boBufStream]);
RunWriteTest(6, Rows, s + ' [boVM, boFS]', [boVirtualMode, boFileStream]);
end else begin
RunWriteTest(1, Rows, s + ' [ ]', []);
RunWriteTest(2, Rows, s + ' [boVM ]', [boVirtualMode]);
RunWriteTest(3, Rows, s + ' [ boBS]', [boBufStream]);
RunWriteTest(4, Rows, s + ' [boVM, boBS]', [boVirtualMode, boBufStream]);
RunWriteTest(1, Rows, s + ' [ ]', []);
RunWriteTest(2, Rows, s + ' [boVM ]', [boVirtualMode]);
RunWriteTest(3, Rows, s + ' [ boBS ]', [boBufStream]);
RunWriteTest(4, Rows, s + ' [boVM, boBS ]', [boVirtualMode, boBufStream]);
RunWriteTest(5, Rows, s + ' [ boFS]', [boFileStream]);
RunWriteTest(6, Rows, s + ' [boVM, boFS]', [boVirtualMode, boFileStream]);
end;
Memo.Append(DupeString('-', len));
end;
@@ -514,6 +551,7 @@ begin
RgContent.Enabled := AEnable;
CgFormats.Enabled := AEnable;
CgRowCount.Enabled := AEnable;
RgColCount.Enabled := AEnable;
LblCancel.Visible := not AEnable;
StatusMsg('');
Application.ProcessMessages;
@@ -531,6 +569,7 @@ begin
CgFormats.Checked[fmtXLS8] := true;
CgFormats.Checked[fmtXLS5] := true;
CgFormats.Checked[fmtXLS2] := true;
CgFormats.Checked[fmtCSV] := true;
CgRowCount.Checked[rc10k] := true;
CgRowCount.Checked[rc20k] := true;
@@ -540,6 +579,11 @@ begin
FErrLog := TStringList.Create;
ReadFromIni;
BoldRadiogroup(RgContent);
BoldRadiogroup(RgColCount);
BoldCheckGroup(CgFormats);
BoldCheckGroup(CgRowCount);
end;
procedure TForm1.FormDestroy(Sender: TObject);
@@ -564,6 +608,7 @@ begin
try
CbVirtualModeOnly.Checked := ini.ReadBool('Parameters', 'VirtualModeOnly', CbVirtualModeOnly.Checked);
RgContent.ItemIndex := ini.ReadInteger('Parameters', 'Content', RgContent.ItemIndex);
RgColCount.ItemIndex := Ini.ReadInteger('Parameters', 'ColCount', RgColCount.ItemIndex);
n := Ini.ReadInteger('Parameters', 'Formats', $1F);
CgFormats.Checked[fmtODS] := n and $01 <> 0;
@@ -571,6 +616,7 @@ begin
CgFormats.Checked[fmtXLS8] := n and $04 <> 0;
CgFormats.Checked[fmtXLS5] := n and $08 <> 0;
CgFormats.Checked[fmtXLS2] := n and $10 <> 0;
CgFormats.Checked[fmtCSV] := n and $20 <> 0;
n := Ini.ReadInteger('Parameters', 'RowCount', $0F);
CgRowCount.Checked[rc10k] := n and $01 <> 0;
@@ -593,8 +639,9 @@ var
begin
ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
ini.WriteBool('Parameters', 'VirtualModeOnly', CbVirtualModeOnly.Checked);
ini.WriteBool ('Parameters', 'VirtualModeOnly', CbVirtualModeOnly.Checked);
ini.WriteInteger('Parameters', 'Content', RgContent.ItemIndex);
ini.WriteInteger('Parameters', 'ColCount', RgColCount.ItemIndex);
n := 0;
if CgFormats.Checked[fmtODS] then n := n or $1;
@@ -602,6 +649,7 @@ begin
if CgFormats.Checked[fmtXLS8] then n := n or $4;
if CgFormats.Checked[fmtXLS5] then n := n or $8;
if CgFormats.Checked[fmtXLS2] then n := n or $10;
if CgFormats.Checked[fmtCSV] then n := n or $20;
ini.WriteInteger('Parameters', 'Formats', n);
n := 0;

33
components/fpspreadsheet/fpsopendocument.pas
View File

@@ -142,7 +142,7 @@ type
destructor Destroy; override;
{ General reading methods }
procedure ReadFromFile(AFileName: string); override;
(* procedure ReadFromFile(AFileName: string); override;*)
procedure ReadFromStream(AStream: TStream); override;
end;
@@ -2035,7 +2035,7 @@ begin
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
(*
{ In principle, this method could be simplified by calling ReadFromStream which
is essentially a duplication of ReadFromFile. But ReadFromStream leads to
worse memory usage. --> KEEP READFROMFILE INTACT
@@ -2159,7 +2159,7 @@ begin
if Assigned(Doc) then Doc.Free;
end;
end;
*)
procedure TsSpreadOpenDocReader.ReadFromStream(AStream: TStream);
var
Doc : TXMLDocument;
@@ -2170,11 +2170,23 @@ var
pageLayout: PsPageLayout;
XMLStream: TStream;
sheet: TsWorksheet;
function CreateXMLStream: TStream;
begin
if boFileStream in FWorkbook.Options then
Result := TFileStream.Create(GetTempFileName, fmCreate)
else
if boBufStream in FWorkbook.Options then
Result := TBufStream.Create(GetTempFileName, fmCreate)
else
Result := TMemoryStream.Create;
end;
begin
Doc := nil;
try
// process the styles.xml file
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, 'styles.xml', XMLStream) then
ReadXMLStream(Doc, XMLStream);
@@ -2192,7 +2204,7 @@ begin
FreeAndNil(Doc);
//process the content.xml file
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, 'content.xml', XMLStream) then
ReadXMLStream(Doc, XMLStream);
@@ -2249,7 +2261,7 @@ begin
FreeAndNil(Doc);
// process the settings.xml file (Note: it does not always exist!)
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, 'settings.xml', XMLStream) then
begin
@@ -3712,6 +3724,15 @@ end;
single xlsx file. }
procedure TsSpreadOpenDocWriter.CreateStreams;
begin
if boFileStream in FWorkbook.Options then
begin
FSMeta := TFileStream.Create(GetTempFileName('', 'fpsM'), fmCreate);
FSSettings := TFileStream.Create(GetTempFileName('', 'fpsS'), fmCreate);
FSStyles := TFileStream.Create(GetTempFileName('', 'fpsSTY'), fmCreate);
FSContent := TFileStream.Create(GetTempFileName('', 'fpsC'), fmCreate);
FSMimeType := TFileStream.Create(GetTempFileName('', 'fpsMT'), fmCreate);
FSMetaInfManifest := TFileStream.Create(GetTempFileName('', 'fpsMIM'), fmCreate);
end else
if (boBufStream in Workbook.Options) then
begin
FSMeta := TBufStream.Create(GetTempFileName('', 'fpsM'));

7
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -549,6 +549,9 @@ type
for writing (a memory stream swapping to disk) or
reading (a file stream pre-reading chunks of data
to memory)
@param boFileStream Uses file streams and temporary files during
reading and writing. Lowest memory consumptions,
but slow.
@param boAutoCalc Automatically recalculate rpn formulas whenever
a cell value changes.
@param boCalcBeforeSaving Calculates formulas before saving the file.
@@ -558,8 +561,8 @@ type
a precaution since formulas not correctly
implemented by fpspreadsheet could crash the
reading operation. }
TsWorkbookOption = (boVirtualMode, boBufStream, boAutoCalc, boCalcBeforeSaving,
boReadFormulas);
TsWorkbookOption = (boVirtualMode, boBufStream, boFileStream,
boAutoCalc, boCalcBeforeSaving, boReadFormulas);
{@@ Set of option flags for the workbook }
TsWorkbookOptions = set of TsWorkbookOption;

23
components/fpspreadsheet/fpsreaderwriter.pas
View File

@@ -296,12 +296,24 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomSpreadReader.ReadFromFile(AFileName: string);
var
stream: TStream;
stream, fs: TStream;
begin
if (boFileStream in Workbook.Options) then
stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone)
else
if (boBufStream in Workbook.Options) then
stream := TBufStream.Create(AFileName, fmOpenRead + fmShareDenyNone)
else
stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
begin
stream := TMemoryStream.Create;
fs := TFileStream.Create(AFilename, fmOpenRead + fmShareDenyNone);
try
(stream as TMemoryStream).CopyFrom(fs, fs.Size);
stream.Position := 0;
finally
fs.Free;
end;
end;
try
ReadFromStream(stream);
@@ -605,13 +617,18 @@ begin
else
lMode := fmCreate;
if (boFileStream in FWorkbook.Options) then
OutputFile := TFileStream.Create(AFileName, lMode)
else
if (boBufStream in Workbook.Options) then
OutputFile := TBufStream.Create(AFileName, lMode)
else
OutputFile := TFileStream.Create(AFileName, lMode);
OutputFile := TMemoryStream.Create;
try
WriteToStream(OutputFile);
if OutputFile is TMemoryStream then
(OutputFile as TMemoryStream).SaveToFile(AFileName);
finally
OutputFile.Free;
end;

6
components/fpspreadsheet/fpsutils.pas
View File

@@ -152,7 +152,7 @@ function SameFont(AFont1, AFont2: TsFont): Boolean; overload;
function SameFont(AFont: TsFont; AFontName: String; AFontSize: Single;
AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Boolean; overload;
function GetUniqueTempDir(Global: Boolean): String;
//function GetUniqueTempDir(Global: Boolean): String;
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
@@ -1965,7 +1965,7 @@ begin
While Length(Result) < Len do
Result := Result + char(ord('A') + random(26));
end;
(*
{@@ ----------------------------------------------------------------------------
Constructs a unique folder name in the temp directory of the OS
-------------------------------------------------------------------------------}
@@ -1978,7 +1978,7 @@ begin
Result := tempdir + AppendPathDelim(GetRandomString(8));
until not DirectoryExists(Result);
end;
*)
{@@ ----------------------------------------------------------------------------
Appends a string to a stream

57
components/fpspreadsheet/xlsxooxml.pas
View File

@@ -99,7 +99,7 @@ type
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
procedure ReadFromFile(AFileName: string); override;
// procedure ReadFromFile(AFileName: string); override;
procedure ReadFromStream(AStream: TStream); override;
end;
@@ -1879,7 +1879,7 @@ begin
FixCols(AWorksheet);
FixRows(AWorksheet);
end;
(*
{ In principle, this method could be simplified by calling ReadFromStream which
is essentially a duplication of ReadFromFile. But ReadFromStream leads to
worse memory usage. --> KEEP READFROMFILE INTACT }
@@ -2028,7 +2028,7 @@ begin
FreeAndNil(Doc);
end;
end;
*)
procedure TsSpreadOOXMLReader.ReadFromStream(AStream: TStream);
var
Doc : TXMLDocument;
@@ -2039,12 +2039,24 @@ var
fn_comments: String;
XMLStream: TStream;
actSheetIndex: Integer;
function CreateXMLStream: TStream;
begin
if boFileStream in FWorkbook.Options then
Result := TFileStream.Create(GetTempFileName, fmCreate)
else
if boBufStream in FWorkbook.Options then
Result := TBufStream.Create(GetTempFileName, fmCreate)
else
Result := TMemoryStream.Create;
end;
begin
Doc := nil;
SheetList := TStringList.Create;
try
// Retrieve theme colors
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, OOXML_PATH_XL_THEME, XMLStream) then
begin
@@ -2057,7 +2069,7 @@ begin
end;
// process the workbook.xml file
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then
raise Exception.CreateFmt(rsDefectiveInternalStructure, ['xlsx']);
@@ -2072,7 +2084,7 @@ begin
end;
// process the styles.xml file
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
// Should always exist, just to make sure...
if UnzipToStream(AStream, OOXML_PATH_XL_STYLES, XMLStream) then
@@ -2092,7 +2104,7 @@ begin
// process the sharedstrings.xml file
// To do: Use buffered stream instead since shared strings may be large
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, OOXML_PATH_XL_STRINGS, XMLStream) then
begin
@@ -2110,7 +2122,7 @@ begin
FWorksheet := FWorkbook.AddWorksheet(SheetList[i], true);
// unzip sheet file
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
fn := OOXML_PATH_XL_WORKSHEETS + Format('sheet%d.xml', [i+1]);
if not UnzipToStream(AStream, fn, XMLStream) then
@@ -2140,7 +2152,7 @@ begin
retrieved from the "sheet<n>.xml.rels" file (n = 1, 2, ...).
The rels file contains also the second part of the hyperlink data. }
fn := OOXML_PATH_XL_WORKSHEETS_RELS + Format('sheet%d.xml.rels', [i+1]);
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, fn, XMLStream) then
begin
@@ -2168,7 +2180,7 @@ begin
if fn_comments <> '' then
begin
fn := OOXML_PATH_XL + fn_comments;
XMLStream := TMemoryStream.Create;
XMLStream := CreateXMLStream;
try
if UnzipToStream(AStream, fn, XMLStream) then
begin
@@ -2466,6 +2478,9 @@ begin
// Create the comments stream
SetLength(FSComments, FCurSheetNum + 1);
if boFileStream in FWorkbook.Options then
FSComments[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsCMNT%d', [FCurSheetNum])), fmCreate)
else
if (boBufStream in Workbook.Options) then
FSComments[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsCMNT%d', [FCurSheetNum])))
else
@@ -3216,6 +3231,9 @@ begin
exit;
SetLength(FSVmlDrawings, FCurSheetNum + 1);
if boFileStream in FWorkbook.Options then
FSVmlDrawings[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsVMLD%d', [FCurSheetNum])), fmCreate)
else
if (boBufStream in Workbook.Options) then
FSVmlDrawings[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsVMLD%d', [FCurSheetNum])))
else
@@ -3290,6 +3308,9 @@ begin
exit;
// Create stream
if boFileStream in FWorkbook.Options then
FSSheetRels[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsWSR%d', [FCurSheetNum])), fmCreate)
else
if (boBufStream in Workbook.Options) then
FSSheetRels[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsWSR%d', [FCurSheetNum])))
else
@@ -3530,6 +3551,9 @@ begin
SetLength(FSSheets, FCurSheetNum + 1);
// Create the stream
if boFileStream in FWorkbook.Options then
FSSheets[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsSH%d', [FCurSheetNum])), fmCreate)
else
if (boBufStream in Workbook.Options) then
FSSheets[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsSH%d', [FCurSheetNum])))
else
@@ -3578,7 +3602,18 @@ end;
-------------------------------------------------------------------------------}
procedure TsSpreadOOXMLWriter.CreateStreams;
begin
if (boBufStream in Workbook.Options) then begin
if boFileStream in FWorkbook.Options then
begin
FSContentTypes := TFileStream.Create(GetTempFileName('', 'fpsCT'), fmCreate);
FSRelsRels := TFileStream.Create(GetTempFileName('', 'fpsRR'), fmCreate);
FSWorkbookRels := TFileStream.Create(GetTempFileName('', 'fpsWBR'), fmCreate);
FSWorkbook := TFileStream.Create(GetTempFileName('', 'fpsWB'), fmCreate);
FSStyles := TFileStream.Create(GetTempFileName('', 'fpsSTY'), fmCreate);
FSSharedStrings := TFileStream.Create(GetTempFileName('', 'fpsSS'), fmCreate);
FSSharedStrings_complete := TFileStream.Create(GetTempFileName('', 'fpsSSC'), fmCreate);
end else
if (boBufStream in Workbook.Options) then
begin
FSContentTypes := TBufStream.Create(GetTempFileName('', 'fpsCT'));
FSRelsRels := TBufStream.Create(GetTempFileName('', 'fpsRR'));
FSWorkbookRels := TBufStream.Create(GetTempFileName('', 'fpsWBR'));