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

fpspreadsheet: Avoid duplicate error message when writing defective UTF8 to ods. Related to issue #39045.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8570 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-19 14:09:56 +00:00
parent ab310b1165
commit 4831f684fc
2 changed files with 23 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

@ -9207,7 +9207,7 @@ var
i, idx, endidx, fntidx, len: Integer;
rtParam: TsRichTextParam;
sheet: TsWorksheet;
txt: String;
lValue, txt: String;
chArray: array of string = nil;
function IsNewLine(var idx: integer): Boolean;
@ -9262,8 +9262,8 @@ begin
spannedStr := '';
// Check for invalid characters, get the error message
totaltxt := AValue;
if not ValidXMLText(totaltxt) then
lValue := AValue;
if not ValidXMLText(lValue) then
Workbook.AddErrorMsg(
rsInvalidCharacterInCell, [
GetCellString(ARow, ACol)
@ -9291,12 +9291,17 @@ begin
totaltxt := Format(
'<text:p>'+
'<text:a xlink:href="%s" xlink:type="simple">%s</text:a>'+
'</text:p>', [target, totaltxt]);
'</text:p>', [target, lValue]);
end
else
begin
// Split AValue into separate code points.
chArray := UTF8CodePoints(AValue);
if not UTF8CodePoints(lValue, chArray) then
Workbook.AddErrorMsg(
rsInvalidCharacterInCell, [
GetCellString(ARow, ACol)
]);
len := Length(chArray);
// No hyperlink, normal text only

22
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -241,7 +241,7 @@ function GetFontAsString(AFont: TsFont): String;
function ISO8601StrToDateTime(s: String): TDateTime;
function UTF8CodePoints(s: string): TStringArray;
function UTF8CodePoints(s: string; out sa: TStringArray): Boolean;
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
@ -3219,9 +3219,10 @@ end;
{@@ ----------------------------------------------------------------------------
Splits the UTF8-encoded string into its code-points ("characters") and
returns them as an array of string.
returns them as an array of string (sa). The result of the function is
false if at least one codepoint is broken UTF8.
-------------------------------------------------------------------------------}
function UTF8CodePoints(s: String): TStringArray;
function UTF8CodePoints(s: String; out sa: TStringArray): Boolean;
const
BROKEN_UTF8_REPLACEMENT = #$E2#$8E#$95; // Box character. Could also be a '?'.
var
@ -3230,30 +3231,33 @@ var
P, PEnd: PChar;
chLen: Integer;
begin
Result := true;
if s = '' then
begin
Result := nil;
sa := nil;
exit;
end;
n := 0;
SetLength(Result, Length(s));
SetLength(sa, Length(s));
P := PChar(s);
PEnd := P + Length(s);
while P < PEnd do
begin
chLen := UTF8CodePointSize(P);
if (chLen = 1) and (P^ > #127) then
ch := BROKEN_UTF8_REPLACEMENT
else
begin
ch := BROKEN_UTF8_REPLACEMENT;
Result := false;
end else
begin
SetLength(ch, chLen);
Move(P^, ch[1], chLen);
end;
Result[n] := ch;
sa[n] := ch;
inc(P, chLen);
inc(n);
end;
SetLength(Result, n);
SetLength(sa, n);
end;
{$PUSH}{$HINTS OFF}