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

* Explicitly use UTF8, fix bug ID : 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
packages/fcl-db/src/export
fpdbexport.ppfprtfexport.pp

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

@ -156,8 +156,8 @@ Type
Procedure DoProgress(ItemNo : Integer); Virtual;
// Override if each field can be written as-is.
Procedure ExportField(EF : TExportFieldItem); virtual;
// Format field as string, according to settings
Function FormatField(F : TField) : String; virtual;
// Format field as UTF8 string, according to settings
Function FormatField(F : TField) : UTF8String; virtual;
// Raise EDataExporter error
Procedure ExportError(Msg : String); overload;
Procedure ExportError(Fmt : String; Args: Array of const); overload;
@ -581,7 +581,7 @@ begin
// Do nothing
end;
Function TCustomDatasetExporter.FormatField(F: TField) : String;
Function TCustomDatasetExporter.FormatField(F: TField) : UTF8String;
Var
FS : TFormatSettings;
@ -594,7 +594,7 @@ begin
else if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end
else if (F.DataType=ftBoolean) then
begin
@ -606,7 +606,7 @@ begin
if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end
else if (F.DataType=ftDate) then
begin
@ -615,7 +615,7 @@ begin
else if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end
else if (F.DataType=ftTime) then
begin
@ -624,7 +624,7 @@ begin
else if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end
else if (F.DataType in [ftDateTime,ftTimeStamp]) then
begin
@ -633,7 +633,7 @@ begin
else if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end
else if (F.DataType=ftCurrency) then
begin
@ -646,12 +646,12 @@ begin
else if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end
else if FormatSettings.UseDisplayText then
Result:=F.DisplayText
else
Result:=F.AsString;
Result:=F.AsUTF8String;
end;
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
FTN : String; // Tabular environment name (for closing)
function GetRTFFormatsettings: TRTFExportFormatSettings;
function MakeCell(S: String; LineBefore, LineAfter: Boolean): string;
function MakeCell(S: UTF8String; LineBefore, LineAfter: Boolean): string;
procedure SetRTFFormatSettings(const AValue: TRTFExportFormatSettings);
Protected
function EscapeRTF(S: String): String;
function EscapeRTF(S: UTF8String): String;
procedure OutputRow(const ARow: String); virtual;
procedure OutputTableEnd; virtual;
procedure OutputTableStart; virtual;
@ -108,29 +108,27 @@ begin
end;
{ TCustomRTFExporter }
function TCustomRTFExporter.EscapeRTF(S: String): String;
function TCustomRTFExporter.EscapeRTF(S: UTF8String): String;
Var
I,J,L : Integer;
P : Pchar;
Const
NeedEscape : TSysCharSet = ['{', '}', '\'];
var
SS : UnicodeString;
Ch : UnicodeChar;
begin
I:=1;
J:=1;
SS:=UTF8Decode(S);
Result:='';
L:=Length(S);
P:=PChar(S);
While I<=L do
For Ch in SS do
begin
if (P^ in ['\','{','}']) then
begin
Result:=Result+Copy(S,J,I-J)+'\'+P^;
J:=I+1;
end;
Inc(I);
Inc(P);
if CharInSet(Ch, NeedEscape) then
Result:=Result+'\';
if Ord(Ch)>255 then
Result:=Result+'\u'+IntToStr(Ord(Ch))+'?'
else
Result:=Result+Utf8Encode(Ch);
end;
Result:=Result+Copy(S,J,I-1);
end;
function TCustomRTFExporter.GetRTFFormatsettings: TRTFExportFormatSettings;
@ -275,7 +273,7 @@ begin
inherited DoDataRowStart;
end;
Function TCustomRTFExporter.MakeCell(S : String; LineBefore,LineAfter : Boolean) : string;
Function TCustomRTFExporter.MakeCell(S : UTF8String; LineBefore,LineAfter : Boolean) : string;
begin
Result:='\pard\intbl '+EscapeRTF(S)+'\cell';