fpspreadsheet: Fix biff8 writer to use CONTINUE records if text in STRING record is too long.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6055 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/languages/fpsstrings.de.po

@@ -8,7 +8,7 @@ msgstr ""
 "Language-Team: \n"
 "MIME-Version: 1.0\n"
 "Content-Transfer-Encoding: 8bit\n"
-"X-Generator: Poedit 1.8.9\n"
+"X-Generator: Poedit 2.0.4\n"
 "Plural-Forms: nplurals=2; plural=(n != 1);\n"
 "Language: de\n"
 
@@ -310,15 +310,15 @@ msgstr "Palettenindex %d"
 
 #: fpsstrings.rspasswordremoved_biff2
 msgid "Password removed (BIFF2 requires matching workbook and worksheet passwords)"
-msgstr ""
+msgstr "Das Passwort wurde entfernt (BIFF2 erfordert übereinstimmende Passwörter von Workbook und Worksheet "
 
 #: fpsstrings.rspasswordremoved_excel
 msgid "Password removed (Hashing algorithm not compatible with Excel)"
-msgstr ""
+msgstr "Das Passwort wurde entfernt (Der Hashing-Algorithmus ist nicht mit Excel kompatibel)."
 
 #: fpsstrings.rspasswordremoved_notvalid
 msgid "Password removed (Not valid)."
-msgstr ""
+msgstr "Das Passwort wurde entfernt (ungültig)."
 
 #: fpsstrings.rspurple
 msgid "purple"
@@ -364,6 +364,10 @@ msgstr "transparent"
 msgid "Text value exceeds the %d character limit in cell %s and has been truncated."
 msgstr "Der Text überschreitet die Grenze von %d Zeichen in Zelle %s und wurde abgeschnitten."
 
+#: fpsstrings.rstruncatetoolongtext
+msgid "Text value exceeds the %d character limit and has been truncated."
+msgstr "Der Text ist länger als die Grenze bei %d Zeichen und wurde gekürzt."
+
 #: fpsstrings.rsunexpectedendofexpression
 msgid "Unexpected end of expression"
 msgstr "Unerwartetes Ende des Ausdrucks"
@@ -431,4 +435,3 @@ msgstr "Die Datei kann nicht geschrieben werden, weil der Name des Arbeitsblatte
 #: fpsstrings.rsyellow
 msgid "yellow"
 msgstr "gelb"
-

components/fpspreadsheet/languages/fpsstrings.fi.po

@@ -353,6 +353,10 @@ msgstr "läpinäkyvä"
 msgid "Text value exceeds the %d character limit in cell %s and has been truncated."
 msgstr ""
 
+#: fpsstrings.rstruncatetoolongtext
+msgid "Text value exceeds the %d character limit and has been truncated."
+msgstr ""
+
 #: fpsstrings.rsunexpectedendofexpression
 msgid "Unexpected end of expression"
 msgstr ""

components/fpspreadsheet/languages/fpsstrings.hu.po

@@ -367,6 +367,10 @@ msgstr "átlátszó"
 msgid "Text value exceeds the %d character limit in cell %s and has been truncated."
 msgstr "A szöveg hosszabb mint a(z) 15 karakteres korlát a(z) %s cellában, ezért csonkolva lett."
 
+#: fpsstrings.rstruncatetoolongtext
+msgid "Text value exceeds the %d character limit and has been truncated."
+msgstr ""
+
 #: fpsstrings.rsunexpectedendofexpression
 msgid "Unexpected end of expression"
 msgstr "A kifejezés váratlanul ért véget"

components/fpspreadsheet/languages/fpsstrings.po

@@ -353,6 +353,10 @@ msgstr ""
 msgid "Text value exceeds the %d character limit in cell %s and has been truncated."
 msgstr ""
 
+#: fpsstrings.rstruncatetoolongtext
+msgid "Text value exceeds the %d character limit and has been truncated."
+msgstr ""
+
 #: fpsstrings.rsunexpectedendofexpression
 msgid "Unexpected end of expression"
 msgstr ""

