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

* Fix writing of special chars (bug ID 0036470)

Browse Source 
git-svn-id: trunk@43713 -
This commit is contained in:
michael 2019-12-23 13:05:59 +00:00
parent 8b24033e93
commit 5edf438489
3 changed files with 70 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -814,6 +814,7 @@ begin
OpenStream;
AssignStream(FTextFile,Stream);
Rewrite(FTextFile);
SetTextCodePage(FTextFile,CP_UTF8);
FTextFileOpen:=True;
end;

41
packages/fcl-db/src/export/fpsimplexmlexport.pp
View File

@ -28,19 +28,19 @@ Type
{ TCustomSimpleXMlExporter }
TCustomSimpleXMLExporter = Class(TCustomFileExporter)
Private
FCurrentRow : String;
FIndent : String;
FRowElementName : String;
FRootNode : String;
FCurrentRow : UTF8String;
FIndent : UTF8String;
FRowElementName : UTF8String;
FRootNode : UTF8String;
FAA : Boolean;
FIS : Integer;
function AttrString(S: String): String;
function AttrString(S: UTF8String): UTF8String;
procedure DecIndent;
function GetXMLFormatsettings: TSimpleXMLFormatSettings;
procedure IncIndent;
procedure OutputRow(const ARow: String);
procedure OutputRow(const ARow: UTF8String);
procedure SetXMLFormatSettings(const AValue: TSimpleXMLFormatSettings);
function TextString(S: String): String;
function TextString(S: UTF8String): UTF8String;
Protected
Function CreateFormatSettings : TCustomExportFormatSettings; override;
Procedure DoBeforeExecute; override;
@ -79,7 +79,7 @@ implementation
{ TCustomSimpleXMLExporter }
procedure TCustomSimpleXMLExporter.OutputRow(const ARow: String);
procedure TCustomSimpleXMLExporter.OutputRow(const ARow: UTF8String);
begin
Writeln(TextFile,FIndent,ARow);
end;
@ -134,21 +134,21 @@ begin
end;
const
QuotStr = '"';
AmpStr = '&';
ltStr = '<';
gtStr = '>';
QuotStr : UTF8String = '"';
AmpStr : UTF8String = '&';
ltStr : UTF8String = '<';
gtStr : UTF8String = '>';
Procedure AddToResult(Var Res : String; S : String; P : integer; Var J : Integer; Const Add : String);
Procedure AddToResult(Var Res : UTF8String; S : UTF8String; P : integer; Var J : Integer; Const Add : UTF8String);
begin
Res:=Res+Copy(S,J,P-J+1);
Res:=Res+Copy(S,J,P-J);
If (Add<>'') then
Res:=Res+Add;
J:=P+1;
end;
Function TCustomSimpleXMLExporter.AttrString(S : String) : String;
Function TCustomSimpleXMLExporter.AttrString(S : UTF8String) : UTF8String;
Var
I,J : Integer;
@ -169,7 +169,7 @@ begin
AddToResult(Result,S,Length(S)+1,J,'');
end;
Function TCustomSimpleXMLExporter.TextString(S : String) : String;
Function TCustomSimpleXMLExporter.TextString(S : UTF8String) : UTF8String;
Var
@ -204,12 +204,11 @@ end;
procedure TCustomSimpleXMLExporter.DoDataHeader;
Var
S : String;
S : UTF8String;
P : Integer;
begin
// Proper UTF-8 support would be good.
Writeln(TextFile,'<?xml version="1.0" encoding = "ISO 8859-1" ?>');
Writeln(TextFile,'<?xml version="1.0" encoding = "utf-8" ?>');
S:=FRootNode;
if S[Length(S)]<>'/' then
S:=S+'/';
@ -227,7 +226,7 @@ procedure TCustomSimpleXMLExporter.DoDataFooter;
Var
P,L : Integer;
S : String;
S : UTF8String;
begin
S:=FRootNode;
@ -251,7 +250,7 @@ end;
procedure TCustomSimpleXMLExporter.ExportField(EF: TExportFieldItem);
Var
S : String;
S : UTF8String;
begin
S:=FormatField(EF.Field);

50
packages/fcl-db/tests/testdbexport.pas
View File

@ -70,6 +70,7 @@ type
procedure TestSQLExport;
procedure TestTeXExport;
procedure TestXMLExport; //tests simple xml export
procedure TestXMLExportSpecialChars;
procedure TestXSDExport_Access_NoXSD_DecimalOverride; //tests xmlxsd export
procedure TestXSDExport_Access_NoXSD_NoDecimalOverride; //tests xmlxsd export
procedure TestXSDExport_Access_XSD_DecimalOverride; //tests xmlxsd export
@ -82,6 +83,9 @@ type
implementation
uses xmlread,dom;
function TTestDBExport.FieldSupported(const FieldType: TFieldType;
const ExportSubFormat: TDetailedExportFormats): boolean;
const
@ -174,7 +178,7 @@ begin
DBConnector.StartTest(TestName);
FExportTempDir:=IncludeTrailingPathDelimiter(ExpandFileName(''))+'exporttests'+PathDelim; //Store output in subdirectory
ForceDirectories(FExportTempDir);
// FKeepFilesAfterTest:=true; //keep test files; consistent with other units right now
FKeepFilesAfterTest:=true; //keep test files; consistent with other units right now
end;
procedure TTestDBExport.TearDown;
@ -1076,6 +1080,50 @@ begin
end;
end;
procedure TTestDBExport.TestXMLExportSpecialChars;
var
Exporter: TSimpleXMLExporter;
FieldMapping: TExportFields;
NumberExported: integer;
i: integer;
XML : TXMLDocument;
begin
XML:=Nil;
Exporter := TSimpleXMLExporter.Create(nil);
FieldMapping:=TExportFields.Create(Exporter.ExportFields.ItemClass);
try
Exporter.Dataset := DBConnector.GetFieldDataset;
Exporter.Dataset.Open;
Exporter.Dataset.Edit;
Exporter.Dataset.FieldByName('FString').AsString:='*&*<*>*';
Exporter.Dataset.Post;
Exporter.BuildDefaultFieldMap(FieldMapping);
Exporter.FileName := FExportTempDir + lowercase(rightstr(TestName,5)) + TDetailedExportExtensions[efXML];
for i:=Exporter.Dataset.Fields.Count-1 downto 0 do
begin
if not FieldSupported(
Exporter.Dataset.Fields[i].DataType,
efXML) then
FieldMapping.Delete(i);
end;
for i:=0 to FieldMapping.Count-1 do
Exporter.ExportFields.Add.Assign(FieldMapping[i]);
NumberExported := Exporter.Execute;
Exporter.Dataset.Last;
Exporter.Dataset.First;
AssertEquals('Number of records exported matches recordcount', NumberExported,
Exporter.Dataset.RecordCount);
Exporter.Dataset.Close;
ReadXMLFile(XML,Exporter.FileName);
AssertEquals('Correct written','*&*<*>*',XML.DocumentElement.FirstChild.FirstChild.NextSibling.FirstChild.NodeValue);
finally
XML.Free;
FieldMapping.Free;
Exporter.Free;
end;
end;
procedure TTestDBExport.TestXSDExport_DelphiClientDataset;
var
Exporter: TXMLXSDExporter;