* Fix bug ID #36304: add charmode to fixed length data export

git-svn-id: trunk@43467 -

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

@@ -69,12 +69,14 @@ Type
     FCurrencySymbol : String;
     FDateFormat : String;
     FIntegerFormat: String;
+    FHandleNullField: Boolean;
     FTimeFormat : String;
     FDateTimeFormat : String;
     FDecimalSeparator: Char;
     FUseDisplayText : Boolean;
   Protected
     Procedure InitSettings; virtual;
+    Property HandleNullField : Boolean Read FHandleNullField Write FHandleNullField;
     Property UseDisplayText : Boolean Read FUseDisplayText Write FUseDisplayText;
     Property IntegerFormat : String Read FIntegerFormat Write FIntegerFormat;
     Property DecimalSeparator : Char Read FDecimalSeparator Write FDecimalSeparator;
@@ -295,6 +297,7 @@ Procedure UnRegisterExportFormat(Const AName : String);
 Const
   StringFieldTypes = [ftString,ftFixedChar,ftWidestring,ftFixedWideChar];
   IntFieldTypes    = [ftInteger,ftWord,ftSmallint,ftAutoinc];
+  FloatFieldTypes = [ftFloat, ftCurrency, ftFMTBcd, ftBCD];
   OrdFieldTypes    = IntFieldTypes +[ftBoolean,ftLargeInt];
   DateFieldTypes   = [ftDate,ftTime,ftDateTime,ftTimeStamp];
   MemoFieldTypes   = [ftMemo,ftFmtMemo,ftWideMemo];
@@ -587,9 +590,11 @@ Var
   FS : TFormatSettings;
 
 begin
+  if F.IsNull and FormatSettings.HandleNullField then
+    Exit('');
   If (F.DataType in IntFieldTypes) then
     begin
-    If (FormatSettings.IntegerFormat)<>'' then
+    If ((FormatSettings.IntegerFormat)<>'') and (not F.IsNull) then
       Result:=Format(FormatSettings.IntegerFormat,[F.AsInteger])
     else if FormatSettings.UseDisplayText then
       Result:=F.DisplayText
@@ -598,10 +603,11 @@ begin
     end
   else if (F.DataType=ftBoolean) then
     begin
-    If F.AsBoolean then
-      Result:=FormatSettings.BooleanTrue
-    else
-      Result:=FormatSettings.BooleanFalse;
+    if (Not F.IsNull) then
+      If F.AsBoolean then
+        Result:=FormatSettings.BooleanTrue
+      else
+        Result:=FormatSettings.BooleanFalse;
     If (Result='') then
       if FormatSettings.UseDisplayText then
         Result:=F.DisplayText
@@ -610,7 +616,7 @@ begin
     end
   else if (F.DataType=ftDate) then
     begin
-    If (FormatSettings.DateFormat<>'') then
+    If (FormatSettings.DateFormat<>'') and (not F.IsNull) then
       Result:=FormatDateTime(FormatSettings.DateFormat,F.AsDateTime)
     else if FormatSettings.UseDisplayText then
       Result:=F.DisplayText
@@ -619,7 +625,7 @@ begin
     end
   else if (F.DataType=ftTime) then
     begin
-    If (FormatSettings.TimeFormat<>'') then
+    If (FormatSettings.TimeFormat<>'') and (not F.IsNull) then
       Result:=FormatDateTime(FormatSettings.TimeFormat,F.AsDateTime)
     else if FormatSettings.UseDisplayText then
       Result:=F.DisplayText
@@ -628,7 +634,7 @@ begin
     end
   else if (F.DataType in [ftDateTime,ftTimeStamp]) then
     begin
-    If (FormatSettings.DateTimeFormat<>'') then
+    If (FormatSettings.DateTimeFormat<>'') and (not F.IsNull) then
       Result:=FormatDateTime(FormatSettings.DateTimeFormat,F.AsDateTime)
     else if FormatSettings.UseDisplayText then
       Result:=F.DisplayText
@@ -637,13 +643,13 @@ begin
     end 
   else if (F.DataType=ftCurrency) then
     begin
-    If (FormatSettings.CurrencySymbol<>'') then
+    If (FormatSettings.CurrencySymbol<>'') and (not F.IsNull) then
       begin
       FS:=DefaultFormatSettings;
       FS.CurrencyString:=FormatSettings.CurrencySymbol;
       Result:=CurrToStrF(F.AsCurrency,ffCurrency,FormatSettings.CurrencyDigits,FS);
       end
-    else  if FormatSettings.UseDisplayText then
+    else if FormatSettings.UseDisplayText then
       Result:=F.DisplayText
     else 
       Result:=F.AsUTF8String;