components/fpspreadsheet/languages/fpsstrings.ru.po

@@ -357,6 +357,10 @@ msgstr "прозрачно"
 msgid "Text value exceeds the %d character limit in cell %s and has been truncated."
 msgstr "Текстовое выражения ограничено %d символами в ячейке %s и будет уменьшено."
 
+#: fpsstrings.rstruncatetoolongtext
+msgid "Text value exceeds the %d character limit and has been truncated."
+msgstr ""
+
 #: fpsstrings.rsunexpectedendofexpression
 msgid "Unexpected end of expression"
 msgstr "Ожидается конец выражения"

components/fpspreadsheet/source/common/fpsopendocument.pas

@@ -280,7 +280,7 @@ type
     procedure WriteToStream(AStream: TStream; AParams: TsStreamParams = []); override;
   end;
 
-{ procedure WriteStarObjectDescriptorToStream(AStream: TStream); }
+procedure InitOpenDocLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
 
 var
   sfidOpenDocument: TsSpreadFormatID;
@@ -452,6 +452,16 @@ begin
 end;                            *)
 
 
+procedure InitOpenDocLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
+begin
+  // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
+  ALimitations.MaxColCount := 1024;
+  ALimitations.MaxRowCount := 1048576;
+  //https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=11247&p=52985
+  ALimitations.MaxCharsInTextCell := 65535;
+end;
+
+
 {******************************************************************************}
 {                          TXMLHeaderFooterFont                                }
 {******************************************************************************}
@@ -993,9 +1003,7 @@ constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
 
-  // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
+  InitOpenDocLimitations(FLimitations);
-  FLimitations.MaxColCount := 1024;
-  FLimitations.MaxRowCount := 1048576;
 
   FPointSeparatorSettings := DefaultFormatSettings;
   FPointSeparatorSettings.DecimalSeparator := '.';
@@ -6280,9 +6288,7 @@ begin
   FPointSeparatorSettings.DecimalSeparator:='.';
   FPointSeparatorSettings.ListSeparator := ';';   // for formulas
 
-  // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
+  InitOpenDocLimitations(FLimitations);
-  FLimitations.MaxColCount := 1024;
-  FLimitations.MaxRowCount := 1048576;
 end;
 
 destructor TsSpreadOpenDocWriter.Destroy;

components/fpspreadsheet/source/common/fpsstrings.pas

@@ -37,6 +37,8 @@ resourcestring
     'the best-matching palette colors.';
   rsTruncateTooLongCellText = 'Text value exceeds the %d character limit in ' +
     'cell %s and has been truncated.';
+  rsTruncateTooLongText = 'Text value exceeds the %d character limit ' +
+    'and has been truncated.';
   rsWriteError_WorksheetNameTooLong = 'File cannot be written because ' +
     'the name of worksheet "%0:s" is too long (max %1:d characters).';
 

components/fpspreadsheet/source/common/fpstypes.pas

@@ -45,6 +45,7 @@ type
     MaxColCount: Cardinal;
     MaxPaletteSize: Integer;
     MaxSheetNameLength: Integer;
+    MaxCharsInTextCell: Integer;
   end;
 
 const

components/fpspreadsheet/source/common/xlsbiff2.pas

@@ -170,6 +170,9 @@ var
 
   sfidExcel2: TsSpreadFormatID;
 
+procedure InitBiff2Limitations(out ALimitations: TsSpreadsheetFormatLimitations);
+
+
 implementation
 
 uses
@@ -270,6 +273,12 @@ type
   end;
 
 
+procedure InitBiff2Limitations(out ALimitations: TsSpreadsheetFormatLimitations);
+begin
+  InitBiffLimitations(ALimitations);
+  ALimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
+end;
+
 procedure InternalAddBuiltinNumFormats(AList: TStringList; AFormatSettings: TFormatSettings);
 var
   fs: TFormatSettings absolute AFormatSettings;
@@ -311,13 +320,12 @@ end;
 constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
