From 7f6277ca084557c653f0b1497d5c5f7e81360643 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 18 Jul 2014 22:48:38 +0000 Subject: [PATCH] fpspreadsheet: Add unit fpsstreams containing a buffered stream for speed-up of writing in virtual mode. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3331 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/other/test_virtualmode.lpr | 16 +- components/fpspreadsheet/fpsstreams.pas | 199 ++++++++++++++++++ .../fpspreadsheet/laz_fpspreadsheet.lpk | 7 +- .../fpspreadsheet/laz_fpspreadsheet.pas | 2 +- .../fpspreadsheet/tests/internaltests.pas | 86 +++++++- components/fpspreadsheet/xlsbiff8.pas | 10 +- components/fpspreadsheet/xlscommon.pas | 90 ++++---- components/fpspreadsheet/xlsxooxml.pas | 59 +++--- 8 files changed, 381 insertions(+), 88 deletions(-) create mode 100644 components/fpspreadsheet/fpsstreams.pas diff --git a/components/fpspreadsheet/examples/other/test_virtualmode.lpr b/components/fpspreadsheet/examples/other/test_virtualmode.lpr index 14f8a445e..21c19de78 100644 --- a/components/fpspreadsheet/examples/other/test_virtualmode.lpr +++ b/components/fpspreadsheet/examples/other/test_virtualmode.lpr @@ -21,6 +21,7 @@ var worksheet: TsWorksheet; dataprovider: TDataProvider; headerTemplate: PCell; + t: TTime; procedure TDataProvider.NeedCellData(Sender: TObject; ARow, ACol: Cardinal; var AData: variant; var AStyleCell: PCell); @@ -33,7 +34,6 @@ var } var s: String; - n: Double; begin if ARow = 0 then begin AData := Format('Column %d', [ACol + 1]); @@ -65,8 +65,8 @@ begin { These are the essential commands to activate virtual mode: } - workbook.WritingOptions := [woVirtualMode, woSaveMemory]; -// workbook.WritingOptions := [woVirtualMode]; +// workbook.WritingOptions := [woVirtualMode, woSaveMemory]; + workbook.WritingOptions := [woVirtualMode]; { woSaveMemory can be omitted, but is essential for large files: it causes writing temporaray data to a file stream instead of a memory stream. woSaveMemory, however, considerably slows down writing of biff files. } @@ -74,7 +74,7 @@ begin { Next two numbers define the size of virtual spreadsheet. In case of a database, VirtualRowCount is the RecordCount, VirtualColCount the number of fields to be written to the spreadsheet file } - workbook.VirtualRowCount := 10000; + workbook.VirtualRowCount := 60000; workbook.VirtualColCount := 100; { The event handler for OnNeedCellData links the workbook to the method @@ -93,13 +93,17 @@ begin worksheet.WriteRowHeight(0, 3); worksheet.WriteColWidth(0, 30); { In case of a database, you would open the dataset before calling this: } - //workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true); - workbook.WriteToFile('test_virtual.xls', sfExcel8, true); + + t := Now; + workbook.WriteToFile('test_virtual.xlsx', sfOOXML, true); + //workbook.WriteToFile('test_virtual.xls', sfExcel8, true); + t := Now - t; finally workbook.Free; end; + WriteLn(Format('Execution time: %.3f sec', [t*24*60*60])); WriteLn('Press [ENTER] to quit...'); ReadLn; finally diff --git a/components/fpspreadsheet/fpsstreams.pas b/components/fpspreadsheet/fpsstreams.pas new file mode 100644 index 000000000..b796cf26d --- /dev/null +++ b/components/fpspreadsheet/fpsstreams.pas @@ -0,0 +1,199 @@ +unit fpsStreams; + +interface + +uses + SysUtils, Classes; + +const + DEFAULT_STREAM_BUFFER_SIZE = 1024; // * 1024; + +type + { A buffered stream } + TBufStream = class(TStream) + private + FFileStream: TFileStream; + FMemoryStream: TMemoryStream; + FBufWritten: Boolean; + FBufSize: Int64; + FKeepTmpFile: Boolean; + FFileName: String; + protected + procedure CreateFileStream; + function GetPosition: Int64; override; + function GetSize: Int64; override; + public + constructor Create(ATempFile: String; AKeepFile: Boolean = false; + ABufSize: Cardinal = DEFAULT_STREAM_BUFFER_SIZE); overload; + constructor Create(ABufSize: Cardinal = DEFAULT_STREAM_BUFFER_SIZE); overload; + destructor Destroy; override; + procedure FlushBuffer; + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + function Write(const ABuffer; ACount: Longint): Longint; override; + end; + +procedure ResetStream(var AStream: TStream); + +implementation + +uses + Math; + +{ Resets the stream position to the beginning of the stream. } +procedure ResetStream(var AStream: TStream); +begin + AStream.Position := 0; +end; + + +constructor TBufStream.Create(ATempFile: String; AKeepFile: Boolean = false; + ABufSize: Cardinal = DEFAULT_STREAM_BUFFER_SIZE); +begin + if ATempFile = '' then + ATempFile := ChangeFileExt(GetTempFileName, '.~abc'); + // Change extension because of naming conflict if the name of the main file + // is determined by GetTempFileName also. Happens in internaltests suite. + FFileName := ATempFile; + FKeepTmpFile := AKeepFile; + FMemoryStream := TMemoryStream.Create; + // The file stream is only created when needed because of possible conflicts + // of random file names. + FBufSize := ABufSize; +end; + +constructor TBufStream.Create(ABufSize: Cardinal = DEFAULT_STREAM_BUFFER_SIZE); +begin + Create('', false, ABufSize); +end; + +destructor TBufStream.Destroy; +begin + // Write current buffer content to file + FlushBuffer; + + // Free streams and delete temporary file, if requested + FreeAndNil(FMemoryStream); + FreeAndNil(FFileStream); + if not FKeepTmpFile and (FFileName <> '') then DeleteFile(FFileName); + + inherited Destroy; +end; + +{ Creation of the file stream is delayed because of naming conflicts of other + streams are needed with random file names as well (the files do not yet exist + when the streams are created and therefore get the same name by GetTempFileName! } +procedure TBufStream.CreateFileStream; +begin + if FFileStream = nil then begin + if FFileName = '' then FFileName := ChangeFileExt(GetTempFileName, '.~abc'); + FFileStream := TFileStream.Create(FFileName, fmCreate + fmOpenRead); + end; +end; + +{ Flushes the contents of the memory stream to file } +procedure TBufStream.FlushBuffer; +begin + if (FMemoryStream.Size > 0) and not FBufWritten then begin + FMemoryStream.Position := 0; + CreateFileStream; + FFileStream.CopyFrom(FMemoryStream, FMemoryStream.Size); + FMemoryStream.Clear; + FBufWritten := true; + end; +end; + +{ Returns the buffer position. This is the buffer position of the bytes written + to file, plus the current position in the memory buffer } +function TBufStream.GetPosition: Int64; +begin + if FFileStream = nil then + Result := FMemoryStream.Position + else + Result := FFileStream.Position + FMemoryStream.Position; +end; + +function TBufStream.GetSize: Int64; +var + n: Int64; +begin + if FFileStream <> nil then + n := FFileStream.Size + else + n := 0; + if n = 0 then n := FMemoryStream.Size; + Result := Max(n, GetPosition); +end; + +function TBufStream.Read(var Buffer; Count: Longint): Longint; +begin + // Case 1: All "Count" bytes are contained in memory stream + if FMemoryStream.Position + Count <= FMemoryStream.Size then begin + Result := FMemoryStream.Read(Buffer, Count); + exit; + end; + + // Case 2: Memory stream is empty + if FMemoryStream.Size = 0 then begin + CreateFileStream; + Result := FFileStream.Read(Buffer, Count); + exit; + end; + + // Case 3: Memory stream is not empty but contains only part of the bytes requested + FlushBuffer; + Result := FFileStream.Read(Buffer, Count); +end; + +function TBufStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +var + oldPos: Int64; + newPos: Int64; +begin + oldPos := GetPosition; + case Origin of + soBeginning : newPos := Offset; + soCurrent : newPos := oldPos + Offset; + soEnd : newPos := GetSize - Offset; + end; + + // case #1: New position is within buffer, no file stream yet + if (FFileStream = nil) and (newPos < FMemoryStream.Size) then begin + FMemoryStream.Position := newPos; + exit; + end; + + CreateFileStream; + + // case #2: New position is within buffer, file stream exists + if (newPos >= FFileStream.Position) and (newPos < FFileStream.Position + FMemoryStream.Size) + then begin + FMemoryStream.Position := newPos - FFileStream.Position; + exit; + end; + + // case #3: New position is outside buffer + FlushBuffer; + FFileStream.Position := newPos; +end; + +function TBufStream.Write(const ABuffer; ACount: LongInt): LongInt; +var + savedPos: Int64; +begin + // Case #1: Bytes fit into buffer + if FMemoryStream.Position + ACount < FBufSize then begin + Result := FMemoryStream.Write(ABuffer, ACount); + FBufWritten := false; + exit; + end; + + // Case #2: Buffer would overflow + savedPos := GetPosition; + FlushBuffer; + FFileStream.Position := savedPos; + Result := FFileStream.Write(ABuffer, ACount); +end; + + +end. diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index e91a7eef4..6125bc066 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -18,7 +18,6 @@ - - + @@ -111,6 +110,10 @@ This package is all you need if you don't want graphical components (like grids + + + + diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index 009ed7b7e..f84eb279a 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet.pas @@ -11,7 +11,7 @@ uses xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, xlscommon, - wikitable, fpsNumFormatParser, fpsfunc; + wikitable, fpsNumFormatParser, fpsfunc, fpsStreams; implementation diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index 33994e031..0b0f4e8c3 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -17,7 +17,7 @@ uses // Instead, add .. to unit search path Classes, SysUtils, fpcunit, testutils, testregistry, fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling}, - fpsutils, testsutility, md5; + fpsutils, fpsstreams, testsutility, md5; type { TSpreadReadInternalTests } @@ -35,6 +35,7 @@ type procedure SetUp; override; procedure TearDown; override; procedure TestVirtualMode(AFormat: TsSpreadsheetFormat; SaveMemoryMode: Boolean); + published // Tests getting Excel style A1 cell locations from row/column based locations. // Bug 26447 @@ -49,6 +50,8 @@ type procedure OverwriteExistingFile; // Write out date cell and try to read as UTF8; verify if contents the same procedure ReadDateAsUTF8; + // Test buffered stream + procedure TestBufStream; // Virtual mode tests for all file formats procedure TestVirtualMode_BIFF2; @@ -172,6 +175,87 @@ begin MyWorkbook.Free; end; +procedure TSpreadInternalTests.TestBufStream; +const + BUFSIZE = 1024; +var + stream: TBufStream; + readBuf, writeBuf1, writeBuf2: array of byte; + nRead, nWrite1, nWrite2: Integer; + i: Integer; +begin + stream := TBufStream.Create(BUFSIZE); + try + // Write 100 random bytes. They fit into the BUFSIZE of the memory buffer + nWrite1 := 100; + SetLength(writeBuf1, nWrite1); + for i:=0 to nWrite1-1 do writeBuf1[i] := Random(255); + stream.WriteBuffer(writeBuf1[0], nWrite1); + + // Check stream size - must be equal to nWrite + CheckEquals(nWrite1, stream.Size, 'Stream size mismatch (#1)'); + + // Check stream position must be equal to nWrite + CheckEquals(nWrite1, stream.Position, 'Stream position mismatch (#2)'); + + // Bring stream pointer back to start + stream.Position := 0; + CheckEquals(0, stream.Position, 'Stream position mismatch (#3)'); + + // Read the first 10 bytes just written and compare + nRead := 10; + SetLength(readBuf, nRead); + nRead := stream.Read(readBuf[0], nRead); + CheckEquals(10, nRead, 'Read/write size mismatch (#4)'); + for i:=0 to 9 do + CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#5)', [i])); + + // Back to start, and read the entire stream + stream.Position := 0; + nRead := stream.Size; + Setlength(readBuf, nRead); + nRead := stream.Read(readBuf[0], stream.Size); + CheckEquals(nWrite1, nRead, 'Stream read size mismatch (#6)'); + for i:=0 to nWrite1-1 do + CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#7)', [i])); + + // Now put stream pointer to end and write another 2000 bytes. This crosses + // the size of the memory buffer, and the stream must swap to file. + stream.Seek(0, soFromEnd); + CheckEquals(stream.Size, stream.Position, 'Stream position not at end (#8)'); + + nWrite2 := 2000; + SetLength(writeBuf2, nWrite2); + for i:=0 to nWrite2-1 do writeBuf2[i] := Random(255); + stream.WriteBuffer(writeBuf2[0], nWrite2); + + // The stream pointer must be at 100+2000, same for the size + CheckEquals(nWrite1+nWrite2, stream.Position, 'Stream position mismatch (#9)'); + CheckEquals(nWrite1+nWrite2, stream.Size, 'Stream size mismatch (#10)'); + + // Read the last 10 bytes and compare + Stream.Seek(10, soFromEnd); + SetLength(readBuf, 10); + Stream.ReadBuffer(readBuf[0], 10); + for i:=0 to 9 do + CheckEquals(writeBuf2[nWrite2-10+i], readBuf[i], Format('Read/write mismatch at position %d from end (#11)', [i])); + + // Now read all from beginning + Stream.Position := 0; + SetLength(readBuf, stream.Size); + nRead := Stream.Read(readBuf[0], stream.Size); + CheckEquals(nWrite1+nWrite2, nRead, 'Read/write size mismatch (#4)'); + for i:=0 to nRead-1 do + if i < nWrite1 then + CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#11)', [i])) + else + CheckEquals(writeBuf2[i-nWrite1], readBuf[i], Format('Read/write mismatch at position %d (#11)', [i])); + + finally + stream.Free; + end; +end; + procedure TSpreadInternalTests.TestCellString; var r,c: Cardinal; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 11f0b87af..06d1849a8 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -220,6 +220,9 @@ var implementation +uses + fpsStreams; + const { Excel record IDs } INT_EXCEL_ID_SST = $00FC; //BIFF8 only @@ -361,12 +364,9 @@ var Stream: TStream; OutputStorage: TOLEStorage; OLEDocument: TOLEDocument; - fn: String; begin if (woSaveMemory in Workbook.WritingOptions) then begin - fn := GetTempFileName('', 'fpsB8'); - if FileExists(fn) then DeleteFile(fn); - Stream := TFileStream.Create(fn, fmCreate + fmOpenRead) + Stream := TBufStream.Create end else Stream := TMemoryStream.Create; @@ -379,8 +379,6 @@ begin OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting, 'Workbook'); finally - if (woSaveMemory in Workbook.WritingOptions) then - DeleteFile(fn); Stream.Free; OutputStorage.Free; end; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 5c51ff4ae..1796e3daa 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -505,12 +505,12 @@ type procedure WriteSelections(AStream: TStream; ASheet: TsWorksheet); procedure WriteSheetPR(AStream: TStream); procedure WriteStringRecord(AStream: TStream; AString: String); virtual; + // Writes cell content received by workbook in OnNeedCellData event + procedure WriteVirtualCells(AStream: TStream); // Writes out a WINDOW1 record procedure WriteWindow1(AStream: TStream); virtual; // Writes the index of the XF record used in the given cell procedure WriteXFIndex(AStream: TStream; ACell: PCell); - // Writes cell content received by workbook in OnNeedCellData event - procedure WriteVirtualCells(AStream: TStream); public constructor Create(AWorkbook: TsWorkbook); override; @@ -2568,6 +2568,49 @@ begin Unused(AStream, AString); end; +procedure TsSpreadBIFFWriter.WriteVirtualCells(AStream: TStream); +var + r,c: Cardinal; + lCell: TCell; + value: variant; + styleCell: PCell; +begin + for r := 0 to Workbook.VirtualRowCount-1 do begin + for c := 0 to Workbook.VirtualColCount-1 do begin + FillChar(lCell, SizeOf(lCell), 0); + value := varNull; + styleCell := nil; + Workbook.OnNeedCellData(Workbook, r, c, value, styleCell); + if styleCell <> nil then lCell := styleCell^; + lCell.Row := r; + lCell.Col := c; + if VarIsNull(value) then + lCell.ContentType := cctEmpty + else + if VarIsNumeric(value) then begin + lCell.ContentType := cctNumber; + lCell.NumberValue := value; + end else + { + if VarIsDateTime(value) then begin + lCell.ContentType := cctNumber; + lCell.DateTimeValue := value; + end else + } + if VarIsStr(value) then begin + lCell.ContentType := cctUTF8String; + lCell.UTF8StringValue := VarToStrDef(value, ''); + end else + if VarIsBool(value) then begin + lCell.ContentType := cctBool; + lCell.BoolValue := value <> 0; + end else + lCell.ContentType := cctEmpty; + WriteCellCallback(@lCell, AStream); + end; + end; +end; + { Writes an Excel 5/8 WINDOW1 record This record contains general settings for the document window and global workbook settings. @@ -2642,48 +2685,5 @@ begin AStream.WriteWord(WordToLE(lXFIndex)); end; -procedure TsSpreadBIFFWriter.WriteVirtualCells(AStream: TStream); -var - r,c: Cardinal; - lCell: TCell; - value: variant; - styleCell: PCell; -begin - for r := 0 to Workbook.VirtualRowCount-1 do begin - for c := 0 to Workbook.VirtualColCount-1 do begin - FillChar(lCell, SizeOf(lCell), 0); - value := varNull; - styleCell := nil; - Workbook.OnNeedCellData(Workbook, r, c, value, styleCell); - if styleCell <> nil then lCell := styleCell^; - lCell.Row := r; - lCell.Col := c; - if VarIsNull(value) then - lCell.ContentType := cctEmpty - else - if VarIsNumeric(value) then begin - lCell.ContentType := cctNumber; - lCell.NumberValue := value; - end else - { - if VarIsDateTime(value) then begin - lCell.ContentType := cctNumber; - lCell.DateTimeValue := value; - end else - } - if VarIsStr(value) then begin - lCell.ContentType := cctUTF8String; - lCell.UTF8StringValue := VarToStrDef(value, ''); - end else - if VarIsBool(value) then begin - lCell.ContentType := cctBool; - lCell.BoolValue := value <> 0; - end else - lCell.ContentType := cctEmpty; - WriteCellCallback(@lCell, AStream); - end; - end; -end; - end. diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index a39fc91e6..e18eeb87b 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -115,7 +115,7 @@ type implementation uses - variants, fpsNumFormatParser, xlscommon; + variants, fpsStreams, fpsNumFormatParser, xlscommon; const { OOXML general XML constants } @@ -737,16 +737,16 @@ begin // Style records AppendToStream(FSStyles, - '', - '', + '' + + '' + '' ); WriteStyleList(FSStyles, 'cellXfs'); // Cell style records AppendToStream(FSStyles, - '', - '', + '' + + '' + ''); // Misc @@ -779,7 +779,7 @@ begin '', [SCHEMAS_WORKSHEET, i, i+2])); - AppendToStream(FSWOrkbookRels, + AppendToStream(FSWorkbookRels, ''); { --- Workbook --- } @@ -820,11 +820,10 @@ begin XML_HEADER, Format( '', [SCHEMAS_SPREADML, FSharedStringsCount, FSharedStringsCount] )); - FSSharedStrings.Position := 0; + ResetStream(FSSharedStrings); FSSharedStrings_complete.CopyFrom(FSSharedStrings, FSSharedStrings.Size); AppendToStream(FSSharedStrings_complete, ''); - FSSharedStrings_complete.Position := 0; end; { @@ -875,7 +874,6 @@ var CellPosText: string; value: Variant; styleCell: PCell; - fn: String; row: PRow; rh: String; h0: Single; @@ -885,11 +883,9 @@ begin h0 := Workbook.GetDefaultFontSize; // Point size of default font // Create the stream - if (woSaveMemory in Workbook.WritingOptions) then begin - fn := IncludeTrailingPathDelimiter(GetTempDir); - fn := GetTempFileName(fn, Format('fpsSH%d-', [FCurSheetNum+1])); - FSSheets[FCurSheetNum] := TFileStream.Create(fn, fmCreate); - end else + if (woSaveMemory in Workbook.WritingOptions) then + FSSheets[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsSH%d', [FCurSheetNum]))) + else FSSheets[FCurSheetNum] := TMemoryStream.Create; // Header @@ -1016,18 +1012,15 @@ end; { Creates the streams for the individual data files. Will be zipped into a single xlsx file. } procedure TsSpreadOOXMLWriter.CreateStreams; -var - dir: String; begin if (woSaveMemory in Workbook.WritingOptions) then begin - dir := IncludeTrailingPathDelimiter(GetTempDir); - FSContentTypes := TFileStream.Create(GetTempFileName(dir, 'fpsCT'), fmCreate+fmOpenRead); - FSRelsRels := TFileStream.Create(GetTempFileName(dir, 'fpsRR'), fmCreate+fmOpenRead); - FSWorkbookRels := TFileStream.Create(GetTempFileName(dir, 'fpsWBR'), fmCreate+fmOpenRead); - FSWorkbook := TFileStream.Create(GetTempFileName(dir, 'fpsWB'), fmCreate+fmOpenRead); - FSStyles := TFileStream.Create(GetTempFileName(dir, 'fpsSTY'), fmCreate+fmOpenRead); - FSSharedStrings := TFileStream.Create(GetTempFileName(dir, 'fpsSST'), fmCreate+fmOpenRead); - FSSharedStrings_complete := TFileStream.Create(GetTempFileName(dir, 'fpsSSTc'), fmCreate+fmOpenRead); + FSContentTypes := TBufStream.Create(GetTempFileName('', 'fpsCT')); + FSRelsRels := TBufStream.Create(GetTempFileName('', 'fpsRR')); + FSWorkbookRels := TBufStream.Create(GetTempFileName('', 'fpsWBR')); + FSWorkbook := TBufStream.Create(GetTempFileName('', 'fpsWB')); + FSStyles := TBufStream.Create(GetTempFileName('', 'fpsSTY')); + FSSharedStrings := TBufStream.Create(GetTempFileName('', 'fpsSS')); + FSSharedStrings_complete := TBufStream.Create(GetTempFileName('', 'fpsSSC')); end else begin; FSContentTypes := TMemoryStream.Create; FSRelsRels := TMemoryStream.Create; @@ -1072,7 +1065,17 @@ end; procedure TsSpreadOOXMLWriter.ResetStreams; var stream: TStream; + i: Integer; begin + ResetStream(FSContentTypes); + ResetStream(FSRelsRels); + ResetStream(FSWorkbookRels); + ResetStream(FSWorkbook); + ResetStream(FSStyles); + ResetStream(FSSharedStrings_complete); + for i := 0 to High(FSSheets) do + ResetStream(FSSheets[i]); + { FSContentTypes.Position := 0; FSRelsRels.Position := 0; FSWorkbookRels.Position := 0; @@ -1080,6 +1083,7 @@ begin FSStyles.Position := 0; FSSharedStrings_complete.Position := 0; for stream in FSSheets do stream.Position := 0; + } end; { @@ -1135,9 +1139,13 @@ begin WriteGlobalFiles; WriteContent; + // Stream position must be at beginning, it was moved to end during adding of xml strings. + ResetStreams; + { Now compress the files } FZip := TZipper.Create; try + FZip.FileName := '__temp__.tmp'; FZip.Entries.AddFileEntry(FSContentTypes, OOXML_PATH_TYPES); FZip.Entries.AddFileEntry(FSRelsRels, OOXML_PATH_RELS_RELS); FZip.Entries.AddFileEntry(FSWorkbookRels, OOXML_PATH_XL_RELS_RELS); @@ -1150,9 +1158,6 @@ begin FZip.Entries.AddFileEntry(FSSheets[i], OOXML_PATH_XL_WORKSHEETS + 'sheet' + IntToStr(i + 1) + '.xml'); end; - // Stream position must be at beginning, it was moved to end during adding of xml strings. - ResetStreams; - FZip.SaveToStream(AStream); finally