@@ -839,6 +845,7 @@ end;
 procedure TCustomExportFormatSettings.InitSettings;
 begin
   FIntegerFormat:='%d';
+  FHandleNullField:=True;
   FDateFormat:=ShortDateFormat;
   FTimeFormat:=ShortTimeFormat;
   FDateTimeFormat:=ShortDateFormat+' '+ShortTimeFormat;
@@ -863,6 +870,7 @@ begin
   If (Source is TCustomExportFormatSettings) then
     begin
     FS:=Source as TCustomExportFormatSettings;
+    FHandleNullField:=FS.FHandleNullField;
     FBooleanFalse:=FS.FBooleanFalse;
     FBooleanTrue:=FS.FBooleanTrue;
     FCurrencyDigits:=FS.FCurrencyDigits;

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

@@ -22,22 +22,46 @@ Type
   end;
 
   { TCustomFixedLengthExporter }
+  TCharMode = (cmANSI,cmUTF8,cmUTF16);
+
+  { TFixedExportFormatSettings }
+
+  TFixedExportFormatSettings = Class (TCustomExportFormatSettings)
+  private
+    FCharMode: TCharMode;
+  Public
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    Property CharMode : TCharMode Read FCharMode Write FCharMode;
+  end;
 
   TCustomFixedLengthExporter = Class(TCustomFileExporter)
   Private
-    FCurrentRow : String;
-    procedure OutputRow(const ARow: String);
+    FCurrentRow : RawByteString;
+    FCurrentRowUnicode : UnicodeString;
+    function GetCharMode: TCharMode;
+    function GeTFixedExportFormatSettings: TFixedExportFormatSettings;
+    procedure SeTFixedExportFormatSettings(AValue: TFixedExportFormatSettings);
   Protected
+    function ExportFieldAsUniCodeString(EF: TExportFieldItem): UnicodeString; virtual;
+    procedure ExportFieldAnsi(EF: TExportFieldItem); virtual;
+    procedure ExportFieldUTF16(EF: TExportFieldItem); virtual;
+    procedure ExportFieldUTF8(EF: TExportFieldItem); virtual;
     Procedure BuildDefaultFieldMap(AMap : TExportFields); override;
     Function  CreateExportFields : TExportFields; override;
+    Function  CreateFormatSettings: TCustomExportFormatSettings; override;
     Procedure DoBeforeExecute; override;
     Procedure DoAfterExecute; override;
     Procedure DoDataRowStart; override;
     Procedure ExportField(EF : TExportFieldItem); override;
     Procedure DoDataRowEnd; override;
+    Property CharMode : TCharMode Read GetCharMode;
+    Property FixedFormatSettings : TFixedExportFormatSettings Read GeTFixedExportFormatSettings Write SeTFixedExportFormatSettings;
   end;
 
   TFixedLengthExporter = Class(TCustomFixedLengthExporter)
+  Public
+    Property FixedFormatSettings;
   Published
     Property FileName;
     Property Dataset;
@@ -62,6 +86,15 @@ Resourcestring
 
 implementation
 
+{ TFixedExportFormatSettings }
+
+procedure TFixedExportFormatSettings.Assign(Source: TPersistent);
+begin
+  if (Source is TFixedExportFormatSettings) then
+    CharMode:=TFixedExportFormatSettings(Source).CharMode;
+  inherited Assign(Source);
+end;
+
 { TFixedLengthExportFieldItem }
 
 procedure TFixedLengthExportFieldItem.Assign(Source: TPersistent);
@@ -81,14 +114,27 @@ end;
 
 { TCustomFixedLengthExporter }
 
-procedure TCustomFixedLengthExporter.OutputRow(const ARow: String);
+
+procedure TCustomFixedLengthExporter.SeTFixedExportFormatSettings(AValue: TFixedExportFormatSettings);
 begin
-  Writeln(TextFile,ARow);
+  FormatSettings:=AValue;
+end;
+
+function TCustomFixedLengthExporter.GetCharMode: TCharMode;
+begin
+  Result:=FixedFormatSettings.CharMode;
+end;
+
+function TCustomFixedLengthExporter.GeTFixedExportFormatSettings: TFixedExportFormatSettings;
+begin
+  Result:=Formatsettings as TFixedExportFormatSettings;
 end;
 
 procedure TCustomFixedLengthExporter.BuildDefaultFieldMap(AMap: TExportFields);
 
 Const