-  FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
+  InitBiff2Limitations(FLimitations);
 end;
 
 procedure TsSpreadBIFF2Reader.AddBuiltInNumFormats;
 begin
   FFirstNumFormatIndexInFile := 0;
-  //InternalAddBuiltInNumFormats(FNumFormatList, Workbook.FormatSettings);
 end;
 
 procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream);
@@ -1203,7 +1211,9 @@ end;
 constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
-  FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
+
+  InitBiff2Limitations(FLimitations);
+
   FDateMode := Excel2Settings.DateMode;
   FCodePage := Excel2Settings.CodePage;
   FSheetIndex := Excel2Settings.SheetIndex;

components/fpspreadsheet/source/common/xlsbiff8.pas

@@ -403,6 +403,7 @@ const
      SHAPEID_BASE = 1024;
 
      MAX_BYTES_IN_RECORD = 8224;   // without header
+     MAX_CHARS_IN_WIDESTRING = 32758;
 
 
 type
@@ -3179,13 +3180,10 @@ end;
 -------------------------------------------------------------------------------}
 procedure TsSpreadBIFF8Writer.WriteLABEL(AStream: TStream;
   const ARow, ACol: Cardinal; const AValue: String; ACell: PCell);
-const
-  //limit for this format: 32767 characters (2 byte each) - header:
-  //37267-8-1=32758
-  MAXCHARS = 32758;
 var
   L: Word;
   WideStr: WideString;
+  recSize: Integer;
   rec: TBIFF8_LabelRecord;
   recSST: TBIFF8_LabelSSTRecord;
   buf: array of byte;
@@ -3195,8 +3193,8 @@ begin
   if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
     exit;
 
+  // If string is in SST write a LABELSST record
   idx := IndexOfSharedString(ACell^.UTF8StringValue, ACell^.RichTextParams);
-
   if idx > -1 then begin
     recSST.RecordID := WordToLE(INT_EXCEL_ID_LABELSST);
     recSST.RecordSize := WordToLE(SizeOf(recSST) - SizeOf(TsBiffHeader));
@@ -3208,6 +3206,7 @@ begin
     exit;
   end;
 
+  // If string is not in SST write a standard LABEL cell
   WideStr := UTF8Decode(FixLineEnding(AValue)); //to UTF16
   if WideStr = '' then begin
     // Badly formatted UTF8String (maybe ANSI?)
@@ -3218,15 +3217,12 @@ begin
     Exit;
   end;
 
-  // wp: THIS IS PROBABLY WRONG, BECAUSE A RECORD CAN ONLY CONTAIN 8224 BYTES AND
+  if Length(WideStr) > FLimitations.MaxCharsInTextCell then begin
-  // A CONTINUE RECORD MUST BE USED!
-
-  if Length(WideStr) > MAXCHARS then begin
     // Rather than lose data when reading it, let the application programmer deal
     // with the problem or purposefully ignore it.
-    SetLength(WideStr, MAXCHARS); //may corrupt the string (e.g. in surrogate pairs), but... too bad.
+    SetLength(WideStr, FLimitations.MaxCharsInTextCell); //may corrupt the string (e.g. in surrogate pairs), but... too bad.
     Workbook.AddErrorMsg(rsTruncateTooLongCellText, [
-      MAXCHARS, GetCellString(ARow, ACol)
+      FLimitations.MaxCharsInTextCell, GetCellString(ARow, ACol)
     ]);
   end;
   L := Length(WideStr);
@@ -3234,6 +3230,12 @@ begin
 
   { BIFF record header }
   rec.RecordID := WordToLE(IfThen(nRuns > 0, INT_EXCEL_ID_RSTRING, INT_EXCEL_ID_LABEL));
