* Fix writing of special chars (bug ID 0036470)

git-svn-id: trunk@43713 -

packages/fcl-db/src/export/fpdbexport.pp

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

packages/fcl-db/src/export/fpsimplexmlexport.pp

@@ -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);

packages/fcl-db/tests/testdbexport.pas

@@ -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;