+  RightAlignedFields = IntFieldTypes+FloatFieldTypes;
+
   // Mapping to TFieldType
   FieldWidths : Array[TFieldType] of integer =
     (
@@ -153,7 +199,7 @@ begin
       if (F.DataType in StringFieldTypes) then
         FL.Width:=F.Size;
       end;
-    If (F.DataType in IntFieldTypes) then
+    If (F.DataType in RightAlignedFields) then
       Fl.AlignField:=afRight;
     end;
 end;
@@ -163,6 +209,11 @@ begin
   Result:=TExportFields.Create(TFixedLengthExportFieldItem);
 end;
 
+function TCustomFixedLengthExporter.CreateFormatSettings: TCustomExportFormatSettings;
+begin
+  Result:=TFixedExportFormatSettings.Create(True);
+end;
+
 procedure TCustomFixedLengthExporter.DoBeforeExecute;
 begin
   inherited DoBeforeExecute;
@@ -183,6 +234,66 @@ end;
 
 procedure TCustomFixedLengthExporter.ExportField(EF: TExportFieldItem);
 
+begin
+  Case CharMode of
+    cmANSI : ExportFieldAnsi(EF);
+    cmUTF8 : ExportFieldUTF8(EF);
+    cmUTF16 : ExportFieldUTF16(EF);
+  end;
+end;
+
+
+Function TCustomFixedLengthExporter.ExportFieldAsUniCodeString(EF: TExportFieldItem) : UnicodeString;
+
+Var
+  S,SS : UnicodeString;
+  FL : TFixedLengthExportFieldItem;
+  L,W : Integer;
+
+begin
+  S:=UTF8Decode(FormatField(EF.Field));
+  If EF is TFixedLengthExportFieldItem then
+    begin
+    FL:=TFixedLengthExportFieldItem(EF);
+    W:=FL.Width;
+    end
+  else
+    W:=Length(S);
+  L:=Length(S);
+  If L>W then
+    begin
+    If (FL.AlignField=afLeft) then
+      S:=Copy(S,1,W)
+    else
+      Delete(S,1,L-W);
+    end
+  else if (L<W) then
+    begin
+    SS:=StringOfChar(' ',W-L);
+    If FL.AlignField=afRight then
+      S:=SS+S
+    else
+      S:=S+SS;
+    end;
+  Result:=S;
+end;
+
+procedure TCustomFixedLengthExporter.ExportFieldUTF16(EF: TExportFieldItem);
+
+begin
+  FCurrentRowUnicode:=FCurrentRowUnicode+ExportFieldAsUnicodeString(EF);
+end;
+
+
+procedure TCustomFixedLengthExporter.ExportFieldUTF8(EF: TExportFieldItem);
+
+
+begin
+  FCurrentRow:=FCurrentRow+UTF8Encode(ExportFieldAsUnicodeString(EF));
+end;
+
+procedure TCustomFixedLengthExporter.ExportFieldAnsi(EF: TExportFieldItem);
+
 Var
   S,SS : String;
   W,L : Integer;
@@ -218,8 +329,12 @@ end;
 
 procedure TCustomFixedLengthExporter.DoDataRowEnd;
 begin
-  OutputRow(FCurrentRow);
+  if (CharMode<>cmUTF16) then
+    Writeln(TextFile,FCurrentRow)
+  else
+    Writeln(TextFile,FCurrentRowUnicode);
   FCurrentRow:='';
+  FCurrentRowUnicode:='';
 end;
 
 Procedure RegisterFixedExportFormat;

packages/fcl-db/tests/testdbexport.pas

@@ -43,6 +43,7 @@ type
       const ExportSubFormat: TDetailedExportFormats): boolean; //Checks if output dataset supports a certain field type
     procedure GenericExportTest(Exporter: TCustomDatasetExporter; ExportFormat: TDetailedExportFormats);
     function GetFileSize(const FileName: string): integer; //Gets a file's size
+    function GetWideStringDS: TBufDataset;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -55,6 +56,8 @@ type
     procedure TestCSVExport_RFC4180WithHeader; //tests csv export with settings that match RFC4180
     procedure TestCSVExport_TweakSettingsSemicolon; //tests semicolon delimited, custom country values
     procedure TestFixedTextExport;
+    procedure TestFixedTextExportUTF8;
+    procedure TestFixedTextExportUTF16;
     procedure TestJSONExport;
     procedure TestRTFExport;
     procedure TestSQLExport;
@@ -102,11 +105,9 @@ begin
     efTeX: result:=true;
     efXML: result:=true;
     efXMLXSDAccess, efXMLXSDADONet, efXMLXSDClientDataset, efXMLXSDExcel: result:=true;
-    else
-    begin
-      result:=false;
-      Fail('Error in test code itself: FieldSupported unknown ExportSubFormat '+inttostr(ord(ExportSubFormat)));
-    end;
+  else
+    result:=false;
+    Fail('Error in test code itself: FieldSupported unknown ExportSubFormat '+inttostr(ord(ExportSubFormat)));
   end;
 end;
 
