diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpi b/components/fpspreadsheet/examples/excel5demo/excel5write.lpi
index 96adb0ca9..9ef7a1dfe 100644
--- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpi
+++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpi
@@ -33,13 +33,13 @@
-
+
-
-
+
+
@@ -68,8 +68,8 @@
-
-
+
+
@@ -86,9 +86,9 @@
-
-
-
+
+
+
@@ -97,7 +97,7 @@
-
+
@@ -116,8 +116,8 @@
-
-
+
+
@@ -128,108 +128,146 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr
index accb4d33f..df379ecc6 100644
--- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr
+++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr
@@ -15,10 +15,9 @@ uses
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
- MyFormula: TRPNFormula;
+ MyFormula: TsFormula;
MyDir: string;
i: Integer;
- a: TStringList;
begin
// Open the output file
MyDir := ExtractFilePath(ParamStr(0));
@@ -44,16 +43,8 @@ begin
}
// Write the formula E1 = A1 + B1
- // or, in RPN: A1, B1, +
- SetLength(MyFormula, 3);
- MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; {A1}
- MyFormula[0].Col := 0;
- MyFormula[0].Row := 0;
- MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; {B1}
- MyFormula[1].Col := 1;
- MyFormula[1].Row := 0;
- MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; {+}
- MyWorksheet.WriteRPNFormula(0, 4, MyFormula);
+// MyFormula.FormulaStr := '';
+// MyWorksheet.WriteFormula(0, 4, MyFormula);
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');
diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi
index 977c26743..ff2ab33cd 100644
--- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi
+++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi
@@ -11,7 +11,7 @@
-
+
@@ -38,8 +38,8 @@
-
-
+
+
@@ -131,8 +131,8 @@
-
-
+
+
@@ -140,8 +140,8 @@
-
-
+
+
@@ -150,123 +150,123 @@
-
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
index 7e4d67dec..a05dfc6e2 100644
--- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
+++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr
@@ -43,18 +43,6 @@ begin
end;
}
- // Write the formula E1 = A1 + B1
- // or, in RPN: A1, B1, +
- SetLength(MyFormula, 3);
- MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; {A1}
- MyFormula[0].Col := 0;
- MyFormula[0].Row := 0;
- MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; {B1}
- MyFormula[1].Col := 1;
- MyFormula[1].Row := 0;
- MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; {+}
- MyWorksheet.WriteRPNFormula(0, 4, MyFormula);
-
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');
@@ -65,7 +53,7 @@ begin
MyWorksheet.WriteUTF8Text(0, 3, 'Fourth');
// Save the spreadsheet to a file
- MyWorkbook.WriteToFile(MyDir + 'test' + STR_OOXML_EXCEL_EXTENSION, sfOOXML);
+ MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML);
MyWorkbook.Free;
end.
diff --git a/components/fpspreadsheet/examples/opendocdemo/oocreated.ods b/components/fpspreadsheet/examples/opendocdemo/oocreated.ods
index bfe2e21bd..920846270 100644
Binary files a/components/fpspreadsheet/examples/opendocdemo/oocreated.ods and b/components/fpspreadsheet/examples/opendocdemo/oocreated.ods differ
diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi
index 02464e3f1..b22b7046f 100644
--- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi
+++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi
@@ -11,7 +11,7 @@
-
+
@@ -33,13 +33,13 @@
-
+
-
-
+
+
@@ -116,10 +116,10 @@
-
-
-
-
+
+
+
+
@@ -131,28 +131,26 @@
-
-
+
+
-
+
-
-
-
-
+
+
+
+
-
+
-
-
-
+
@@ -160,127 +158,159 @@
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
index 16fa55b95..180420f77 100644
--- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
+++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr
@@ -10,17 +10,14 @@ program opendocwrite;
{$mode delphi}{$H+}
uses
- Classes, SysUtils, fpspreadsheet, fpsallformats, laz_fpspreadsheet;
+ Classes, SysUtils, fpspreadsheet, fpsallformats,
+ laz_fpspreadsheet;
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
- MyFormula: TRPNFormula;
MyDir: string;
- i: Integer;
- a: TStringList;
begin
- // Open the output file
MyDir := ExtractFilePath(ParamStr(0));
// Create the spreadsheet
@@ -33,38 +30,16 @@ begin
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);
-{ Uncommend this to test large XLS files
- for i := 2 to 20 do
- begin
- MyWorksheet.WriteAnsiText(i, 0, ParamStr(0));
- MyWorksheet.WriteAnsiText(i, 1, ParamStr(0));
- MyWorksheet.WriteAnsiText(i, 2, ParamStr(0));
- MyWorksheet.WriteAnsiText(i, 3, ParamStr(0));
- end;
-}
-
- // Write the formula E1 = A1 + B1
- // or, in RPN: A1, B1, +
-(* SetLength(MyFormula, 3);
- MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; {A1}
- MyFormula[0].Col := 0;
- MyFormula[0].Row := 0;
- MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; {B1}
- MyFormula[1].Col := 1;
- MyFormula[1].Row := 0;
- MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; {+}
- MyWorksheet.WriteRPNFormula(0, 4, MyFormula);
-
- // Creates a new worksheet
- MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');
- *)
-
// Write some string cells
MyWorksheet.WriteUTF8Text(4, 2, 'Total:');
MyWorksheet.WriteNumber(4, 3, 10.0);
+ // Creates a new worksheet
+ MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2');
+
// Save the spreadsheet to a file
- MyWorkbook.WriteToFile(MyDir + 'test', sfOpenDocument);
+ MyWorkbook.WriteToFile(MyDir + 'test.ods',
+ sfOpenDocument);
MyWorkbook.Free;
end.
diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas
index 0a9eea3f2..7c2e28cc6 100755
--- a/components/fpspreadsheet/fpsopendocument.pas
+++ b/components/fpspreadsheet/fpsopendocument.pas
@@ -10,8 +10,7 @@ meta.xml - Authoring data
settings.xml - User persistent viewing information, such as zoom, cursor position, etc.
styles.xml - Styles, which are the only way to do formatting
mimetype - application/vnd.oasis.opendocument.spreadsheet
-META-INF
- manifest.xml -
+META-INF\manifest.xml - Describes the other files in the archive
Specifications obtained from:
@@ -28,7 +27,8 @@ unit fpsopendocument;
interface
uses
- Classes, SysUtils, zipper,
+ Classes, SysUtils,
+ fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released }
fpspreadsheet;
type
@@ -37,25 +37,23 @@ type
TsSpreadOpenDocWriter = class(TsCustomSpreadWriter)
protected
- FZip: TZipper;
// Strings with the contents of files
- // filename\
- FMeta, FSettings, FStyles: string;
- FContent: string;
- FMimetype: string;
- // filename\META-INF
+ FMeta, FSettings, FStyles, FContent, FMimetype: string;
FMetaInfManifest: string;
+ // Streams with the contents of files
+ FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream;
+ FSMetaInfManifest: TStringStream;
// Routines to write those files
procedure WriteGlobalFiles;
procedure WriteContent(AData: TsWorkbook);
procedure WriteWorksheet(CurSheet: TsWorksheet);
public
{ General writing methods }
- procedure WriteStringToFile(AFileName, AString: string);
+ procedure WriteStringToFile(AString, AFileName: string);
procedure WriteToFile(AFileName: string; AData: TsWorkbook); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
{ Record writing methods }
- procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override;
+ procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
end;
@@ -67,11 +65,11 @@ const
XML_HEADER = '';
{ OpenDocument Directory structure constants }
- OOXML_PATH_CONTENT = 'content.xml';
- OOXML_PATH_META = 'meta.xml';
- OOXML_PATH_SETTINGS = 'settings.xml';
- OOXML_PATH_STYLES = 'styles.xml';
- OOXML_PATH_MIMETYPE = 'mimetype';
+ OPENDOC_PATH_CONTENT = 'content.xml';
+ OPENDOC_PATH_META = 'meta.xml';
+ OPENDOC_PATH_SETTINGS = 'settings.xml';
+ OPENDOC_PATH_STYLES = 'styles.xml';
+ OPENDOC_PATH_MIMETYPE = 'mimetype';
OPENDOC_PATH_METAINF = 'META-INF' + PathDelim;
OPENDOC_PATH_METAINF_MANIFEST = 'META-INF' + PathDelim + 'manifest.xml';
@@ -246,6 +244,7 @@ begin
' ' + LineEnding +
' ' + LineEnding;
+ // Write all worksheets
for i := 0 to AData.GetWorksheetCount - 1 do
begin
WriteWorksheet(Adata.GetWorksheetByIndex(i));
@@ -312,13 +311,10 @@ begin
' ' + LineEnding;
end;
-{*******************************************************************
-* TsSpreadOOXMLWriter.WriteStringToFile ()
-*
-* DESCRIPTION: Writes a string to a file. Helper convenience method.
-*
-*******************************************************************}
-procedure TsSpreadOpenDocWriter.WriteStringToFile(AFileName, AString: string);
+{
+ Writes a string to a file. Helper convenience method.
+}
+procedure TsSpreadOpenDocWriter.WriteStringToFile(AString, AFileName: string);
var
TheStream : TFileStream;
S : String;
@@ -329,57 +325,70 @@ begin
TheStream.Free;
end;
-{*******************************************************************
-* TsSpreadOOXMLWriter.WriteToFile ()
-*
-* DESCRIPTION: Writes an OOXML document to the disc
-*
-*******************************************************************}
+{
+ Writes an OOXML document to the disc.
+}
procedure TsSpreadOpenDocWriter.WriteToFile(AFileName: string; AData: TsWorkbook);
var
- TempDir: string;
+ FZip: TZipper;
begin
- {FZip := TZipper.Create;
- FZip.ZipFiles(AFileName, x);
- FZip.Free;}
-
-// WriteToStream(nil, AData);
+ { Fill the strings with the contents of the files }
WriteGlobalFiles();
WriteContent(AData);
- TempDir := IncludeTrailingBackslash(AFileName);
+ { Write the data to streams }
- { files on the root path }
+ FSMeta := TStringStream.Create(FMeta);
+ FSSettings := TStringStream.Create(FSettings);
+ FSStyles := TStringStream.Create(FStyles);
+ FSContent := TStringStream.Create(FContent);
+ FSMimetype := TStringStream.Create(FMimetype);
+ FSMetaInfManifest := TStringStream.Create(FMetaInfManifest);
- ForceDirectories(TempDir);
+ { Now compress the files }
- WriteStringToFile(TempDir + OOXML_PATH_CONTENT, FContent);
-
- WriteStringToFile(TempDir + OOXML_PATH_META, FMeta);
+ FZip := TZipper.Create;
+ try
+ FZip.FileName := AFileName;
- WriteStringToFile(TempDir + OOXML_PATH_SETTINGS, FSettings);
+ FZip.Entries.AddFileEntry(FSMeta, OPENDOC_PATH_META);
+ FZip.Entries.AddFileEntry(FSSettings, OPENDOC_PATH_SETTINGS);
+ FZip.Entries.AddFileEntry(FSStyles, OPENDOC_PATH_STYLES);
+ FZip.Entries.AddFileEntry(FSContent, OPENDOC_PATH_CONTENT);
+ FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE);
+ FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST);
- WriteStringToFile(TempDir + OOXML_PATH_STYLES, FStyles);
-
- WriteStringToFile(TempDir + OOXML_PATH_MIMETYPE, FMimetype);
-
- { META-INF directory }
-
- ForceDirectories(TempDir + OPENDOC_PATH_METAINF);
-
- WriteStringToFile(TempDir + OPENDOC_PATH_METAINF_MANIFEST, FMetaInfManifest);
+ FZip.ZipAllFiles;
+ finally
+ FZip.Free;
+ FSMeta.Free;
+ FSSettings.Free;
+ FSStyles.Free;
+ FSContent.Free;
+ FSMimetype.Free;
+ FSMetaInfManifest.Free;
+ end;
end;
+
procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
begin
-
+ // Not supported at the moment
+ raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported');
end;
procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
- ACol: Word; const AFormula: TRPNFormula);
+ ACol: Word; const AFormula: TsFormula);
begin
-
+{ // The row should already be the correct one
+ FContent := FContent +
+ ' ' + LineEnding +
+ ' ' + AFormula.DoubleValue + '' + LineEnding +
+ ' ' + LineEnding;
+
+1833
+}
end;
procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow,
@@ -402,12 +411,9 @@ begin
' ' + LineEnding;
end;
-{*******************************************************************
-* Initialization section
-*
-* Registers this reader / writer on fpSpreadsheet
-*
-*******************************************************************}
+{
+ Registers this reader / writer on fpSpreadsheet
+}
initialization
RegisterSpreadFormat(TsCustomSpreadReader, TsSpreadOpenDocWriter, sfOpenDocument);
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 242595a3e..c46d7d0c9 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -26,38 +26,35 @@ const
STR_OOXML_EXCEL_EXTENSION = '.xlsx';
STR_OPENDOCUMENT_CALC_EXTENSION = '.ods';
-const
- { TokenID values }
-
- { Binary Operator Tokens }
- INT_EXCEL_TOKEN_TADD = $03;
- INT_EXCEL_TOKEN_TSUB = $04;
- INT_EXCEL_TOKEN_TMUL = $05;
- INT_EXCEL_TOKEN_TDIV = $06;
- INT_EXCEL_TOKEN_TPOWER = $07;
-
- { Constant Operand Tokens }
- INT_EXCEL_TOKEN_TNUM = $1F;
-
- { Operand Tokens }
- INT_EXCEL_TOKEN_TREFR = $24;
- INT_EXCEL_TOKEN_TREFV = $44;
- INT_EXCEL_TOKEN_TREFA = $64;
-
type
- {@@ A Token of a RPN Token array for formulas }
+ {@@ Describes a formula
- TRPNToken = record
- TokenID: Byte;
- Col: Byte;
- Row: Word;
+ Supported syntax:
+
+ =A1+B1+C1/D2... - Array with simple mathematical operations
+
+ =SUM(A1:D1) - SUM operation in a interval
+ }
+
+ TsFormula = record
+ FormulaStr: string;
DoubleValue: double;
end;
- {@@ RPN Token array for formulas }
+ {@@ Expanded formula. Used by backend modules. Provides more information then the text only }
- TRPNFormula = array of TRPNToken;
+ TFEKind = (fekCell, fekAdd, fekSub, fekDiv, fekMul,
+ fekOpSUM);
+
+ TsFormulaElement = record
+ ElementKind: TFEKind;
+ Row1, Row2: Word;
+ Col1, Col2: Byte;
+ DoubleValue: double;
+ end;
+
+ TsExpandedFormula = array of TsFormulaElement;
{@@ Describes the type of content of a cell on a TsWorksheet }
@@ -69,7 +66,7 @@ type
Col: Byte;
Row: Word;
ContentType: TCellContentType;
- FormulaValue: TRPNFormula;
+ FormulaValue: TsFormula;
NumberValue: double;
UTF8StringValue: ansistring;
end;
@@ -81,8 +78,6 @@ type
TsCustomSpreadReader = class;
TsCustomSpreadWriter = class;
- {@@ TsWorksheet }
-
{ TsWorksheet }
TsWorksheet = class
@@ -105,11 +100,9 @@ type
procedure RemoveAllCells;
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double);
- procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TRPNFormula);
+ procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
end;
- {@@ TsWorkbook }
-
{ TsWorkbook }
TsWorkbook = class
@@ -140,8 +133,6 @@ type
TsSpreadReaderClass = class of TsCustomSpreadReader;
- {@@ TsCustomSpreadReader }
-
{ TsCustomSpreadReader }
TsCustomSpreadReader = class
@@ -162,19 +153,19 @@ type
TsSpreadWriterClass = class of TsCustomSpreadWriter;
- {@@ TsCustomSpreadWriter }
-
{ TsCustomSpreadWriter }
TsCustomSpreadWriter = class
public
+ { Helper routines }
+ function ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
{ General writing methods }
procedure WriteCellCallback(data, arg: pointer);
procedure WriteCellsToStream(AStream: TStream; ACells: TFPList);
procedure WriteToFile(AFileName: string; AData: TsWorkbook); virtual;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual;
{ Record writing methods }
- procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); virtual; abstract;
+ procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); virtual; abstract;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); virtual; abstract;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); virtual; abstract;
end;
@@ -494,9 +485,9 @@ end;
@param ARow The row of the cell
@param ACol The column of the cell
- @param AFormula The formula in RPN array format
+ @param AFormula The formula to be written
}
-procedure TsWorksheet.WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TRPNFormula);
+procedure TsWorksheet.WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
var
ACell: PCell;
begin
@@ -758,6 +749,50 @@ end;
{ TsCustomSpreadWriter }
+{@@
+ Expands a formula, separating it in it's constituent parts,
+ so that it is already partially parsed and it is easier to
+ convert it into the format supported by the writer module
+}
+function TsCustomSpreadWriter.ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
+var
+ StrPos: Integer;
+ ResPos: Integer;
+begin
+ ResPos := -1;
+ SetLength(Result, 0);
+
+ // The formula needs to start with a =
+ if AFormula.FormulaStr[1] <> '=' then raise Exception.Create('Formula doesn''t start with =');
+
+ StrPos := 2;
+
+ while Length(AFormula.FormulaStr) <= StrPos do
+ begin
+ // Checks for cell with the format [Letter][Number]
+{ if (AFormula.FormulaStr[StrPos] in [a..zA..Z]) and
+ (AFormula.FormulaStr[StrPos + 1] in [0..9]) then
+ begin
+ Inc(ResPos);
+ SetLength(Result, ResPos + 1);
+ Result[ResPos].ElementKind := fekCell;
+// Result[ResPos].Col1 := fekCell;
+ Result[ResPos].Row1 := AFormula.FormulaStr[StrPos + 1];
+
+ Inc(StrPos);
+ end
+ // Checks for arithmetical operations
+ else} if AFormula.FormulaStr[StrPos] = '+' then
+ begin
+ Inc(ResPos);
+ SetLength(Result, ResPos + 1);
+ Result[ResPos].ElementKind := fekAdd;
+ end;
+
+ Inc(StrPos);
+ end;
+end;
+
{@@
Helper function for the spreadsheet writers.
diff --git a/components/fpspreadsheet/fpszipper.pp b/components/fpspreadsheet/fpszipper.pp
new file mode 100644
index 000000000..2a6b8a824
--- /dev/null
+++ b/components/fpspreadsheet/fpszipper.pp
@@ -0,0 +1,1687 @@
+{
+ $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ Copy from the zipper unit from FPC 2.3.1 rev 12624
+
+ Remove it after a new FPC with the fixes from this unit is released!
+}
+{$mode objfpc}
+{$h+}
+unit fpszipper;
+
+Interface
+
+Uses
+ SysUtils,Classes,ZStream;
+
+
+Const
+ { Signatures }
+ END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
+ LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
+ CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
+
+Type
+ Local_File_Header_Type = Packed Record
+ Signature : LongInt;
+ Extract_Version_Reqd : Word;
+ Bit_Flag : Word;
+ Compress_Method : Word;
+ Last_Mod_Time : Word;
+ Last_Mod_Date : Word;
+ Crc32 : LongWord;
+ Compressed_Size : LongInt;
+ Uncompressed_Size : LongInt;
+ Filename_Length : Word;
+ Extra_Field_Length : Word;
+ end;
+
+ { Define the Central Directory record types }
+
+ Central_File_Header_Type = Packed Record
+ Signature : LongInt;
+ MadeBy_Version : Word;
+ Extract_Version_Reqd : Word;
+ Bit_Flag : Word;
+ Compress_Method : Word;
+ Last_Mod_Time : Word;
+ Last_Mod_Date : Word;
+ Crc32 : LongWord;
+ Compressed_Size : LongInt;
+ Uncompressed_Size : LongInt;
+ Filename_Length : Word;
+ Extra_Field_Length : Word;
+ File_Comment_Length : Word;
+ Starting_Disk_Num : Word;
+ Internal_Attributes : Word;
+ External_Attributes : LongInt;
+ Local_Header_Offset : LongInt;
+ End;
+
+ End_of_Central_Dir_Type = Packed Record
+ Signature : LongInt;
+ Disk_Number : Word;
+ Central_Dir_Start_Disk : Word;
+ Entries_This_Disk : Word;
+ Total_Entries : Word;
+ Central_Dir_Size : LongInt;
+ Start_Disk_Offset : LongInt;
+ ZipFile_Comment_Length : Word;
+ end;
+
+Const
+ Crc_32_Tab : Array[0..255] of LongWord = (
+ $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
+ $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
+ $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
+ $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
+ $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
+ $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
+ $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
+ $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
+ $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
+ $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
+ $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
+ $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
+ $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
+ $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
+ $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
+ $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
+ $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
+ $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
+ $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
+ $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
+ $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
+ $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
+ $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
+ $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
+ $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
+ $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
+ $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
+ $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
+ $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
+ $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
+ $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
+ $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
+ );
+
+Type
+
+ TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
+ TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object;
+ TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object;
+
+Type
+
+ { TCompressor }
+ TCompressor = Class(TObject)
+ Protected
+ FInFile : TStream; { I/O file variables }
+ FOutFile : TStream;
+ FCrc32Val : LongWord; { CRC calculation variable }
+ FBufferSize : LongWord;
+ FOnPercent : Integer;
+ FOnProgress : TProgressEvent;
+ Procedure UpdC32(Octet: Byte);
+ Public
+ Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
+ Procedure Compress; Virtual; Abstract;
+ Class Function ZipID : Word; virtual; Abstract;
+ Property BufferSize : LongWord read FBufferSize;
+ Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+ Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+ Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
+ end;
+
+ { TDeCompressor }
+ TDeCompressor = Class(TObject)
+ Protected
+ FInFile : TStream; { I/O file variables }
+ FOutFile : TStream;
+ FCrc32Val : LongWord; { CRC calculation variable }
+ FBufferSize : LongWord;
+ FOnPercent : Integer;
+ FOnProgress : TProgressEvent;
+ Procedure UpdC32(Octet: Byte);
+ Public
+ Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
+ Procedure DeCompress; Virtual; Abstract;
+ Class Function ZipID : Word; virtual; Abstract;
+ Property BufferSize : LongWord read FBufferSize;
+ Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+ Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+ Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
+ end;
+
+ { TShrinker }
+
+Const
+ TABLESIZE = 8191;
+ FIRSTENTRY = 257;
+
+Type
+ CodeRec = Packed Record
+ Child : Smallint;
+ Sibling : Smallint;
+ Suffix : Byte;
+ end;
+ CodeArray = Array[0..TABLESIZE] of CodeRec;
+ TablePtr = ^CodeArray;
+
+ FreeListPtr = ^FreeListArray;
+ FreeListArray = Array[FIRSTENTRY..TABLESIZE] of Word;
+
+ BufPtr = PByte;
+
+ TShrinker = Class(TCompressor)
+ Private
+ FBufSize : LongWord;
+ MaxInBufIdx : LongWord; { Count of valid chars in input buffer }
+ InputEof : Boolean; { End of file indicator }
+ CodeTable : TablePtr; { Points to code table for LZW compression }
+ FreeList : FreeListPtr; { Table of free code table entries }
+ NextFree : Word; { Index into free list table }
+
+ ClearList : Array[0..1023] of Byte; { Bit mapped structure used in }
+ { during adaptive resets }
+ CodeSize : Byte; { Size of codes (in bits) currently being written }
+ MaxCode : Word; { Largest code that can be written in CodeSize bits }
+ InBufIdx, { Points to next char in buffer to be read }
+ OutBufIdx : LongWord; { Points to next free space in output buffer }
+ InBuf, { I/O buffers }
+ OutBuf : BufPtr;
+ FirstCh : Boolean; { Flag indicating the START of a shrink operation }
+ TableFull : Boolean; { Flag indicating a full symbol table }
+ SaveByte : Byte; { Output code buffer }
+ BitsUsed : Byte; { Index into output code buffer }
+ BytesIn : LongInt; { Count of input file bytes processed }
+ BytesOut : LongInt; { Count of output bytes }
+ FOnBytes : Longint;
+ Procedure FillInputBuffer;
+ Procedure WriteOutputBuffer;
+ Procedure FlushOutput;
+ Procedure PutChar(B : Byte);
+ procedure PutCode(Code : Smallint);
+ Procedure InitializeCodeTable;
+ Procedure Prune(Parent : Word);
+ Procedure Clear_Table;
+ Procedure Table_Add(Prefix : Word; Suffix : Byte);
+ function Table_Lookup(TargetPrefix : Smallint;
+ TargetSuffix : Byte;
+ Out FoundAt : Smallint) : Boolean;
+ Procedure Shrink(Suffix : Smallint);
+ Procedure ProcessLine(Const Source : String);
+ Procedure DoOnProgress(Const Pct : Double); Virtual;
+ Public
+ Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); override;
+ Destructor Destroy; override;
+ Procedure Compress; override;
+ Class Function ZipID : Word; override;
+ end;
+
+ { TDeflater }
+
+ TDeflater = Class(TCompressor)
+ private
+ FCompressionLevel: TCompressionlevel;
+ Public
+ Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
+ Procedure Compress; override;
+ Class Function ZipID : Word; override;
+ Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
+ end;
+
+ { TInflater }
+
+ TInflater = Class(TDeCompressor)
+ Public
+ Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
+ Procedure DeCompress; override;
+ Class Function ZipID : Word; override;
+ end;
+
+ { TZipFileEntry }
+
+ TZipFileEntry = Class(TCollectionItem)
+ private
+ FArchiveFileName: String;
+ FDateTime: TDateTime;
+ FDiskFileName: String;
+ FHeaderPos: Longint;
+ FSize: Integer;
+ FStream: TStream;
+ function GetArchiveFileName: String;
+ Protected
+ Property HdrPos : Longint Read FHeaderPos Write FheaderPos;
+ Public
+ Procedure Assign(Source : TPersistent); override;
+ Property Stream : TStream Read FStream Write FStream;
+ Published
+ Property ArchiveFileName : String Read GetArchiveFileName Write FArchiveFileName;
+ Property DiskFileName : String Read FDiskFileName Write FDiskFileName;
+ Property Size : Integer Read FSize Write FSize;
+ Property DateTime : TDateTime Read FDateTime Write FDateTime;
+ end;
+
+ { TZipFileEntries }
+
+ TZipFileEntries = Class(TCollection)
+ private
+ function GetZ(AIndex : Integer): TZipFileEntry;
+ procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry);
+ Public
+ Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry;
+ Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry;
+ Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry;
+ Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default;
+ end;
+
+
+ { TZipper }
+
+ TZipper = Class(TObject)
+ Private
+ FEntries: TZipFileEntries;
+ FZipping : Boolean;
+ FBufSize : LongWord;
+ FFileName : String; { Name of resulting Zip file }
+ FFiles : TStrings;
+ FInMemSize : Integer;
+ FOutFile : TFileStream;
+ FInFile : TStream; { I/O file variables }
+ LocalHdr : Local_File_Header_Type;
+ CentralHdr : Central_File_Header_Type;
+ EndHdr : End_of_Central_Dir_Type;
+ FOnPercent : LongInt;
+ FOnProgress : TProgressEvent;
+ FOnEndOfFile : TOnEndOfFileEvent;
+ FOnStartFile : TOnStartFileEvent;
+ function CheckEntries: Integer;
+ procedure SetEntries(const AValue: TZipFileEntries);
+ Protected
+ Procedure OpenOutput;
+ Procedure CloseOutput;
+ Procedure CloseInput(Item : TZipFileEntry);
+ Procedure StartZipFile(Item : TZipFileEntry);
+ Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word) : Boolean;
+ Procedure BuildZipDirectory;
+ Procedure DoEndOfFile;
+ Procedure ZipOneFile(Item : TZipFileEntry); virtual;
+ Function OpenInput(Item : TZipFileEntry) : Boolean;
+ Procedure GetFileInfo;
+ Procedure SetBufSize(Value : LongWord);
+ Procedure SetFileName(Value : String);
+ Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual;
+ Public
+ Constructor Create;
+ Destructor Destroy;override;
+ Procedure ZipAllFiles; virtual;
+ Procedure ZipFiles(AFileName : String; FileList : TStrings);
+ Procedure ZipFiles(AFileName : String; Entries : TZipFileEntries);
+ Procedure Clear;
+ Public
+ Property BufferSize : LongWord Read FBufSize Write SetBufSize;
+ Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+ Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+ Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
+ Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
+ Property FileName : String Read FFileName Write SetFileName;
+ Property Files : TStrings Read FFiles;
+ Property InMemSize : Integer Read FInMemSize Write FInMemSize;
+ Property Entries : TZipFileEntries Read FEntries Write SetEntries;
+ end;
+
+ { TYbZipper }
+
+ { TUnZipper }
+
+ TUnZipper = Class(TObject)
+ Private
+ FUnZipping : Boolean;
+ FBufSize : LongWord;
+ FFileName : String; { Name of resulting Zip file }
+ FOutputPath : String;
+ FEntries : TZipFileEntries;
+ FFiles : TStrings;
+ FOutFile : TFileStream;
+ FZipFile : TFileStream; { I/O file variables }
+ LocalHdr : Local_File_Header_Type;
+ CentralHdr : Central_File_Header_Type;
+ EndHdr : End_of_Central_Dir_Type;
+
+ FOnPercent : LongInt;
+ FOnProgress : TProgressEvent;
+ FOnEndOfFile : TOnEndOfFileEvent;
+ FOnStartFile : TOnStartFileEvent;
+ Protected
+ Procedure OpenInput;
+ Procedure CloseOutput;
+ Procedure CloseInput;
+ Procedure ReadZipHeader(Item : TZipFileEntry; out ACRC : LongWord;out AMethod : Word);
+ Procedure ReadZipDirectory;
+ Procedure DoEndOfFile;
+ Procedure UnZipOneFile(Item : TZipFileEntry); virtual;
+ Function OpenOutput(OutFileName : String) : Boolean;
+ Procedure SetBufSize(Value : LongWord);
+ Procedure SetFileName(Value : String);
+ Procedure SetOutputPath(Value:String);
+ Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual;
+ Public
+ Constructor Create;
+ Destructor Destroy;override;
+ Procedure UnZipAllFiles; virtual;
+ Procedure UnZipFiles(AFileName : String; FileList : TStrings);
+ Procedure UnZipAllFiles(AFileName : String);
+ Procedure Clear;
+ Public
+ Property BufferSize : LongWord Read FBufSize Write SetBufSize;
+ Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+ Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+ Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
+ Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
+ Property FileName : String Read FFileName Write SetFileName;
+ Property OutputPath : String Read FOutputPath Write SetOutputPath;
+ Property Files : TStrings Read FFiles;
+ Property Entries : TZipFileEntries Read FEntries Write FEntries;
+ end;
+
+ EZipError = Class(Exception);
+
+Implementation
+
+ResourceString
+ SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping';
+ SErrFileChange = 'Changing output file name is not allowed while (un)zipping';
+ SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s';
+ SErrCorruptZIP = 'Corrupt ZIP file %s';
+ SErrUnsupportedCompressionFormat = 'Unsupported compression format %d';
+ SErrMissingFileName = 'Missing filename in entry %d';
+ SErrMissingArchiveName = 'Missing archive filename in streamed entry %d';
+ SErrFileDoesNotExist = 'File "%s" does not exist.';
+
+{ ---------------------------------------------------------------------
+ Auxiliary
+ ---------------------------------------------------------------------}
+
+{$IFDEF FPC_BIG_ENDIAN}
+function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type;
+begin
+ with Values do
+ begin
+ Result.Signature := SwapEndian(Signature);
+ Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
+ Result.Bit_Flag := SwapEndian(Bit_Flag);
+ Result.Compress_Method := SwapEndian(Compress_Method);
+ Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
+ Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
+ Result.Crc32 := SwapEndian(Crc32);
+ Result.Compressed_Size := SwapEndian(Compressed_Size);
+ Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
+ Result.Filename_Length := SwapEndian(Filename_Length);
+ Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
+ end;
+end;
+
+function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type;
+begin
+ with Values do
+ begin
+ Result.Signature := SwapEndian(Signature);
+ Result.MadeBy_Version := SwapEndian(MadeBy_Version);
+ Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
+ Result.Bit_Flag := SwapEndian(Bit_Flag);
+ Result.Compress_Method := SwapEndian(Compress_Method);
+ Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
+ Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
+ Result.Crc32 := SwapEndian(Crc32);
+ Result.Compressed_Size := SwapEndian(Compressed_Size);
+ Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
+ Result.Filename_Length := SwapEndian(Filename_Length);
+ Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
+ Result.File_Comment_Length := SwapEndian(File_Comment_Length);
+ Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num);
+ Result.Internal_Attributes := SwapEndian(Internal_Attributes);
+ Result.External_Attributes := SwapEndian(External_Attributes);
+ Result.Local_Header_Offset := SwapEndian(Local_Header_Offset);
+ end;
+end;
+
+function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type;
+begin
+ with Values do
+ begin
+ Result.Signature := SwapEndian(Signature);
+ Result.Disk_Number := SwapEndian(Disk_Number);
+ Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
+ Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
+ Result.Total_Entries := SwapEndian(Total_Entries);
+ Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
+ Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
+ Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length);
+ end;
+end;
+{$ENDIF FPC_BIG_ENDIAN}
+
+Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word);
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ DecodeDate(DT,Y,M,D);
+ DecodeTime(DT,H,N,S,MS);
+ Y:=Y-1980;
+ ZD:=d+(32*M)+(512*Y);
+ ZT:=(S div 2)+(32*N)+(2048*h);
+end;
+
+Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ MS:=0;
+ S:=(ZT and 31) shl 1;
+ N:=(ZT shr 5) and 63;
+ H:=(ZT shr 12) and 31;
+ D:=ZD and 31;
+ M:=(ZD shr 5) and 15;
+ Y:=((ZD shr 9) and 127)+1980;
+ DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
+end;
+
+{ ---------------------------------------------------------------------
+ TDeCompressor
+ ---------------------------------------------------------------------}
+
+
+Procedure TDeCompressor.UpdC32(Octet: Byte);
+
+Begin
+ FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
+end;
+
+constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+ FinFile:=AInFile;
+ FoutFile:=AOutFile;
+ FBufferSize:=ABufSize;
+ CRC32Val:=$FFFFFFFF;
+end;
+
+
+{ ---------------------------------------------------------------------
+ TCompressor
+ ---------------------------------------------------------------------}
+
+
+Procedure TCompressor.UpdC32(Octet: Byte);
+
+Begin
+ FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
+end;
+
+constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+ FinFile:=AInFile;
+ FoutFile:=AOutFile;
+ FBufferSize:=ABufSize;
+ CRC32Val:=$FFFFFFFF;
+end;
+
+
+{ ---------------------------------------------------------------------
+ TDeflater
+ ---------------------------------------------------------------------}
+
+constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+ Inherited;
+ FCompressionLevel:=clDefault;
+end;
+
+
+procedure TDeflater.Compress;
+
+Var
+ Buf : PByte;
+ I,Count,NewCount : Integer;
+ C : TCompressionStream;
+
+begin
+ CRC32Val:=$FFFFFFFF;
+ Buf:=GetMem(FBufferSize);
+ Try
+ C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True);
+ Try
+ Repeat
+ Count:=FInFile.Read(Buf^,FBufferSize);
+ For I:=0 to Count-1 do
+ UpdC32(Buf[i]);
+ NewCount:=Count;
+ While (NewCount>0) do
+ NewCount:=NewCount-C.Write(Buf^,NewCount);
+ Until (Count=0);
+ Finally
+ C.Free;
+ end;
+ Finally
+ FreeMem(Buf);
+ end;
+ Crc32Val:=NOT Crc32Val;
+end;
+
+class function TDeflater.ZipID: Word;
+begin
+ Result:=8;
+end;
+
+{ ---------------------------------------------------------------------
+ TInflater
+ ---------------------------------------------------------------------}
+
+constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
+begin
+ Inherited;
+end;
+
+
+procedure TInflater.DeCompress;
+
+Var
+ Buf : PByte;
+ I,Count : Integer;
+ C : TDeCompressionStream;
+
+begin
+ CRC32Val:=$FFFFFFFF;
+ Buf:=GetMem(FBufferSize);
+ Try
+ C:=TDeCompressionStream.Create(FInFile,True);
+ Try
+ Repeat
+ Count:=C.Read(Buf^,FBufferSize);
+ For I:=0 to Count-1 do
+ UpdC32(Buf[i]);
+ FOutFile.Write(Buf^,Count);
+ Until (Count=0);
+ Finally
+ C.Free;
+ end;
+ Finally
+ FreeMem(Buf);
+ end;
+ Crc32Val:=NOT Crc32Val;
+end;
+
+class function TInflater.ZipID: Word;
+begin
+ Result:=8;
+end;
+
+
+{ ---------------------------------------------------------------------
+ TShrinker
+ ---------------------------------------------------------------------}
+
+Const
+ DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk }
+ DefaultBufSize = 16384; { Use 16K file buffers }
+ MINBITS = 9; { Starting code size of 9 bits }
+ MAXBITS = 13; { Maximum code size of 13 bits }
+ SPECIAL = 256; { Special function code }
+ INCSIZE = 1; { Code indicating a jump in code size }
+ CLEARCODE = 2; { Code indicating code table has been cleared }
+ STDATTR = $23; { Standard file attribute for DOS Find First/Next }
+
+constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord);
+begin
+ Inherited;
+ FBufSize:=ABufSize;
+ InBuf:=GetMem(FBUFSIZE);
+ OutBuf:=GetMem(FBUFSIZE);
+ CodeTable:=GetMem(SizeOf(CodeTable^));
+ FreeList:=GetMem(SizeOf(FreeList^));
+end;
+
+destructor TShrinker.Destroy;
+begin
+ FreeMem(CodeTable);
+ FreeMem(FreeList);
+ FreeMem(InBuf);
+ FreeMem(OutBuf);
+ inherited Destroy;
+end;
+
+Procedure TShrinker.Compress;
+
+Var
+ OneString : String;
+ Remaining : Word;
+
+begin
+ BytesIn := 1;
+ BytesOut := 1;
+ InitializeCodeTable;
+ FillInputBuffer;
+ FirstCh:= TRUE;
+ Crc32Val:=$FFFFFFFF;
+ FOnBytes:=Round((FInFile.Size * FOnPercent) / 100);
+ While NOT InputEof do
+ begin
+ Remaining:=Succ(MaxInBufIdx - InBufIdx);
+ If Remaining>255 then
+ Remaining:=255;
+ If Remaining=0 then
+ FillInputBuffer
+ else
+ begin
+ SetLength(OneString,Remaining);
+ Move(InBuf[InBufIdx], OneString[1], Remaining);
+ Inc(InBufIdx, Remaining);
+ ProcessLine(OneString);
+ end;
+ end;
+ Crc32Val := NOT Crc32Val;
+ ProcessLine('');
+end;
+
+class function TShrinker.ZipID: Word;
+begin
+ Result:=1;
+end;
+
+
+Procedure TShrinker.DoOnProgress(Const Pct: Double);
+
+begin
+ If Assigned(FOnProgress) then
+ FOnProgress(Self,Pct);
+end;
+
+
+Procedure TShrinker.FillInputBuffer;
+
+Begin
+ MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize);
+ If MaxInbufIDx=0 then
+ InputEof := TRUE
+ else
+ InputEOF := FALSE;
+ InBufIdx := 0;
+end;
+
+
+Procedure TShrinker.WriteOutputBuffer;
+Begin
+ FOutFile.WriteBuffer(OutBuf[0], OutBufIdx);
+ OutBufIdx := 0;
+end;
+
+
+Procedure TShrinker.PutChar(B : Byte);
+
+Begin
+ OutBuf[OutBufIdx] := B;
+ Inc(OutBufIdx);
+ If OutBufIdx>=FBufSize then
+ WriteOutputBuffer;
+ Inc(BytesOut);
+end;
+
+Procedure TShrinker.FlushOutput;
+Begin
+ If OutBufIdx>0 then
+ WriteOutputBuffer;
+End;
+
+
+procedure TShrinker.PutCode(Code : Smallint);
+
+var
+ ACode : LongInt;
+ XSize : Smallint;
+
+begin
+ if (Code=-1) then
+ begin
+ if BitsUsed>0 then
+ PutChar(SaveByte);
+ end
+ else
+ begin
+ ACode := Longint(Code);
+ XSize := CodeSize+BitsUsed;
+ ACode := (ACode shl BitsUsed) or SaveByte;
+ while (XSize div 8) > 0 do
+ begin
+ PutChar(Lo(ACode));
+ ACode := ACode shr 8;
+ Dec(XSize,8);
+ end;
+ BitsUsed := XSize;
+ SaveByte := Lo(ACode);
+ end;
+end;
+
+
+Procedure TShrinker.InitializeCodeTable;
+
+Var
+ I : Word;
+Begin
+ For I := 0 to TableSize do
+ begin
+ With CodeTable^[I] do
+ begin
+ Child := -1;
+ Sibling := -1;
+ If (I<=255) then
+ Suffix := I;
+ end;
+ If (I>=257) then
+ FreeList^[I] := I;
+ end;
+ NextFree := FIRSTENTRY;
+ TableFull := FALSE;
+end;
+
+
+Procedure TShrinker.Prune(Parent : Word);
+
+Var
+ CurrChild : Smallint;
+ NextSibling : Smallint;
+Begin
+ CurrChild := CodeTable^[Parent].Child;
+ { Find first Child that has descendants .. clear any that don't }
+ While (CurrChild <> -1) AND (CodeTable^[CurrChild].Child = -1) do
+ begin
+ CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling;
+ CodeTable^[CurrChild].Sibling := -1;
+ { Turn on ClearList bit to indicate a cleared entry }
+ ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8)));
+ CurrChild := CodeTable^[Parent].Child;
+ end;
+ If CurrChild <> -1 then
+ begin { If there are any children left ...}
+ Prune(CurrChild);
+ NextSibling := CodeTable^[CurrChild].Sibling;
+ While NextSibling <> -1 do
+ begin
+ If CodeTable^[NextSibling].Child = -1 then
+ begin
+ CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling;
+ CodeTable^[NextSibling].Sibling := -1;
+ { Turn on ClearList bit to indicate a cleared entry }
+ ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8)));
+ NextSibling := CodeTable^[CurrChild].Sibling;
+ end
+ else
+ begin
+ CurrChild := NextSibling;
+ Prune(CurrChild);
+ NextSibling := CodeTable^[CurrChild].Sibling;
+ end;
+ end;
+ end;
+end;
+
+
+Procedure TShrinker.Clear_Table;
+Var
+ Node : Word;
+Begin
+ FillChar(ClearList, SizeOf(ClearList), $00);
+ For Node := 0 to 255 do
+ Prune(Node);
+ NextFree := Succ(TABLESIZE);
+ For Node := TABLESIZE downto FIRSTENTRY do
+ begin
+ If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then
+ begin
+ Dec(NextFree);
+ FreeList^[NextFree] := Node;
+ end;
+ end;
+ If NextFree <= TABLESIZE then
+ TableFull := FALSE;
+end;
+
+
+Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte);
+Var
+ FreeNode : Word;
+Begin
+ If NextFree <= TABLESIZE then
+ begin
+ FreeNode := FreeList^[NextFree];
+ Inc(NextFree);
+ CodeTable^[FreeNode].Child := -1;
+ CodeTable^[FreeNode].Sibling := -1;
+ CodeTable^[FreeNode].Suffix := Suffix;
+ If CodeTable^[Prefix].Child = -1 then
+ CodeTable^[Prefix].Child := FreeNode
+ else
+ begin
+ Prefix := CodeTable^[Prefix].Child;
+ While CodeTable^[Prefix].Sibling <> -1 do
+ Prefix := CodeTable^[Prefix].Sibling;
+ CodeTable^[Prefix].Sibling := FreeNode;
+ end;
+ end;
+ if NextFree > TABLESIZE then
+ TableFull := TRUE;
+end;
+
+function TShrinker.Table_Lookup( TargetPrefix : Smallint;
+ TargetSuffix : Byte;
+ Out FoundAt : Smallint ) : Boolean;
+
+var TempPrefix : Smallint;
+
+begin
+ TempPrefix := TargetPrefix;
+ Table_lookup := False;
+ if CodeTable^[TempPrefix].Child <> -1 then
+ begin
+ TempPrefix := CodeTable^[TempPrefix].Child;
+ repeat
+ if CodeTable^[TempPrefix].Suffix = TargetSuffix then
+ begin
+ Table_lookup := True;
+ break;
+ end;
+ if CodeTable^[TempPrefix].Sibling = -1 then
+ break;
+ TempPrefix := CodeTable^[TempPrefix].Sibling;
+ until False;
+ end;
+ if Table_Lookup then
+ FoundAt := TempPrefix
+ else
+ FoundAt := -1;
+end;
+
+Procedure TShrinker.Shrink(Suffix : Smallint);
+
+Const
+ LastCode : Smallint = 0;
+
+Var
+ WhereFound : Smallint;
+
+Begin
+ If FirstCh then
+ begin
+ SaveByte := $00;
+ BitsUsed := 0;
+ CodeSize := MINBITS;
+ MaxCode := (1 SHL CodeSize) - 1;
+ LastCode := Suffix;
+ FirstCh := FALSE;
+ end
+ else
+ begin
+ If Suffix <> -1 then
+ begin
+ If TableFull then
+ begin
+ Putcode(LastCode);
+ PutCode(SPECIAL);
+ Putcode(CLEARCODE);
+ Clear_Table;
+ Table_Add(LastCode, Suffix);
+ LastCode := Suffix;
+ end
+ else
+ begin
+ If Table_Lookup(LastCode, Suffix, WhereFound) then
+ begin
+ LastCode := WhereFound;
+ end
+ else
+ begin
+ PutCode(LastCode);
+ Table_Add(LastCode, Suffix);
+ LastCode := Suffix;
+ If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then
+ begin
+ PutCode(SPECIAL);
+ PutCode(INCSIZE);
+ Inc(CodeSize);
+ MaxCode := (1 SHL CodeSize) -1;
+ end;
+ end;
+ end;
+ end
+ else
+ begin
+ PutCode(LastCode);
+ PutCode(-1);
+ FlushOutput;
+ end;
+ end;
+end;
+
+Procedure TShrinker.ProcessLine(Const Source : String);
+
+Var
+ I : Word;
+
+Begin
+ If Source = '' then
+ Shrink(-1)
+ else
+ For I := 1 to Length(Source) do
+ begin
+ Inc(BytesIn);
+ If (Pred(BytesIn) MOD FOnBytes) = 0 then
+ DoOnProgress(100 * ( BytesIn / FInFile.Size));
+ UpdC32(Ord(Source[I]));
+ Shrink(Ord(Source[I]));
+ end;
+end;
+
+{ ---------------------------------------------------------------------
+ TZipper
+ ---------------------------------------------------------------------}
+
+
+Procedure TZipper.GetFileInfo;
+
+Var
+ F : TZipFileEntry;
+ Info : TSearchRec;
+ I : Longint;
+
+Begin
+ For I := 0 to FEntries.Count-1 do
+ begin
+ F:=FEntries[i];
+ If F.Stream=Nil then
+ begin
+ If (F.DiskFileName='') then
+ Raise EZipError.CreateFmt(SErrMissingFileName,[I]);
+ If FindFirst(F.DiskFileName, STDATTR, Info)=0 then
+ try
+ F.Size:=Info.Size;
+ F.DateTime:=FileDateToDateTime(Info.Time);
+ finally
+ FindClose(Info);
+ end
+ else
+ Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
+ end
+ else
+ begin
+ If (F.ArchiveFileName='') then
+ Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
+ F.Size:=F.Stream.Size;
+ end;
+ end;
+end;
+
+
+procedure TZipper.SetEntries(const AValue: TZipFileEntries);
+begin
+ if FEntries=AValue then exit;
+ FEntries.Assign(AValue);
+end;
+
+Procedure TZipper.OpenOutput;
+
+Begin
+ FOutFile:=TFileStream.Create(FFileName,fmCreate);
+End;
+
+
+Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean;
+
+Begin
+ If (Item.Stream<>nil) then
+ FInFile:=Item.Stream
+ else
+ FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead);
+ Result:=True;
+ If Assigned(FOnStartFile) then
+ FOnStartFile(Self,Item.ArchiveFileName);
+End;
+
+
+Procedure TZipper.CloseOutput;
+
+Begin
+ FreeAndNil(FOutFile);
+end;
+
+
+Procedure TZipper.CloseInput(Item : TZipFileEntry);
+
+Begin
+ If (FInFile<>Item.Stream) then
+ FreeAndNil(FInFile)
+ else
+ FinFile:=Nil;
+end;
+
+
+Procedure TZipper.StartZipFile(Item : TZipFileEntry);
+
+Begin
+ FillChar(LocalHdr,SizeOf(LocalHdr),0);
+ With LocalHdr do
+ begin
+ Signature := LOCAL_FILE_HEADER_SIGNATURE;
+ Extract_Version_Reqd := 10;
+ Bit_Flag := 0;
+ Compress_Method := 1;
+ DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time);
+ Crc32 := 0;
+ Compressed_Size := 0;
+ Uncompressed_Size := Item.Size;
+ FileName_Length := 0;
+ Extra_Field_Length := 0;
+ end ;
+End;
+
+
+Function TZipper.UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord; AMethod : Word) : Boolean;
+var
+ ZFileName : ShortString;
+Begin
+ ZFileName:=Item.ArchiveFileName;
+ With LocalHdr do
+ begin
+ FileName_Length := Length(ZFileName);
+ Compressed_Size := FZip.Size;
+ Crc32 := ACRC;
+ Compress_method:=AMethod;
+ Result:=Not (Compressed_Size >= Uncompressed_Size);
+ If Not Result then
+ begin { No... }
+ Compress_Method := 0; { ...change stowage type }
+ Compressed_Size := Uncompressed_Size; { ...update compressed size }
+ end;
+ end;
+ FOutFile.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr));
+ FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName));
+End;
+
+
+Procedure TZipper.BuildZipDirectory;
+
+Var
+ SavePos : LongInt;
+ HdrPos : LongInt;
+ CenDirPos : LongInt;
+ ACount : Word;
+ ZFileName : ShortString;
+
+Begin
+ ACount := 0;
+ CenDirPos := FOutFile.Position;
+ FOutFile.Seek(0,soFrombeginning); { Rewind output file }
+ HdrPos := FOutFile.Position;
+ FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+ LocalHdr := SwapLFH(LocalHdr);
+{$ENDIF}
+ Repeat
+ SetLength(ZFileName,LocalHdr.FileName_Length);
+ FOutFile.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
+ SavePos := FOutFile.Position;
+ FillChar(CentralHdr,SizeOf(CentralHdr),0);
+ With CentralHdr do
+ begin
+ Signature := CENTRAL_FILE_HEADER_SIGNATURE;
+ MadeBy_Version := LocalHdr.Extract_Version_Reqd;
+ Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26);
+ Last_Mod_Time:=localHdr.Last_Mod_Time;
+ Last_Mod_Date:=localHdr.Last_Mod_Date;
+ File_Comment_Length := 0;
+ Starting_Disk_Num := 0;
+ Internal_Attributes := 0;
+ External_Attributes := faARCHIVE;
+ Local_Header_Offset := HdrPos;
+ end;
+ FOutFile.Seek(0,soFromEnd);
+ FOutFile.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr));
+ FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName));
+ Inc(ACount);
+ FOutFile.Seek(SavePos + LocalHdr.Compressed_Size,soFromBeginning);
+ HdrPos:=FOutFile.Position;
+ FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+ LocalHdr := SwapLFH(LocalHdr);
+{$ENDIF}
+ Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE;
+ FOutFile.Seek(0,soFromEnd);
+ FillChar(EndHdr,SizeOf(EndHdr),0);
+ With EndHdr do
+ begin
+ Signature := END_OF_CENTRAL_DIR_SIGNATURE;
+ Disk_Number := 0;
+ Central_Dir_Start_Disk := 0;
+ Entries_This_Disk := ACount;
+ Total_Entries := ACount;
+ Central_Dir_Size := FOutFile.Size-CenDirPos;
+ Start_Disk_Offset := CenDirPos;
+ ZipFile_Comment_Length := 0;
+ FOutFile.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr));
+ end;
+end;
+
+Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor;
+
+begin
+ Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
+end;
+
+Procedure TZipper.ZipOneFile(Item : TZipFileEntry);
+
+Var
+ CRC : LongWord;
+ ZMethod : Word;
+ ZipStream : TStream;
+ TmpFileName : String;
+
+Begin
+ OpenInput(Item);
+ Try
+ StartZipFile(Item);
+ If (FInfile.Size<=FInMemSize) then
+ ZipStream:=TMemoryStream.Create
+ else
+ begin
+ TmpFileName:=ChangeFileExt(FFileName,'.tmp');
+ ZipStream:=TFileStream.Create(TmpFileName,fmCreate);
+ end;
+ Try
+ With CreateCompressor(Item, FinFile,ZipStream) do
+ Try
+ OnProgress:=Self.OnProgress;
+ OnPercent:=Self.OnPercent;
+ Compress;
+ CRC:=Crc32Val;
+ ZMethod:=ZipID;
+ Finally
+ Free;
+ end;
+ If UpdateZipHeader(Item,ZipStream,CRC,ZMethod) then
+ // Compressed file smaller than original file.
+ FOutFile.CopyFrom(ZipStream,0)
+ else
+ begin
+ // Original file smaller than compressed file.
+ FInfile.Seek(0,soFromBeginning);
+ FOutFile.CopyFrom(FInFile,0);
+ end;
+ finally
+ ZipStream.Free;
+ If (TmpFileName<>'') then
+ DeleteFile(TmpFileName);
+ end;
+ Finally
+ CloseInput(Item);
+ end;
+end;
+
+Procedure TZipper.ZipAllFiles;
+
+Var
+ I : Integer;
+ filecnt : integer;
+Begin
+ If CheckEntries=0 then
+ Exit;
+ FZipping:=True;
+ Try
+ GetFileInfo;
+ OpenOutput;
+ Try
+ filecnt:=0;
+ For I:=0 to FEntries.Count-1 do
+ begin
+ ZipOneFile(FEntries[i]);
+ inc(filecnt);
+ end;
+ if filecnt>0 then
+ BuildZipDirectory;
+ finally
+ CloseOutput;
+ end;
+ finally
+ FZipping:=False;
+ end;
+end;
+
+
+Procedure TZipper.SetBufSize(Value : LongWord);
+
+begin
+ If FZipping then
+ Raise EZipError.Create(SErrBufsizeChange);
+ If Value>=DefaultBufSize then
+ FBufSize:=Value;
+end;
+
+Procedure TZipper.SetFileName(Value : String);
+
+begin
+ If FZipping then
+ Raise EZipError.Create(SErrFileChange);
+ FFileName:=Value;
+end;
+
+Procedure TZipper.ZipFiles(AFileName : String; FileList : TStrings);
+
+begin
+ FFiles.Assign(FileList);
+ FFileName:=AFileName;
+ ZipAllFiles;
+end;
+
+procedure TZipper.ZipFiles(AFileName: String; Entries: TZipFileEntries);
+begin
+ FFileName:=AFileName;
+ FEntries.Assign(Entries);
+ ZipAllFiles;
+end;
+
+Procedure TZipper.DoEndOfFile;
+
+Var
+ ComprPct : Double;
+
+begin
+ If (LocalHdr.Uncompressed_Size>0) then
+ ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
+ else
+ ComprPct := 0;
+ If Assigned(FOnEndOfFile) then
+ FOnEndOfFile(Self,ComprPct);
+end;
+
+Constructor TZipper.Create;
+
+begin
+ FBufSize:=DefaultBufSize;
+ FInMemSize:=DefaultInMemSize;
+ FFiles:=TStringList.Create;
+ FEntries:=TZipFileEntries.Create(TZipFileEntry);
+ FOnPercent:=1;
+end;
+
+Function TZipper.CheckEntries : Integer;
+
+Var
+ I : Integer;
+
+begin
+ If (FFiles.Count>0) and (FEntries.Count=0) then
+ begin
+ FEntries.Clear;
+ For I:=0 to FFiles.Count-1 do
+ begin
+ FEntries.AddFileEntry(FFiles[i]);
+ end;
+ end;
+ Result:=FEntries.Count;
+end;
+
+
+Procedure TZipper.Clear;
+
+begin
+ FEntries.Clear;
+ FFiles.Clear;
+end;
+
+Destructor TZipper.Destroy;
+
+begin
+ Clear;
+ FreeAndNil(FEntries);
+ FreeAndNil(FFiles);
+ Inherited;
+end;
+
+
+{ ---------------------------------------------------------------------
+ TUnZipper
+ ---------------------------------------------------------------------}
+
+Procedure TUnZipper.OpenInput;
+
+Begin
+ FZipFile:=TFileStream.Create(FFileName,fmOpenRead);
+End;
+
+
+Function TUnZipper.OpenOutput(OutFileName : String) : Boolean;
+
+Begin
+ ForceDirectories(ExtractFilePath(OutFileName));
+ FOutFile:=TFileStream.Create(OutFileName,fmCreate);
+ Result:=True;
+ If Assigned(FOnStartFile) then
+ FOnStartFile(Self,OutFileName);
+End;
+
+
+Procedure TUnZipper.CloseOutput;
+
+Begin
+ FreeAndNil(FOutFile);
+end;
+
+
+Procedure TUnZipper.CloseInput;
+
+Begin
+ FreeAndNil(FZipFile);
+end;
+
+
+Procedure TUnZipper.ReadZipHeader(Item : TZipFileEntry; out ACRC : LongWord; out AMethod : Word);
+
+Var
+ S : String;
+ D : TDateTime;
+
+Begin
+ FZipFile.Seek(Item.HdrPos,soFromBeginning);
+ FZipFile.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+ LocalHdr := SwapLFH(LocalHdr);
+{$ENDIF}
+ With LocalHdr do
+ begin
+ SetLength(S,Filename_Length);
+ FZipFile.ReadBuffer(S[1],Filename_Length);
+ FZipFile.Seek(Extra_Field_Length,soCurrent);
+ Item.ArchiveFileName:=S;
+ Item.DiskFileName:=S;
+ Item.Size:=Uncompressed_Size;
+ ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
+ Item.DateTime:=D;
+ ACrc:=Crc32;
+ AMethod:=Compress_method;
+ end;
+End;
+
+
+Procedure TUnZipper.ReadZipDirectory;
+
+Var
+ i,
+ EndHdrPos,
+ CenDirPos : LongInt;
+ NewNode : TZipFileEntry;
+ S : String;
+
+Begin
+ EndHdrPos:=FZipFile.Size-SizeOf(EndHdr);
+ if EndHdrPos < 0 then
+ raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
+ FZipFile.Seek(EndHdrPos,soFromBeginning);
+ FZipFile.ReadBuffer(EndHdr, SizeOf(EndHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+ EndHdr := SwapECD(EndHdr);
+{$ENDIF}
+ With EndHdr do
+ begin
+ if Signature <> END_OF_CENTRAL_DIR_SIGNATURE then
+ raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
+ CenDirPos:=Start_Disk_Offset;
+ end;
+ FZipFile.Seek(CenDirPos,soFrombeginning);
+ for i:=0 to EndHdr.Entries_This_Disk-1 do
+ begin
+ FZipFile.ReadBuffer(CentralHdr, SizeOf(CentralHdr));
+{$IFDEF FPC_BIG_ENDIAN}
+ CentralHdr := SwapCFH(CentralHdr);
+{$ENDIF}
+ With CentralHdr do
+ begin
+ if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
+ raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
+ NewNode:=FEntries.Add as TZipFileEntry;
+ NewNode.HdrPos := Local_Header_Offset;
+ SetLength(S,Filename_Length);
+ FZipFile.ReadBuffer(S[1],Filename_Length);
+ NewNode.ArchiveFileName:=S;
+ FZipFile.Seek(Extra_Field_Length+File_Comment_Length,soCurrent);
+ end;
+ end;
+end;
+
+Function TUnZipper.CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor;
+begin
+ case AMethod of
+ 8 :
+ Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
+ else
+ raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
+ end;
+end;
+
+Procedure TUnZipper.UnZipOneFile(Item : TZipFileEntry);
+
+Var
+ Count : Longint;
+ CRC : LongWord;
+ ZMethod : Word;
+ OutputFileName : string;
+Begin
+ Try
+ ReadZipHeader(Item,CRC,ZMethod);
+ OutputFileName:=Item.DiskFileName;
+ if FOutputPath<>'' then
+ OutputFileName:=IncludeTrailingPathDelimiter(FOutputPath)+OutputFileName;
+ OpenOutput(OutputFileName);
+ if ZMethod=0 then
+ begin
+ Count:=FOutFile.CopyFrom(FZipFile,LocalHdr.Compressed_Size);
+{$warning TODO: Implement CRC Check}
+ end
+ else
+ With CreateDecompressor(Item, ZMethod, FZipFile, FOutFile) do
+ Try
+ OnProgress:=Self.OnProgress;
+ OnPercent:=Self.OnPercent;
+ DeCompress;
+ if CRC<>Crc32Val then
+ raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
+ Finally
+ Free;
+ end;
+ Finally
+ CloseOutput;
+ end;
+end;
+
+
+Procedure TUnZipper.UnZipAllFiles;
+Var
+ Item : TZipFileEntry;
+ I : Integer;
+ AllFiles : Boolean;
+
+Begin
+ FUnZipping:=True;
+ Try
+ AllFiles:=(FFiles.Count=0);
+ OpenInput;
+ Try
+ ReadZipDirectory;
+ For I:=0 to FEntries.Count-1 do
+ begin
+ Item:=FEntries[i];
+ if AllFiles or (FFiles.IndexOf(Item.ArchiveFileName)<>-1) then
+ UnZipOneFile(Item);
+ end;
+ Finally
+ CloseInput;
+ end;
+ finally
+ FUnZipping:=False;
+ end;
+end;
+
+
+Procedure TUnZipper.SetBufSize(Value : LongWord);
+
+begin
+ If FUnZipping then
+ Raise EZipError.Create(SErrBufsizeChange);
+ If Value>=DefaultBufSize then
+ FBufSize:=Value;
+end;
+
+Procedure TUnZipper.SetFileName(Value : String);
+
+begin
+ If FUnZipping then
+ Raise EZipError.Create(SErrFileChange);
+ FFileName:=Value;
+end;
+
+Procedure TUnZipper.SetOutputPath(Value:String);
+begin
+ If FUnZipping then
+ Raise EZipError.Create(SErrFileChange);
+ FOutputPath:=Value;
+end;
+
+Procedure TUnZipper.UnZipFiles(AFileName : String; FileList : TStrings);
+
+begin
+ FFiles.Assign(FileList);
+ FFileName:=AFileName;
+ UnZipAllFiles;
+end;
+
+Procedure TUnZipper.UnZipAllFiles(AFileName : String);
+
+begin
+ FFileName:=AFileName;
+ UnZipAllFiles;
+end;
+
+Procedure TUnZipper.DoEndOfFile;
+
+Var
+ ComprPct : Double;
+
+begin
+ If (LocalHdr.Uncompressed_Size>0) then
+ ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
+ else
+ ComprPct := 0;
+ If Assigned(FOnEndOfFile) then
+ FOnEndOfFile(Self,ComprPct);
+end;
+
+Constructor TUnZipper.Create;
+
+begin
+ FBufSize:=DefaultBufSize;
+ FFiles:=TStringList.Create;
+ TStringlist(FFiles).Sorted:=True;
+ FEntries:=TZipFileEntries.Create(TZipFileEntry);
+ FOnPercent:=1;
+end;
+
+Procedure TUnZipper.Clear;
+
+begin
+ FFiles.Clear;
+ FEntries.Clear;
+end;
+
+Destructor TUnZipper.Destroy;
+
+begin
+ Clear;
+ FreeAndNil(FFiles);
+ FreeAndNil(FEntries);
+ Inherited;
+end;
+
+{ TZipFileEntry }
+
+function TZipFileEntry.GetArchiveFileName: String;
+begin
+ Result:=FArchiveFileName;
+ If (Result='') then
+ Result:=FDiskFileName;
+end;
+
+procedure TZipFileEntry.Assign(Source: TPersistent);
+
+Var
+ Z : TZipFileEntry;
+
+begin
+ if Source is TZipFileEntry then
+ begin
+ Z:=Source as TZipFileEntry;
+ FArchiveFileName:=Z.FArchiveFileName;
+ FDiskFileName:=Z.FDiskFileName;
+ FSize:=Z.FSize;
+ FDateTime:=Z.FDateTime;
+ FStream:=Z.FStream;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+{ TZipFileEntries }
+
+function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry;
+begin
+ Result:=TZipFileEntry(Items[AIndex]);
+end;
+
+procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry);
+begin
+ Items[AIndex]:=AValue;
+end;
+
+function TZipFileEntries.AddFileEntry(const ADiskFileName: String
+ ): TZipFileEntry;
+begin
+ Result:=Add as TZipFileEntry;
+ Result.DiskFileName:=ADiskFileName;
+end;
+
+function TZipFileEntries.AddFileEntry(const ADiskFileName,
+ AArchiveFileName: String): TZipFileEntry;
+begin
+ Result:=AddFileEntry(ADiskFileName);
+ Result.ArchiveFileName:=AArchiveFileName;
+end;
+
+function TZipFileEntries.AddFileEntry(const AStream: TSTream;
+ const AArchiveFileName: String): TZipFileEntry;
+begin
+ Result:=Add as TZipFileEntry;
+ Result.Stream:=AStream;
+ Result.ArchiveFileName:=AArchiveFileName;
+end;
+
+End.
diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk
index 7288ac779..3a92f1b00 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.lpk
+++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk
@@ -8,13 +8,13 @@
-
+
-
+
@@ -51,6 +51,10 @@
+
+
+
+
diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas
index 36146bbc6..5fa602f39 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.pas
+++ b/components/fpspreadsheet/laz_fpspreadsheet.pas
@@ -8,7 +8,7 @@ interface
uses
fpolestorage, fpsallformats, fpsopendocument, fpspreadsheet, xlsbiff2,
- xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, LazarusPackageIntf;
+ xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, LazarusPackageIntf;
implementation
diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas
index 8287bca86..2cdeb7967 100755
--- a/components/fpspreadsheet/xlsbiff2.pas
+++ b/components/fpspreadsheet/xlsbiff2.pas
@@ -59,7 +59,7 @@ type
{ Record writing methods }
procedure WriteBOF(AStream: TStream);
procedure WriteEOF(AStream: TStream);
- procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override;
+ procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
end;
@@ -84,17 +84,43 @@ const
INT_EXCEL_CHART = $0020;
INT_EXCEL_MACRO_SHEET = $0040;
+ { Types and constants for formulas }
+type
+ TRPNItem = record
+ TokenID: Byte;
+ Col: Byte;
+ Row: Word;
+ DoubleValue: Double;
+ end;
+
+ TRPNFormula = array of TRPNItem;
+
+const
+ { TokenID values }
+
+ { Binary Operator Tokens }
+ INT_EXCEL_TOKEN_TADD = $03;
+ INT_EXCEL_TOKEN_TSUB = $04;
+ INT_EXCEL_TOKEN_TMUL = $05;
+ INT_EXCEL_TOKEN_TDIV = $06;
+ INT_EXCEL_TOKEN_TPOWER = $07;
+
+ { Constant Operand Tokens }
+ INT_EXCEL_TOKEN_TNUM = $1F;
+
+ { Operand Tokens }
+ INT_EXCEL_TOKEN_TREFR = $24;
+ INT_EXCEL_TOKEN_TREFV = $44;
+ INT_EXCEL_TOKEN_TREFA = $64;
+
{ TsSpreadBIFF2Writer }
-{*******************************************************************
-* TsSpreadBIFF2Writer.WriteToStream ()
-*
-* DESCRIPTION: Writes an Excel 2 file to a stream
-*
-* Excel 2.x files support only one Worksheet per Workbook,
-* so only the first will be written.
-*
-*******************************************************************}
+{
+ Writes an Excel 2 file to a stream
+
+ Excel 2.x files support only one Worksheet per Workbook,
+ so only the first will be written.
+}
procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
begin
WriteBOF(AStream);
@@ -104,14 +130,11 @@ begin
WriteEOF(AStream);
end;
-{*******************************************************************
-* TsSpreadBIFF2Writer.WriteBOF ()
-*
-* DESCRIPTION: Writes an Excel 2 BOF record
-*
-* This must be the first record on an Excel 2 stream
-*
-*******************************************************************}
+{
+ Writes an Excel 2 BOF record
+
+ This must be the first record on an Excel 2 stream
+}
procedure TsSpreadBIFF2Writer.WriteBOF(AStream: TStream);
begin
{ BIFF Record header }
@@ -125,14 +148,11 @@ begin
AStream.WriteWord(WordToLE(INT_EXCEL_SHEET));
end;
-{*******************************************************************
-* TsSpreadBIFF2Writer.WriteEOF ()
-*
-* DESCRIPTION: Writes an Excel 2 EOF record
-*
-* This must be the last record on an Excel 2 stream
-*
-*******************************************************************}
+{
+ Writes an Excel 2 EOF record
+
+ This must be the last record on an Excel 2 stream
+}
procedure TsSpreadBIFF2Writer.WriteEOF(AStream: TStream);
begin
{ BIFF Record header }
@@ -140,25 +160,31 @@ begin
AStream.WriteWord($0000);
end;
-{*******************************************************************
-* TsSpreadBIFF2Writer.WriteFormula ()
-*
-* DESCRIPTION: Writes an Excel 2 FORMULA record
-*
-* To input a formula to this method, first convert it
-* to RPN, and then list all it's members in the
-* AFormula array
-*
-*******************************************************************}
+{
+ Writes an Excel 2 FORMULA record
+
+ The formula needs to be converted from usual user-readable string
+ to an RPN array
+
+ // or, in RPN: A1, B1, +
+ SetLength(MyFormula, 3);
+ MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; A1
+ MyFormula[0].Col := 0;
+ MyFormula[0].Row := 0;
+ MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; B1
+ MyFormula[1].Col := 1;
+ MyFormula[1].Row := 0;
+ MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; +
+}
procedure TsSpreadBIFF2Writer.WriteFormula(AStream: TStream; const ARow,
- ACol: Word; const AFormula: TRPNFormula);
-var
+ ACol: Word; const AFormula: TsFormula);
+{var
FormulaResult: double;
i: Integer;
RPNLength: Word;
- TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;
+ TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;}
begin
- RPNLength := 0;
+(* RPNLength := 0;
FormulaResult := 0.0;
{ BIFF Record header }
@@ -227,7 +253,7 @@ begin
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(17 + RPNLength));
- AStream.position := FinalPos;
+ AStream.position := FinalPos;*)
end;
{*******************************************************************
diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas
index 070e8f7f8..fa78cecd2 100755
--- a/components/fpspreadsheet/xlsbiff5.pas
+++ b/components/fpspreadsheet/xlsbiff5.pas
@@ -97,7 +97,7 @@ type
procedure WriteDimensions(AStream: TStream);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TFPCustomFont);
- procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override;
+ procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override;
procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
@@ -536,14 +536,14 @@ end;
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteFormula(AStream: TStream; const ARow,
- ACol: Word; const AFormula: TRPNFormula);
-var
+ ACol: Word; const AFormula: TsFormula);
+{var
FormulaResult: double;
i: Integer;
RPNLength: Word;
- TokenArraySizePos, RecordSizePos, FinalPos: Int64;
+ TokenArraySizePos, RecordSizePos, FinalPos: Int64;}
begin
- RPNLength := 0;
+(* RPNLength := 0;
FormulaResult := 0.0;
{ BIFF Record header }
@@ -612,7 +612,7 @@ begin
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength));
- AStream.position := FinalPos;
+ AStream.position := FinalPos;*)
end;
{*******************************************************************
diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas
index 05e47e978..ce58f100e 100755
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@@ -66,7 +66,7 @@ type
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFontName: Widestring = 'Arial');
procedure WriteFormat(AStream: TStream; AIndex: Word = 0; AFormatString: Widestring = 'General');
- procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override;
+ procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override;
procedure WriteXF(AStream: TStream);
@@ -260,14 +260,14 @@ end;
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteFormula(AStream: TStream; const ARow,
- ACol: Word; const AFormula: TRPNFormula);
-var
+ ACol: Word; const AFormula: TsFormula);
+{var
FormulaResult: double;
i: Integer;
RPNLength: Word;
- TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;
+ TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;}
begin
- RPNLength := 0;
+(* RPNLength := 0;
FormulaResult := 0.0;
{ BIFF Record header }
@@ -336,7 +336,7 @@ begin
AStream.WriteByte(RPNLength);
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(17 + RPNLength));
- AStream.position := FinalPos;
+ AStream.position := FinalPos;*)
end;
{*******************************************************************
diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas
index c4cef5824..b3f526c6f 100755
--- a/components/fpspreadsheet/xlsxooxml.pas
+++ b/components/fpspreadsheet/xlsxooxml.pas
@@ -5,13 +5,13 @@ Writes an OOXML (Office Open XML) document
An OOXML document is a compressed ZIP file with the following files inside:
-[Content_Types].xml
-_rels\.rels
-xl\_rels\workbook.xml.rels
-xl\workbook.xml
-xl\styles.xml
-xl\sharedStrings.xml
-xl\worksheets\sheet1.xml
+[Content_Types].xml -
+_rels\.rels -
+xl\_rels\workbook.xml.rels -
+xl\workbook.xml - Global workbook data and list of worksheets
+xl\styles.xml -
+xl\sharedStrings.xml -
+xl\worksheets\sheet1.xml - Contents of each worksheet
...
xl\worksheets\sheetN.xml
@@ -20,8 +20,6 @@ Specifications obtained from:
http://openxmldeveloper.org/default.aspx
AUTHORS: Felipe Monteiro de Carvalho
-
-IMPORTANT: This writer doesn't work yet!!! This is just initial code.
}
unit xlsxooxml;
@@ -32,7 +30,8 @@ unit xlsxooxml;
interface
uses
- Classes, SysUtils, zipper,
+ Classes, SysUtils,
+ fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released }
fpspreadsheet;
type
@@ -41,12 +40,23 @@ type
TsSpreadOOXMLWriter = class(TsCustomSpreadWriter)
protected
- FZip: TZipper;
+ { Strings with the contents of files }
FContentTypes: string;
FRelsRels: string;
- FWorkbook, FWorkbookRels, FStyles, FSharedString, FSheet1: string;
- procedure FillFileContentStrings(AData: TsWorkbook);
+ FWorkbook, FWorkbookRels, FStyles, FSharedStrings: string;
+ FSheets: array of string;
+ FSharedStringsCount: Integer;
+ { Streams with the contents of files }
+ FSContentTypes: TStringStream;
+ FSRelsRels: TStringStream;
+ FSWorkbook, FSWorkbookRels, FSStyles, FSSharedStrings: TStringStream;
+ FSSheets: array of TStringStream;
+ { Routines to write those files }
+ procedure WriteGlobalFiles;
+ procedure WriteContent(AData: TsWorkbook);
+ procedure WriteWorksheet(CurSheet: TsWorksheet);
public
+ destructor Destroy; override;
{ General writing methods }
procedure WriteStringToFile(AFileName, AString: string);
procedure WriteToFile(AFileName: string; AData: TsWorkbook); override;
@@ -64,15 +74,15 @@ const
{ OOXML Directory structure constants }
OOXML_PATH_TYPES = '[Content_Types].xml';
- OOXML_PATH_RELS = '_rels\';
- OOXML_PATH_RELS_RELS = '_rels\.rels';
- OOXML_PATH_XL = 'xl\';
- OOXML_PATH_XL_RELS = 'xl\_rels\';
- OOXML_PATH_XL_RELS_RELS = 'xl\_rels\workbook.xml.rels';
- OOXML_PATH_XL_WORKBOOK = 'xl\workbook.xml';
- OOXML_PATH_XL_STYLES = 'xl\styles.xml';
- OOXML_PATH_XL_STRINGS = 'xl\sharedStrings.xml';
- OOXML_PATH_XL_WORKSHEETS = 'xl\worksheets\';
+ OOXML_PATH_RELS = '_rels' + PathDelim;
+ OOXML_PATH_RELS_RELS = '_rels' + PathDelim + '.rels';
+ OOXML_PATH_XL = 'xl' + PathDelim;
+ OOXML_PATH_XL_RELS = 'xl' + PathDelim + '_rels' + PathDelim;
+ OOXML_PATH_XL_RELS_RELS = 'xl' + PathDelim + '_rels' + PathDelim + 'workbook.xml.rels';
+ OOXML_PATH_XL_WORKBOOK = 'xl' + PathDelim + 'workbook.xml';
+ OOXML_PATH_XL_STYLES = 'xl' + PathDelim + 'styles.xml';
+ OOXML_PATH_XL_STRINGS = 'xl' + PathDelim + 'sharedStrings.xml';
+ OOXML_PATH_XL_WORKSHEETS = 'xl' + PathDelim + 'worksheets' + PathDelim;
{ OOXML schemas constants }
SCHEMAS_TYPES = 'http://schemas.openxmlformats.org/package/2006/content-types';
@@ -95,7 +105,7 @@ const
{ TsSpreadOOXMLWriter }
-procedure TsSpreadOOXMLWriter.FillFileContentStrings(AData: TsWorkbook);
+procedure TsSpreadOOXMLWriter.WriteGlobalFiles;
begin
// WriteCellsToStream(AStream, AData.GetFirstWorksheet.FCells);
@@ -116,28 +126,6 @@ begin
'' + LineEnding +
'';
- FWorkbookRels :=
- XML_HEADER + LineEnding +
- '' + LineEnding +
- '' + LineEnding +
- '' + LineEnding +
- '' + LineEnding +
- '';
-
- FWorkbook :=
- XML_HEADER + LineEnding +
- '' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- ' ' + LineEnding +
- '';
-
FStyles :=
XML_HEADER + LineEnding +
'' + LineEnding +
@@ -176,11 +164,71 @@ begin
' ' + LineEnding +
' ' + LineEnding +
'';
+end;
- FSharedString :=
+procedure TsSpreadOOXMLWriter.WriteContent(AData: TsWorkbook);
+var
+ i: Integer;
+begin
+ { Workbook relations - Mark relation to all sheets }
+ FWorkbookRels :=
XML_HEADER + LineEnding +
- '' + LineEnding +
- ' ' + LineEnding +
+ '' + LineEnding +
+ '' + LineEnding +
+ '' + LineEnding;
+
+ for i := 1 to AData.GetWorksheetCount do
+ begin
+ FWorkbookRels := FWorkbookRels +
+ '' + LineEnding;
+ end;
+
+ FWorkbookRels := FWorkbookRels +
+ '';
+
+ // Global workbook data - Mark all sheets
+ FWorkbook :=
+ XML_HEADER + LineEnding +
+ '' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding;
+
+ for i := 1 to AData.GetWorksheetCount do
+ begin
+ FWorkbook := FWorkbook +
+ ' ' + LineEnding +
+ ' ' + LineEnding +
+ ' ' + LineEnding;
+ end;
+
+ FWorkbook := FWorkbook +
+ ' ' + LineEnding +
+ '';
+
+ // Preparation for Shared strings
+ FSharedStringsCount := 0;
+ FSharedStrings := '';
+
+ // Write all worksheets, which fills also FSharedStrings
+ SetLength(FSheets, 0);
+
+ for i := 0 to AData.GetWorksheetCount - 1 do
+ begin
+ WriteWorksheet(Adata.GetWorksheetByIndex(i));
+ end;
+
+ // Finalization of the shared strings document
+ FSharedStrings :=
+ XML_HEADER + LineEnding +
+ '' + LineEnding +
+ FSharedStrings +
+{ ' ' + LineEnding +
' First' + LineEnding +
' ' + LineEnding +
' ' + LineEnding +
@@ -191,10 +239,18 @@ begin
' ' + LineEnding +
' ' + LineEnding +
' Fourth' + LineEnding +
- ' ' + LineEnding +
+ ' ' + LineEnding + }
'';
+end;
- FSheet1 :=
+procedure TsSpreadOOXMLWriter.WriteWorksheet(CurSheet: TsWorksheet);
+var
+ CurStr: Integer;
+begin
+ CurStr := Length(FSheets);
+ SetLength(FSheets, CurStr + 1);
+
+ FSheets[CurStr] :=
XML_HEADER + LineEnding +
'' + LineEnding +
' ' + LineEnding +
@@ -228,17 +284,22 @@ begin
' ' + LineEnding +
' 3' + LineEnding +
' ' + LineEnding +
- ' ' + LineEnding +
+ ' ' + LineEnding +
' ' + LineEnding +
'';
end;
-{*******************************************************************
-* TsSpreadOOXMLWriter.WriteStringToFile ()
-*
-* DESCRIPTION: Writes a string to a file. Helper convenience method.
-*
-*******************************************************************}
+destructor TsSpreadOOXMLWriter.Destroy;
+begin
+ SetLength(FSheets, 0);
+ SetLength(FSSheets, 0);
+
+ inherited Destroy;
+end;
+
+{
+ Writes a string to a file. Helper convenience method.
+}
procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string);
var
TheStream : TFileStream;
@@ -250,127 +311,92 @@ begin
TheStream.Free;
end;
-{*******************************************************************
-* TsSpreadOOXMLWriter.WriteToFile ()
-*
-* DESCRIPTION: Writes an OOXML document to the disc
-*
-*******************************************************************}
+{
+ Writes an OOXML document to the disc
+}
procedure TsSpreadOOXMLWriter.WriteToFile(AFileName: string; AData: TsWorkbook);
var
- TempDir: string;
+ FZip: TZipper;
+ i: Integer;
begin
-{ FZip := TZipper.Create;
- FZip.ZipFiles(AFileName, x);
- FZip.Free;}
-
- FillFileContentStrings(AData);
+ { Fill the strings with the contents of the files }
- TempDir := IncludeTrailingBackslash(AFileName);
+ WriteGlobalFiles();
+ WriteContent(AData);
- { files on the root path }
+ { Write the data to streams }
- ForceDirectories(TempDir);
+ FSContentTypes := TStringStream.Create(FContentTypes);
+ FSRelsRels := TStringStream.Create(FRelsRels);
+ FSWorkbookRels := TStringStream.Create(FWorkbookRels);
+ FSWorkbook := TStringStream.Create(FWorkbook);
+ FSStyles := TStringStream.Create(FStyles);
+ FSSharedStrings := TStringStream.Create(FSharedStrings);
- WriteStringToFile(TempDir + OOXML_PATH_TYPES, FContentTypes);
-
- { _rels directory }
+ SetLength(FSSheets, Length(FSheets));
- ForceDirectories(TempDir + OOXML_PATH_RELS);
+ for i := 0 to Length(FSheets) - 1 do
+ FSSheets[i] := TStringStream.Create(FSheets[i]);
- WriteStringToFile(TempDir + OOXML_PATH_RELS_RELS, FRelsRels);
+ { Now compress the files }
- { xl directory }
+ FZip := TZipper.Create;
+ try
+ FZip.FileName := AFileName;
- ForceDirectories(TempDir + OOXML_PATH_XL_RELS);
-
- WriteStringToFile(TempDir + OOXML_PATH_XL_RELS_RELS, FWorkbookRels);
-
- WriteStringToFile(TempDir + OOXML_PATH_XL_WORKBOOK, FWorkbook);
+ FZip.Entries.AddFileEntry(FSContentTypes, OOXML_PATH_TYPES);
+ FZip.Entries.AddFileEntry(FSRelsRels, OOXML_PATH_RELS_RELS);
+ FZip.Entries.AddFileEntry(FSWorkbookRels, OOXML_PATH_XL_RELS_RELS);
+ FZip.Entries.AddFileEntry(FSWorkbook, OOXML_PATH_XL_WORKBOOK);
+ FZip.Entries.AddFileEntry(FSStyles, OOXML_PATH_XL_STYLES);
+ FZip.Entries.AddFileEntry(FSSharedStrings, OOXML_PATH_XL_STRINGS);
- WriteStringToFile(TempDir + OOXML_PATH_XL_STYLES, FStyles);
+ for i := 0 to Length(FSheets) - 1 do
+ FZip.Entries.AddFileEntry(FSSheets[i], OOXML_PATH_XL_WORKSHEETS + 'sheet' + IntToStr(i + 1) + '.xml');
- WriteStringToFile(TempDir + OOXML_PATH_XL_STRINGS, FSharedString);
-
- { xl\worksheets directory }
+ FZip.ZipAllFiles;
+ finally
+ FSContentTypes.Free;
+ FSRelsRels.Free;
+ FSWorkbookRels.Free;
+ FSWorkbook.Free;
+ FSStyles.Free;
+ FSSharedStrings.Free;
- ForceDirectories(TempDir + OOXML_PATH_XL_WORKSHEETS);
+ for i := 0 to Length(FSSheets) - 1 do
+ FSSheets[i].Free;
- WriteStringToFile(TempDir + OOXML_PATH_XL_WORKSHEETS + 'sheet1.xml', FSheet1);
+ FZip.Free;
+ end;
end;
procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
begin
-
+ // Not supported at the moment
+ raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported');
end;
-{*******************************************************************
-* TsSpreadOOXMLWriter.WriteLabel ()
-*
-* DESCRIPTION: Writes an Excel 2 LABEL record
-*
-* Writes a string to the sheet
-*
-*******************************************************************}
+{
+ Writes a string to the sheet
+}
procedure TsSpreadOOXMLWriter.WriteLabel(AStream: TStream; const ARow,
ACol: Word; const AValue: string);
-var
- L: Byte;
begin
- L := Length(AValue);
- { BIFF Record header }
-// AStream.WriteWord(WordToLE(INT_EXCEL_ID_LABEL));
-// AStream.WriteWord(WordToLE(8 + L));
-
- { BIFF Record data }
-// AStream.WriteWord(WordToLE(ARow));
-// AStream.WriteWord(WordToLE(ACol));
-
- { BIFF2 Attributes }
- AStream.WriteByte($0);
- AStream.WriteByte($0);
- AStream.WriteByte($0);
-
- { String with 8-bit size }
- AStream.WriteByte(L);
- AStream.WriteBuffer(AValue[1], L);
end;
-{*******************************************************************
-* TsSpreadOOXMLWriter.WriteNumber ()
-*
-* DESCRIPTION: Writes an Excel 2 NUMBER record
-*
-* Writes a number (64-bit IEE 754 floating point) to the sheet
-*
-*******************************************************************}
+{
+ Writes a number (64-bit IEE 754 floating point) to the sheet
+}
procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: double);
begin
- { BIFF Record header }
-// AStream.WriteWord(WordToLE(INT_EXCEL_ID_NUMBER));
-// AStream.WriteWord(WordToLE(15));
- { BIFF Record data }
-// AStream.WriteWord(WordToLE(ARow));
-// AStream.WriteWord(WordToLE(ACol));
-
- { BIFF2 Attributes }
- AStream.WriteByte($0);
- AStream.WriteByte($0);
- AStream.WriteByte($0);
-
- { IEE 754 floating-point value }
- AStream.WriteBuffer(AValue, 8);
end;
-{*******************************************************************
-* Initialization section
-*
-* Registers this reader / writer on fpSpreadsheet
-*
-*******************************************************************}
+{
+ Registers this reader / writer on fpSpreadsheet
+}
initialization
RegisterSpreadFormat(TsCustomSpreadReader, TsSpreadOOXMLWriter, sfOOXML);