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

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

View File

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

View File

@ -241,7 +241,7 @@ function GetFontAsString(AFont: TsFont): String;
function ISO8601StrToDateTime(s: String): TDateTime; 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 AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: 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 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 const
BROKEN_UTF8_REPLACEMENT = #$E2#$8E#$95; // Box character. Could also be a '?'. BROKEN_UTF8_REPLACEMENT = #$E2#$8E#$95; // Box character. Could also be a '?'.
var var
@ -3230,30 +3231,33 @@ var
P, PEnd: PChar; P, PEnd: PChar;
chLen: Integer; chLen: Integer;
begin begin
Result := true;
if s = '' then if s = '' then
begin begin
Result := nil; sa := nil;
exit; exit;
end; end;
n := 0; n := 0;
SetLength(Result, Length(s)); SetLength(sa, Length(s));
P := PChar(s); P := PChar(s);
PEnd := P + Length(s); PEnd := P + Length(s);
while P < PEnd do while P < PEnd do
begin begin
chLen := UTF8CodePointSize(P); chLen := UTF8CodePointSize(P);
if (chLen = 1) and (P^ > #127) then if (chLen = 1) and (P^ > #127) then
ch := BROKEN_UTF8_REPLACEMENT begin
else ch := BROKEN_UTF8_REPLACEMENT;
Result := false;
end else
begin begin
SetLength(ch, chLen); SetLength(ch, chLen);
Move(P^, ch[1], chLen); Move(P^, ch[1], chLen);
end; end;
Result[n] := ch; sa[n] := ch;
inc(P, chLen); inc(P, chLen);
inc(n); inc(n);
end; end;
SetLength(Result, n); SetLength(sa, n);
end; end;
{$PUSH}{$HINTS OFF} {$PUSH}{$HINTS OFF}