@@ -166,7 +167,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;
@@ -565,6 +566,125 @@ begin
   end;
 end;
 
+Const
+  // UTF8 code page assumed !
+  WidestringLine1 = '这是一个测验';
+  WidestringLine2 = 'Это тест.';
+  WidestringLine3 = 'ça roule.';
+  WidestringResLine1 = '这是一';
+  WidestringResLine2 = 'Это';
+  WidestringResLine3 = 'ça ';
+
+Function TTestDBExport.GetWideStringDS : TBufDataset;
+
+Var
+  DS : TBufDataset;
+
+begin
+  DS:=TBufDataset.Create(Nil);
+  try
+    DS.FieldDefs.Add('F',ftWideString,10);
+    DS.CreateDataset;
+    DS.Append;
+    DS.Fields[0].AsWideString:=UTF8Decode(WideStringLine1);
+    DS.Post;
+    DS.Append;
+    DS.Fields[0].AsWideString:=UTF8Decode(WideStringLine2);
+    DS.Post;
+    DS.Append;
+    DS.Fields[0].AsWideString:=UTF8Decode(WideStringLine3);
+    DS.Post;
+    DS.First;
+  except
+    DS.Free;
+    Raise;
+  end;
+  Result:=DS;
+end;
+
+
+procedure TTestDBExport.TestFixedTextExportUTF8;
+
+var
+  DS : TBufDataset;
+  Exporter: TFixedLengthExporter;
+  F : text;
+  S : UTF8String;
+  haveFile : Boolean;
+
+begin
+  haveFile:=False;
+  Exporter:=Nil;
+  DS:=GetWideStringDS;
+  try
+    Exporter := TFixedLengthExporter.Create(nil);
+    Exporter.Dataset:=DS;
+    Exporter.FixedFormatSettings.CharMode:=cmUTF8;
+    Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt';
+    Exporter.BuildDefaultFieldMap(Exporter.ExportFields);
+    TFixedLengthExportFieldItem(Exporter.ExportFields[0]).Width:=3;
+    AssertEquals('Output count',3,Exporter.Execute);
+    AssertTrue('Output file must be created', FileExists(Exporter.FileName));
+    AssertFalse('Output file must not be empty', (GetFileSize(Exporter.FileName) = 0));
+    AssignFile(F,Exporter.FileName);
+    Reset(F);
+    haveFile:=True;
+    Readln(F,S);
+    AssertEquals('Correct first line',UTF8Decode(WideStringResLine1),UTF8Decode(S));
+    Readln(F,S);
+    AssertEquals('Correct second line',UTF8Decode(WideStringResLine2),UTF8Decode(S));
+    Readln(F,S);
+    AssertEquals('Correct second line',UTF8Decode(WideStringResLine3),UTF8Decode(S));
+  finally
+    if HaveFile then
+      closeFile(F);
+    if (FKeepFilesAfterTest = False) then
+      DeleteFile(Exporter.FileName);
+    Exporter.Free;
+  end;
+end;
+
+procedure TTestDBExport.TestFixedTextExportUTF16;
+
+var
+  DS : TBufDataset;
+  Exporter: TFixedLengthExporter;
+  F : text;
+  S : UnicodeString;
+  haveFile : Boolean;
+
+begin
+  haveFile:=False;
+  Exporter:=Nil;
+  DS:=GetWideStringDS;
+  try
+    Exporter := TFixedLengthExporter.Create(nil);
+    Exporter.Dataset:=DS;
+    Exporter.FixedFormatSettings.CharMode:=cmUTF16;
+    Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt';
+    Exporter.BuildDefaultFieldMap(Exporter.ExportFields);
+    TFixedLengthExportFieldItem(Exporter.ExportFields[0]).Width:=3;
+    AssertEquals('Output count',3,Exporter.Execute);
+    AssertTrue('Output file must be created', FileExists(Exporter.FileName));
+    AssertFalse('Output file must not be empty', (GetFileSize(Exporter.FileName) = 0));
+    AssignFile(F,Exporter.FileName);
+    Reset(F);
+    haveFile:=True;
+    Readln(F,S);
+    AssertEquals('Correct first line',UTF8Decode(WideStringResLine1),S);
+    Readln(F,S);
+    AssertEquals('Correct second line',UTF8Decode(WideStringResLine2),S);
+    Readln(F,S);
+    AssertEquals('Correct second line',UTF8Decode(WideStringResLine3),S);
+  finally
+    if HaveFile then
+      closeFile(F);
+    if (FKeepFilesAfterTest = False) then
+      DeleteFile(Exporter.FileName);
+    Exporter.Free;
+  end;
+end;
+
 procedure TTestDBExport.TestJSONExport;
 var
   Exporter: TSimpleJSONExporter;