paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-09 16:59:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Explicitly use UTF8, fix bug ID #36231: RTF export must write unicode chars escaped

Browse Source 
git-svn-id: trunk@43356 -
This commit is contained in:
michael 2019-11-02 11:42:32 +00:00
parent 51b1f6a47c
commit c6f53adf89
2 changed files with 28 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/fcl-db/src/export/fpdbexport.pp
View File

@ -156,8 +156,8 @@ Type
Procedure DoProgress(ItemNo : Integer); Virtual; Procedure DoProgress(ItemNo : Integer); Virtual;
// Override if each field can be written as-is. // Override if each field can be written as-is.
Procedure ExportField(EF : TExportFieldItem); virtual; Procedure ExportField(EF : TExportFieldItem); virtual;
// Format field as string, according to settings // Format field as UTF8 string, according to settings
Function FormatField(F : TField) : String; virtual; Function FormatField(F : TField) : UTF8String; virtual;
// Raise EDataExporter error // Raise EDataExporter error
Procedure ExportError(Msg : String); overload; Procedure ExportError(Msg : String); overload;
Procedure ExportError(Fmt : String; Args: Array of const); overload; Procedure ExportError(Fmt : String; Args: Array of const); overload;
@ -581,7 +581,7 @@ begin
// Do nothing // Do nothing
end; end;
Function TCustomDatasetExporter.FormatField(F: TField) : String; Function TCustomDatasetExporter.FormatField(F: TField) : UTF8String;
Var Var
FS : TFormatSettings; FS : TFormatSettings;
@ -594,7 +594,7 @@ begin
else if FormatSettings.UseDisplayText then else if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end end
else if (F.DataType=ftBoolean) then else if (F.DataType=ftBoolean) then
begin begin
@ -606,7 +606,7 @@ begin
if FormatSettings.UseDisplayText then if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end end
else if (F.DataType=ftDate) then else if (F.DataType=ftDate) then
begin begin
@ -615,7 +615,7 @@ begin
else if FormatSettings.UseDisplayText then else if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end end
else if (F.DataType=ftTime) then else if (F.DataType=ftTime) then
begin begin
@ -624,7 +624,7 @@ begin
else if FormatSettings.UseDisplayText then else if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end end
else if (F.DataType in [ftDateTime,ftTimeStamp]) then else if (F.DataType in [ftDateTime,ftTimeStamp]) then
begin begin
@ -633,7 +633,7 @@ begin
else if FormatSettings.UseDisplayText then else if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end end
else if (F.DataType=ftCurrency) then else if (F.DataType=ftCurrency) then
begin begin
@ -646,12 +646,12 @@ begin
else if FormatSettings.UseDisplayText then else if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end end
else if FormatSettings.UseDisplayText then else if FormatSettings.UseDisplayText then
Result:=F.DisplayText Result:=F.DisplayText
else else
Result:=F.AsString; Result:=F.AsUTF8String;
end; end;
procedure TCustomDatasetExporter.ExportError(Msg: String); procedure TCustomDatasetExporter.ExportError(Msg: String);

38
packages/fcl-db/src/export/fprtfexport.pp
View File

@ -50,10 +50,10 @@ Type
FTH : String; // Table header row FTH : String; // Table header row
FTN : String; // Tabular environment name (for closing) FTN : String; // Tabular environment name (for closing)
function GetRTFFormatsettings: TRTFExportFormatSettings; function GetRTFFormatsettings: TRTFExportFormatSettings;
function MakeCell(S: String; LineBefore, LineAfter: Boolean): string; function MakeCell(S: UTF8String; LineBefore, LineAfter: Boolean): string;
procedure SetRTFFormatSettings(const AValue: TRTFExportFormatSettings); procedure SetRTFFormatSettings(const AValue: TRTFExportFormatSettings);
Protected Protected
function EscapeRTF(S: String): String; function EscapeRTF(S: UTF8String): String;
procedure OutputRow(const ARow: String); virtual; procedure OutputRow(const ARow: String); virtual;
procedure OutputTableEnd; virtual; procedure OutputTableEnd; virtual;
procedure OutputTableStart; virtual; procedure OutputTableStart; virtual;
@ -108,29 +108,27 @@ begin
end; end;
{ TCustomRTFExporter } { TCustomRTFExporter }
function TCustomRTFExporter.EscapeRTF(S: String): String; function TCustomRTFExporter.EscapeRTF(S: UTF8String): String;
Var Const
I,J,L : Integer; NeedEscape : TSysCharSet = ['{', '}', '\'];
P : Pchar;
var
SS : UnicodeString;
Ch : UnicodeChar;
begin begin
I:=1; SS:=UTF8Decode(S);
J:=1;
Result:=''; Result:='';
L:=Length(S); For Ch in SS do
P:=PChar(S);
While I<=L do
begin begin
if (P^ in ['\','{','}']) then if CharInSet(Ch, NeedEscape) then
begin Result:=Result+'\';
Result:=Result+Copy(S,J,I-J)+'\'+P^; if Ord(Ch)>255 then
J:=I+1; Result:=Result+'\u'+IntToStr(Ord(Ch))+'?'
end; else
Inc(I); Result:=Result+Utf8Encode(Ch);
Inc(P);
end; end;
Result:=Result+Copy(S,J,I-1);
end; end;
function TCustomRTFExporter.GetRTFFormatsettings: TRTFExportFormatSettings; function TCustomRTFExporter.GetRTFFormatsettings: TRTFExportFormatSettings;
@ -275,7 +273,7 @@ begin
inherited DoDataRowStart; inherited DoDataRowStart;
end; end;
Function TCustomRTFExporter.MakeCell(S : String; LineBefore,LineAfter : Boolean) : string; Function TCustomRTFExporter.MakeCell(S : UTF8String; LineBefore,LineAfter : Boolean) : string;
begin begin
Result:='\pard\intbl '+EscapeRTF(S)+'\cell'; Result:='\pard\intbl '+EscapeRTF(S)+'\cell';