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

fpspreadsheet: Move log list from reader/writer to workbook for easier access. Add unit test for error logging (in internaltests). Improve OOXML writer to begin writing rows only from the first existing row, not from 0. (The ODS writer still does this, therefore, it creates a huge file for the error logging test - this test is currently deactivated for ods).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3446 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-07 22:24:22 +00:00
parent 68718a9192
commit ff059e3420
9 changed files with 297 additions and 154 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -795,8 +795,10 @@ type
FOnWriteCellData: TsWorkbookWriteCellDataEvent;
FOnReadCellData: TsWorkbookReadCellDataEvent;
FFileName: String;
FLog: TStringList;
{ Setter/Getter }
function GetErrorMsg: String;
procedure SetVirtualColCount(AValue: Cardinal);
procedure SetVirtualRowCount(AValue: Cardinal);
@ -865,6 +867,11 @@ type
procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
ABigEndian: Boolean = false);
{ Error messages }
procedure AddErrorMsg(const AMsg: String); overload;
procedure AddErrorMsg(const AMsg: String; const Args: array of const); overload;
procedure ClearErrorList;
{@@ The default column width given in "character units" (width of the
character "0" in the default font) }
property DefaultColWidth: Single read FDefaultColWidth;
@ -874,6 +881,8 @@ type
{@@ This property is only used for formats which don't support unicode
and support a single encoding for the whole document, like Excel 2 to 5 }
property Encoding: TsEncoding read FEncoding write FEncoding;
{@@ Retrieves error messages collected during reading/writing }
property ErrorMsg: String read GetErrorMsg;
{@@ Filename of the saved workbook }
property FileName: String read FFileName;
{@@ Identifies the file format which was detected when reading the file }
@ -970,9 +979,6 @@ type
{@@ Common ancestor of the spreadsheet reader and writer classes providing
shared data and methods. }
TsCustomSpreadReaderWriter = class
private
FLog: TStringList;
function GetErrorMsg: String;
protected
{@@ Instance of the workbook which is currently being read. }
FWorkbook: TsWorkbook;
@ -982,9 +988,6 @@ type
{@@ List of number formats found in the file }
FNumFormatList: TsCustomNumFormatList;
procedure CreateNumFormatList; virtual;
protected
procedure AddToLog(const AMsg: String); overload;
procedure AddToLog(const AMsg: String; const Args: array of const); overload;
public
constructor Create(AWorkbook: TsWorkbook); virtual; // to allow descendents to override it
destructor Destroy; override;
@ -992,8 +995,6 @@ type
property Workbook: TsWorkbook read FWorkbook;
{@@ List of number formats found in the workbook. }
property NumFormatList: TsCustomNumFormatList read FNumFormatList;
{@@ Retrieve error messages logged during writing}
property ErrorMsg: String read GetErrorMsg;
end;
{ TsCustomSpreadReader }
@ -2130,8 +2131,11 @@ begin
// Store the result
FFirstColIndex := Result;
end
else
else begin
Result := FFirstColIndex;
if Result = $FFFFFFFF then
Result := GetFirstColIndex(true);
end;
end;
{@@
@ -2255,8 +2259,11 @@ begin
// Store result
FFirstRowIndex := Result;
end
else
Result := FFirstRowIndex
else begin
Result := FFirstRowIndex;
if Result = $FFFFFFFF then
Result := GetFirstRowIndex(true);
end;
end;
{@@
@ -4717,6 +4724,7 @@ constructor TsWorkbook.Create;
begin
inherited Create;
FWorksheets := TFPList.Create;
FLog := TStringList.Create;
FFormat := sfExcel8;
FDefaultColWidth := 12;
FDefaultRowHeight := 1;
@ -4739,6 +4747,7 @@ begin
FWorksheets.Free;
FFontList.Free;
FLog.Free;
inherited Destroy;
end;
@ -5389,6 +5398,43 @@ begin
FPalette[Result] := AColorValue;
end;
{@@
Adds a (simple) error message to an internal list
@param AMsg Error text to be stored in the list
}
procedure TsWorkbook.AddErrorMsg(const AMsg: String);
begin
FLog.Add(AMsg);
end;
{@@
Adds an error message composed by means of format codes to an internal list
@param AMsg Error text to be stored in the list
@param Args Array of arguments to be used by the Format() function
}
procedure TsWorkbook.AddErrorMsg(const AMsg: String; const Args: Array of const);
begin
FLog.Add(Format(AMsg, Args));
end;
{@@
Clears the internal list with error messages
}
procedure TsWorkbook.ClearErrorList;
begin
FLog.Clear;
end;
{@@
Getter to retrieve the error messages collected during reading/writing
}
function TsWorkbook.GetErrorMsg: String;
begin
Result := FLog.Text;
end;
{@@
Finds the palette color index which points to a color that is closest to a
given color. "Close" means here smallest length of the rgb-difference vector.
@ -5970,7 +6016,6 @@ constructor TsCustomSpreadReaderWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
FWorkbook := AWorkbook;
FLog := TStringList.Create;
CreateNumFormatList;
end;
@ -5980,27 +6025,9 @@ end;
destructor TsCustomSpreadReaderWriter.Destroy;
begin
FNumFormatList.Free;
FLog.Free;
inherited Destroy;
end;
{@@
Adds an (simple) error message to the log list
}
procedure TsCustomSpreadReaderWriter.AddToLog(const AMsg: String);
begin
FLog.Add(AMsg);
end;
{@@
Adds an error message to the log list by using the Format function
}
procedure TsCustomSpreadReaderWriter.AddToLog(const AMsg: String;
const Args: array of const);
begin
FLog.Add(Format(AMsg, Args));
end;
{@@
Creates an instance of the number format list which contains prototypes of
all number formats found in the workbook (when writing) or in the file (when
@ -6013,12 +6040,6 @@ begin
// nothing to do here
end;
{@@ Getter method to retrieve the error messages collected during reading/writing }
function TsCustomSpreadReaderWriter.GetErrorMsg: String;
begin
Result := FLog.Text;
end;
{ TsCustomSpreadReader }
@ -6133,7 +6154,7 @@ begin
inherited Create(AWorkbook);
{ A good starting point valid for many formats... }
FLimitations.MaxCols := 256;
FLimitations.MaxRows := 65536;
FLimitations.MaxRows := 65536;
end;
{@@
@ -6267,9 +6288,9 @@ var
begin
Workbook.GetLastRowColIndex(lastRow, lastCol);
if lastRow >= FLimitations.MaxRows then
AddToLog(lpMaxRowsExceeded, [lastRow+1, FLimitations.MaxRows]);
Workbook.AddErrorMsg(lpMaxRowsExceeded, [lastRow+1, FLimitations.MaxRows]);
if lastCol >= FLimitations.MaxCols then
AddToLog(lpMaxColsExceeded, [lastCol+1, FLimitations.MaxCols]);
Workbook.AddErrorMsg(lpMaxColsExceeded, [lastCol+1, FLimitations.MaxCols]);
end;

10
components/fpspreadsheet/fpsutils.pas
View File

@ -75,7 +75,7 @@ function ParseCellColString(const AStr: string;
out AResult: Cardinal): Boolean;
function GetColString(AColIndex: Integer): String;
function GetCellString(ARow,ACol: Cardinal; AFlags: TsRelFlags): String;
function GetCellString(ARow,ACol: Cardinal; AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): String;
function GetErrorValueStr(AErrorValue: TsErrorValue): String;
@ -610,13 +610,15 @@ const
@param ARowIndex Zero-based row index
@param AColIndex Zero-based column index
@param AFlags A set containing an entry for column and row if these
addresses are relative.
@param AFlags An optional set containing an entry for column and row
if these addresses are relative. By default, relative
addresses are assumed.
@return Excel type of cell address containing $ characters for absolute
address parts.
@example ARowIndex = 0, AColIndex = 0, AFlags = [rfRelRow] --> $A1
}
function GetCellString(ARow, ACol: Cardinal; AFlags: TsRelFlags): String;
function GetCellString(ARow, ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
begin
Result := Format('%s%s%s%d', [
RELCHAR[rfRelCol in AFlags], GetColString(ACol),

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

@ -1,5 +1,7 @@
unit internaltests;
{$DEFINE SKIP_TestWriteErrorMessages_ODS}
{ Other units test file read/write capability.
This unit tests functions, procedures and properties that fpspreadsheet provides.
}
@ -34,6 +36,7 @@ type
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure TestWriteErrorMessages(AFormat: TsSpreadsheetFormat);
procedure TestVirtualMode(AFormat: TsSpreadsheetFormat; ABufStreamMode: Boolean);
published
@ -50,10 +53,18 @@ type
procedure OverwriteExistingFile;
// Write out date cell and try to read as UTF8; verify if contents the same
procedure ReadDateAsUTF8;
// Test buffered stream
procedure TestReadBufStream;
procedure TestWriteBufStream;
// Tests collection of error messages during writing
procedure TestWriteErrorMessages_BIFF2;
procedure TestWriteErrorMessages_BIFF5;
procedure TestWriteErrorMessages_BIFF8;
procedure TestWriteErrorMessages_ODS;
procedure TestWriteErrorMessages_OOXML;
// Virtual mode tests for all file formats
procedure TestVirtualMode_BIFF2;
procedure TestVirtualMode_BIFF5;
@ -71,7 +82,7 @@ type
implementation
uses
numberstests, stringtests;
StrUtils, numberstests, stringtests;
const
InternalSheet = 'Internal'; //worksheet name
@ -82,11 +93,14 @@ var
MyWorkbook: TsWorkbook;
begin
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:=MyWorkBook.AddWorksheet(InternalSheet);
MyWorkSheet:=nil;
MyWorkSheet:=MyWorkBook.GetWorksheetByIndex(0);
CheckFalse((MyWorksheet=nil),'GetWorksheetByIndex should return a valid index');
MyWorkbook.Free;
try
MyWorkSheet:=MyWorkBook.AddWorksheet(InternalSheet);
MyWorkSheet:=nil;
MyWorkSheet:=MyWorkBook.GetWorksheetByIndex(0);
CheckFalse((MyWorksheet=nil),'GetWorksheetByIndex should return a valid index');
finally
MyWorkbook.Free;
end;
end;
procedure TSpreadInternalTests.GetSheetByName;
@ -97,13 +111,16 @@ var
MyWorkbook: TsWorkbook;
begin
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:=MyWorkBook.AddWorksheet(InternalSheet);
MyWorkSheet:=MyWorkBook.AddWorksheet(AnotherSheet);
MyWorkSheet:=nil;
MyWorkSheet:=MyWorkBook.GetWorksheetByName(InternalSheet);
CheckFalse((MyWorksheet=nil),'GetWorksheetByName should return a valid index');
CheckEquals(MyWorksheet.Name,InternalSheet,'GetWorksheetByName should return correct name.');
MyWorkbook.Free;
try
MyWorkSheet:=MyWorkBook.AddWorksheet(InternalSheet);
MyWorkSheet:=MyWorkBook.AddWorksheet(AnotherSheet);
MyWorkSheet:=nil;
MyWorkSheet:=MyWorkBook.GetWorksheetByName(InternalSheet);
CheckFalse((MyWorksheet=nil),'GetWorksheetByName should return a valid index');
CheckEquals(MyWorksheet.Name,InternalSheet,'GetWorksheetByName should return correct name.');
finally
MyWorkbook.Free;
end;
end;
procedure TSpreadInternalTests.OverwriteExistingFile;
@ -156,22 +173,26 @@ begin
Row:=0;
Column:=0;
TestDT:=EncodeDate(1969,7,21)+EncodeTime(2,56,0,0);
MyWorkbook:=TsWorkbook.Create;
MyWorkSheet:=MyWorkBook.AddWorksheet(InternalSheet);
MyWorkSheet.WriteDateTime(Row,Column,TestDT); //write date
try
MyWorkSheet:=MyWorkBook.AddWorksheet(InternalSheet);
MyWorkSheet.WriteDateTime(Row,Column,TestDT); //write date
// Reading as date/time should just work
if not(MyWorksheet.ReadAsDateTime(Row,Column,ActualDT)) then
Fail('Could not read date time for cell '+CellNotation(MyWorkSheet,Row,Column));
CheckEquals(TestDT,ActualDT,'Test date/time value mismatch '
+'cell '+CellNotation(MyWorkSheet,Row,Column));
// Reading as date/time should just work
if not(MyWorksheet.ReadAsDateTime(Row,Column,ActualDT)) then
Fail('Could not read date time for cell '+CellNotation(MyWorkSheet,Row,Column));
CheckEquals(TestDT,ActualDT,'Test date/time value mismatch '
+'cell '+CellNotation(MyWorkSheet,Row,Column));
//Check reading as string, convert to date & compare
ActualDTString:=MyWorkSheet.ReadAsUTF8Text(Row,Column);
ActualDT:=StrToDateTimeDef(ActualDTString,EncodeDate(1906,1,1));
CheckEquals(TestDT,ActualDT,'Date/time mismatch using ReadAsUTF8Text');
//Check reading as string, convert to date & compare
ActualDTString:=MyWorkSheet.ReadAsUTF8Text(Row,Column);
ActualDT:=StrToDateTimeDef(ActualDTString,EncodeDate(1906,1,1));
CheckEquals(TestDT,ActualDT,'Date/time mismatch using ReadAsUTF8Text');
MyWorkbook.Free;
finally
MyWorkbook.Free;
end;
end;
procedure TSpreadInternalTests.TestWriteBufStream;
@ -255,6 +276,122 @@ begin
end;
end;
procedure TSpreadInternalTests.TestWriteErrorMessages(AFormat: TsSpreadsheetFormat);
type
TTestFormat = (sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument);
const
MAX_ROW_COUNT: array[TTestFormat] of Cardinal = (65536, 65536, 65536, 1048576, 1048576);
MAX_COL_COUNT: array[TTestFormat] of Cardinal = (256, 256, 256, 16384, 1024);
MAX_CELL_LEN: array[TTestFormat] of Cardinal = (255, 255, 32767, cardinal(-1), Cardinal(-1));
var
MyWorkbook: TsWorkbook;
MyWorksheet: TsWorksheet;
row, col: Cardinal;
row1, row2: Cardinal;
col1, col2: Cardinal;
s: String;
TempFile: String;
ErrList: TStringList;
begin
ErrList := TStringList.Create;
try
// Test 1: Too many rows
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet('Test');
row1 := MAX_ROW_COUNT[TTestFormat(AFormat)] - 5;
row2 := MAX_ROW_COUNT[TTestFormat(AFormat)] + 5;
for row :=row1 to row2 do begin
MyWorksheet.WriteBlank(row, 0);
MyWorksheet.WriteNumber(row, 1, 1.0);
MyWorksheet.WriteUTF8Text(row, 2, 'A');
MyWorksheet.WriteRPNFormula(row, 3, CreateRPNFormula(
RPNCellValue('A1', nil)));
end;
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
ErrList.Text := MyWorkbook.ErrorMsg;
CheckEquals(1, ErrList.Count, 'Error count mismatch in test 1');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
// Test 2: Too many columns
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet('Test');
col1 := MAX_COL_COUNT[TTestFormat(AFormat)] - 5;
col2 := MAX_COL_COUNT[TTestFormat(AFormat)] + 5;
for col := col1 to col2 do begin
MyWorksheet.WriteBlank(row, 0);
MyWorksheet.WriteNumber(row, 1, 1.0);
MyWorksheet.WriteUTF8Text(row, 2, 'A');
MyWorksheet.WriteRPNFormula(row, 3, CreateRPNFormula(
RPNCellValue('A1', nil)));
end;
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
ErrList.Text := MyWorkbook.ErrorMsg;
CheckEquals(1, ErrList.Count, 'Error count mismatch in test 2');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
// Test 3: Too long cell label
if MAX_CELL_LEN[TTestFormat(AFormat)] <> Cardinal(-1) then begin
s := DupeString('A', MAX_CELL_LEN[TTestFormat(AFormat)] + 10);
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet('Test');
MyWorksheet.WriteUTF8Text(0, 0, s);
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
ErrList.Text := MyWorkbook.ErrorMsg;
CheckEquals(1, ErrList.Count, 'Error count mismatch in test 3');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
finally
ErrList.Free;
end;
end;
procedure TSpreadInternalTests.TestWriteErrorMessages_BIFF2;
begin
TestWriteErrorMessages(sfExcel2);
end;
procedure TSpreadInternalTests.TestWriteErrorMessages_BIFF5;
begin
TestWriteErrorMessages(sfExcel5);
end;
procedure TSpreadInternalTests.TestWriteErrorMessages_BIFF8;
begin
TestWriteErrorMessages(sfExcel8);
end;
procedure TSpreadInternalTests.TestWriteErrorMessages_ODS;
begin
{$IFDEF SKIP_TestWriteErrorMessages_ODS}
//Ignore(TestWriteErrorMessages(sfOpenDocument));
// How to do that?
{$ELSE}
TestWriteErrorMessages(sfOpenDocument);
{$ENDIF}
end;
procedure TSpreadInternalTests.TestWriteErrorMessages_OOXML;
begin
TestWriteErrorMessages(sfOOXML);
end;
procedure TSpreadInternalTests.TestReadBufStream;
const
BUF_SIZE = 1024;

9
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,12 +48,10 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -63,17 +61,14 @@
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testsutility"/>
</Unit5>
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -91,7 +86,6 @@
<Unit10>
<Filename Value="optiontests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="optiontests"/>
</Unit10>
<Unit11>
<Filename Value="numformatparsertests.pas"/>
@ -100,17 +94,14 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formulatests"/>
</Unit13>
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
</Units>
</ProjectOptions>

65
components/fpspreadsheet/xlsbiff2.pas
View File

@ -604,7 +604,7 @@ begin
XF := rec.Attrib1 and $3F;
{ String with 8-bit size }
L := rec.TextLen;
L := rec.TextLen;
SetLength(AValue, L);
AStream.ReadBuffer(AValue[1], L);
@ -1502,6 +1502,9 @@ var
s: ansistring;
xf: Word;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
RPNLength := 0;
FormulaResult := 0.0;
@ -1605,6 +1608,9 @@ var
xf: Word;
rec: TBlankRecord;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
@ -1661,6 +1667,9 @@ var
var
xf: Word;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
if AValue = '' then Exit; // Writing an empty text doesn't work
AnsiText := UTF8ToISO_8859_1(AValue);
@ -1672,6 +1681,11 @@ begin
// with the problem or purposefully ignore it.
TextTooLong:=true;
AnsiText := Copy(AnsiText, 1, MAXBYTES);
Workbook.AddErrorMsg(
'Text value exceeds %d character limit in cell %s. ' +
'Text has been truncated.', [
MAXBYTES, GetCellString(ARow, ACol)
]);
end;
L := Length(AnsiText);
@ -1700,32 +1714,6 @@ begin
{ Write out }
AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*L);
(*
{ 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 }
WriteCellFormatting(AStream, ACell, xf);
{ String with 8-bit size }
AStream.WriteByte(L);
AStream.WriteBuffer(AnsiText[1], L);
*)
{
//todo: keep a log of errors and show with an exception after writing file or something.
We can't just do the following
if TextTooLong then
Raise Exception.CreateFmt('Text value exceeds %d character limit in cell [%d,%d]. Text has been truncated.',[MaxBytes,ARow,ACol]);
because the file wouldn't be written.
}
end;
{*******************************************************************
@ -1742,24 +1730,12 @@ var
xf: Word;
rec: TBIFF2NumberRecord;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
(*
{ 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 }
WriteCellFormatting(AStream, ACell, xf);
{ IEE 754 floating-point value }
AStream.WriteBuffer(AValue, 8);
*)
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_NUMBER);
@ -1787,6 +1763,11 @@ var
w: Word;
h: Single;
begin
if (ARowIndex >= FLimitations.MaxRows) or (AFirstColIndex >= FLimitations.MaxCols)
or (ALastColIndex >= FLimitations.MaxCols)
then
exit;
Unused(ASheet);
containsXF := false;

32
components/fpspreadsheet/xlsbiff5.pas
View File

@ -951,6 +951,9 @@ var
rec: TBIFF5LabelRecord;
buf: array of byte;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
case WorkBookEncoding of
seLatin2: AnsiValue := UTF8ToCP1250(AValue);
seCyrillic: AnsiValue := UTF8ToCP1251(AValue);
@ -977,6 +980,11 @@ begin
// with the problem or purposefully ignore it.
TextTooLong := true;
AnsiValue := Copy(AnsiValue, 1, MAXBYTES);
Workbook.AddErrorMsg(
'Text value exceeds %d character limit in cell %s. ' +
'Text has been truncated.', [
MAXBYTES, GetCellString(ARow, ACol)
]);
end;
L := Length(AnsiValue);
@ -1004,30 +1012,6 @@ begin
{ Clean up }
SetLength(buf, 0);
(*
{ 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));
{ Index to XF record }
WriteXFIndex(AStream, ACell);
{ Byte String with 16-bit size }
AStream.WriteWord(WordToLE(L));
AStream.WriteBuffer(AnsiValue[1], L);
*)
{
//todo: keep a log of errors and show with an exception after writing file or something.
We can't just do the following
if TextTooLong then
Raise Exception.CreateFmt('Text value exceeds %d character limit in cell [%d,%d]. Text has been truncated.',[MaxBytes,ARow,ACol]);
because the file wouldn't be written.
}
end;
{ Writes an Excel 5 STRING record which immediately follows a FORMULA record

22
components/fpspreadsheet/xlsbiff8.pas
View File

@ -788,7 +788,11 @@ procedure TsSpreadBIFF8Writer.WriteFormula(AStream: TStream; const ARow,
RPNLength: Word;
TokenArraySizePos, RecordSizePos, FinalPos: Int64;}
begin
(* RPNLength := 0;
(*
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
RPNLength := 0;
FormulaResult := 0.0;
{ BIFF Record header }
@ -992,6 +996,9 @@ var
rec: TBIFF8LabelRecord;
buf: array of byte;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
WideValue := UTF8Decode(AValue); //to UTF16
if WideValue = '' then begin
// Badly formatted UTF8String (maybe ANSI?)
@ -1007,6 +1014,11 @@ begin
// with the problem or purposefully ignore it.
TextTooLong := true;
SetLength(WideValue, MaxBytes); //may corrupt the string (e.g. in surrogate pairs), but... too bad.
Workbook.AddErrorMsg(
'Text value exceeds %d character limit in cell %s. ' +
'Text has been truncated.', [
MAXBYTES, GetCellString(ARow, ACol)
]);
end;
L := Length(WideValue);
@ -1037,14 +1049,6 @@ begin
{ Clean up }
SetLength(buf, 0);
{
//todo: keep a log of errors and show with an exception after writing file or something.
We can't just do the following
if TextTooLong then
Raise Exception.CreateFmt('Text value exceeds %d character limit in cell [%d,%d]. Text has been truncated.',[MaxBytes,ARow,ACol]);
because the file wouldn't be written.
}
end;
{*******************************************************************

18
components/fpspreadsheet/xlscommon.pas
View File

@ -1852,6 +1852,9 @@ procedure TsSpreadBIFFWriter.WriteBlank(AStream: TStream;
var
rec: TBIFF58BlankRecord;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_BLANK);
rec.RecordSize := WordToLE(6);
@ -1922,6 +1925,9 @@ var
w: Integer;
begin
if Assigned(ACol) then begin
if (ACol^.Col >= FLimitations.MaxCols) then
exit;
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_COLINFO);
rec.RecordSize := WordToLE(12);
@ -2035,6 +2041,9 @@ procedure TsSpreadBIFFWriter.WriteNumber(AStream: TStream;
var
rec: TBIFF58NumberRecord;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
{ BIFF Record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_NUMBER);
rec.RecordSize := WordToLE(14);
@ -2260,6 +2269,9 @@ var
RPNLength: Word;
RecordSizePos, FinalPos: Int64;
begin
if (ARow >= FLimitations.MaxRows) or (ACol >= FLimitations.MaxCols) then
exit;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
@ -2482,6 +2494,12 @@ var
rowheight: Word;
h: Single;
begin
if (ARowIndex >= FLimitations.MaxRows) or
(AFirstColIndex >= FLimitations.MaxCols) or
(ALastColIndex >= FLimitations.MaxCols)
then
exit;
// Check for additional space above/below row
spaceabove := false;
spacebelow := false;

9
components/fpspreadsheet/xlsxooxml.pas
View File

@ -1842,7 +1842,8 @@ end;
procedure TsSpreadOOXMLWriter.WriteSheetData(AStream: TStream;
AWorksheet: TsWorksheet);
var
r, c, c1, c2: Cardinal;
r, r1, r2: Cardinal;
c, c1, c2: Cardinal;
row: PRow;
value: Variant;
lCell: TCell;
@ -1907,7 +1908,11 @@ begin
c1 := AWorksheet.GetFirstColIndex;
c2 := AWorksheet.GetLastColIndex;
if (c1 = $FFFFFFFF) and (c2 = 0) then c1 := 0; // avoid arithmetic overflow in case of empty worksheet
for r := 0 to AWorksheet.GetLastRowIndex do begin
r1 := AWorksheet.GetFirstRowIndex;
r2 := AWorksheet.GetlastRowIndex;
if (r1 = $FFFFFFFF) and (r2 = 0) then r1 := 0; // avoid arithmetic overflow in case of empty worksheet
// for r := 0 to AWorksheet.GetLastRowIndex do begin
for r := r1 to r2 do begin
// If the row has a custom height add this value to the <row> specification
row := AWorksheet.FindRow(r);
if row <> nil then