+  (*
+  recSize := SizeOf(TBiff8_LabelRecord) - SizeOf(TsBiffHeader) + L*SizeOf(WideChar);
+  if nRuns > 0 then
+    inc(recSize, SizeOf(Word) + nRunms * SizeOf(TBiff8_RichTextFormattingRun);
+  if n
+    *)
   rec.RecordSize := SizeOf(TBiff8_LabelRecord) - SizeOf(TsBiffHeader) + L *SizeOf(WideChar);
   if nRuns > 0 then
     inc(rec.RecordSize, SizeOf(Word) + nRuns * SizeOf(TBiff8_RichTextFormattingRun));
@@ -3763,13 +3765,24 @@ begin
     s := FixLineEnding(FSharedStringTable.Strings[i]);
     isASCII := Is8BitString(s);
     if isASCII then
-      rs := s
+    begin
-    else begin
+      rs := s;
+      if Length(s) > FLimitations.MaxCharsInTextCell then
+      begin
+        SetLength(rs, FLimitations.MaxCharsInTextCell);
+        FWorkbook.AddErrorMsg(rsTruncateTooLongText, [FLimitations.MaxCharsInTextCell]);
+      end;
+    end else
+    begin
       ws := WideStringToLE(UTF8ToUTF16(s));
       SetLength(rs, Length(ws) * SizeOf(widechar));
       Move(ws[1], rs[1], Length(rs));
+      if Length(ws) > FLimitations.MaxCharsInTextCell then
+      begin
+        SetLength(ws, FLimitations.MaxCharsInTextCell);
+        FWorkbook.AddErrorMsg(rsTruncateTooLongText, [FLimitations.MaxCharsInTextCell]);
+      end;
     end;
-    // To do: Truncate if string is too long
 
     rtParams := TsRichTextParams(FSharedStringTable.Objects[i]);
 
@@ -4096,6 +4109,7 @@ end;
 
 {@@ ----------------------------------------------------------------------------
   Write the result of a string formula in the preceding record.
+  In BIFF8 files no STRING record occurs, if the result string is empty.
 -------------------------------------------------------------------------------}
 procedure TsSpreadBIFF8Writer.WriteSTRINGRecord(AStream: TStream;
   AString: String);
@@ -4106,20 +4120,51 @@ procedure TsSpreadBIFF8Writer.WriteSTRINGRecord(AStream: TStream;
 var
   wideStr: widestring;
   len: Integer;
+  strBytes: Integer;
+  idx: Integer;
+  needCONTINUE: Boolean;
 begin
-  wideStr := UTF8Decode(AString);
+  if AString = '' then
+    exit;
+
+  wideStr := WideStringToLE(UTF8Decode(FixLineEnding(AString)));
   len := Length(wideStr);
 
-  { BIFF Record header }
+  strBytes := len * SizeOf(WideChar);
+  needCONTINUE := 3 + strBytes > MAX_BYTES_IN_RECORD;
+
+  if needCONTINUE then
+    strBytes := MAX_BYTES_IN_RECORD - 4;  // -4 = -3 (header) - 1 (even byte count)
+
+  { BIFF STRING record header}
   AStream.WriteWord(WordToLE(INT_EXCEL_ID_STRING));
-  AStream.WriteWord(WordToLE(3 + len*SizeOf(widechar)));
+  AStream.WriteWord(WordToLE(3 + strBytes));
 
   { Write widestring length }
   AStream.WriteWord(WordToLE(len));
   { Widestring flags, 1=regular unicode LE string }
   AStream.WriteByte(1);
   { Write characters }
-  AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
+  AStream.WriteBuffer(wideStr[1], strBytes);
+
+  idx := 1 + strBytes div SizeOf(WideChar);
+
+  while needCONTINUE and (idx < len) do begin
+    strBytes := (len - idx) * SizeOf(WideChar);
+    needCONTINUE := strBytes + 1 > MAX_BYTES_IN_RECORD;
+    if needCONTINUE then
+      strBytes := MAX_BYTES_IN_RECORD - 2;  // -2 = -1 (flag byte) - 1 (for even count)
+
+    { BIFF CONTINUE record header }
+    AStream.WriteWord(WordToLE(INT_EXCEL_ID_CONTINUE));
+    AStream.WriteWord(WordToLE(1 + strBytes)); // for flag byte
+    { Widestring flags, 1 = regular unicode LE string }
+    AStream.WriteByte(1);
+    {Write characters }
+    AStream.WriteBuffer(wideStr[idx], strBytes);
+
+    inc(idx, strBytes div SizeOf(WideChar));
+  end;
 end;
 
 {@@-----------------------------------------------------------------------------

components/fpspreadsheet/source/common/xlscommon.pas

@@ -656,6 +656,8 @@ type
 procedure AddBuiltinBiffFormats(AList: TStringList;
   AFormatSettings: TFormatSettings; ALastIndex: Integer);
 
+procedure InitBiffLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
+
 
 implementation
 
@@ -884,6 +886,15 @@ begin
   for i:=50 to ALastIndex do AList.Add('');  // not supported/used
 end;
 
+procedure InitBiffLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
+begin
+  ALimitations.MaxColCount := 256;
+  ALimitations.MaxRowCount := 65536;
+  ALimitations.MaxPaletteSize := 64;
+  ALimitations.MaxSheetNameLength := 31;
+  ALimitations.MaxCharsInTextCell := 320000;  // 32767 in Excel 2003
+end;
+
 
 {------------------------------------------------------------------------------}
 {                           TsBIFFDefinedName                                  }
@@ -980,9 +991,7 @@ begin
   FActivePane := 3;
 
   // Limitations of BIFF5 and BIFF8 file format
-  FLimitations.MaxColCount := 256;
+  InitBiffLimitations(FLimitations);
-  FLimitations.MaxRowCount := 65536;
-  FLimitations.MaxPaletteSize := 64;
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -3076,16 +3085,15 @@ end;
 {@@ ----------------------------------------------------------------------------
   Constructor of the general BIFF writer.
   Initializes the date mode and the limitations of the format.
+
+  https://support.microsoft.com/de-de/help/507098
 -------------------------------------------------------------------------------}
 constructor TsSpreadBIFFWriter.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
 
   // Limitations of BIFF5 and BIFF8 file formats
-  FLimitations.MaxColCount := 256;
+  InitBIFFLimitations(FLimitations);
-  FLimitations.MaxRowCount := 65536;
-  FLimitations.MaxPaletteSize := 64;
-  FLimitations.MaxSheetNameLength := 31;
 
   // Initial base date in case it won't be set otherwise.
   // Use 1900 to get a bit more range between 1900..1904.

components/fpspreadsheet/source/common/xlsxooxml.pas

@@ -229,6 +229,8 @@ var
 
   sfidOOXML: TsSpreadFormatID;
 
+procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
+
 
 implementation
 
@@ -353,6 +355,17 @@ const
     );
 
 
+procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations);
+begin
+  // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
+  ALimitations.MaxColCount := 16384;
+  aLimitations.MaxRowCount := 1048576;
+  ALimitations.MaxSheetNameLength := 31;
+  // https://support.office.com/en-us/article/Excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3#ID0EBABAAA=Excel_2007
+  ALimitations.MaxCharsInTextCell := 32767;
+end;
+
+
 {------------------------------------------------------------------------------}
 {                           TsSpreadOOXMLReader                                }
 {------------------------------------------------------------------------------}
@@ -375,6 +388,8 @@ begin
 
   FPointSeparatorSettings := DefaultFormatSettings;
   FPointSeparatorSettings.DecimalSeparator := '.';
+
+  InitOOXMLLimitations(FLimitations);
 end;
 
 destructor TsSpreadOOXMLReader.Destroy;
@@ -2593,10 +2608,7 @@ begin
   FPointSeparatorSettings := DefaultFormatSettings;
   FPointSeparatorSettings.DecimalSeparator := '.';
 
-  // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
+  InitOOXMLLimitations(FLimitations);
-  FLimitations.MaxColCount := 16384;
-  FLimitations.MaxRowCount := 1048576;
-  FLimitations.MaxSheetNameLength := 31;
 end;