From 40d9899d6549208925d9cc46357c5719e70abbf6 Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 23 Dec 2019 14:16:30 +0000 Subject: [PATCH] * Merging revisions r43558 from trunk: ------------------------------------------------------------------------ r43558 | michael | 2019-11-22 16:15:15 +0100 (Fri, 22 Nov 2019) | 1 line * Add column separator ------------------------------------------------------------------------ git-svn-id: branches/fixes_3_2@43762 - --- packages/fcl-db/src/export/fpfixedexport.pp | 15 ++++ packages/fcl-db/tests/testdbexport.pas | 76 ++++++++++++++++++++- 2 files changed, 90 insertions(+), 1 deletion(-) diff --git a/packages/fcl-db/src/export/fpfixedexport.pp b/packages/fcl-db/src/export/fpfixedexport.pp index 99b9680698..829d06002e 100644 --- a/packages/fcl-db/src/export/fpfixedexport.pp +++ b/packages/fcl-db/src/export/fpfixedexport.pp @@ -29,6 +29,7 @@ Type TFixedExportFormatSettings = Class (TExportFormatSettings) private FCharMode: TCharMode; + FColumnSeparatorSpaceCount: Integer; FHeaderRow: Boolean; Public Procedure Assign(Source: TPersistent); override; @@ -37,12 +38,16 @@ Type Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true; // How to handle Unicode ? Property CharMode : TCharMode Read FCharMode Write FCharMode; + // Number of separator spaces between columns. Default 0. + Property ColumnSeparatorSpaceCount : Integer Read FColumnSeparatorSpaceCount Write FColumnSeparatorSpaceCount; end; TCustomFixedLengthExporter = Class(TCustomFileExporter) Private FCurrentRow : RawByteString; FCurrentRowUnicode : UnicodeString; + FSpaces : RawByteString; + FSpacesUnicode : UnicodeString; function GetCharMode: TCharMode; function GeTFixedExportFormatSettings: TFixedExportFormatSettings; procedure SetFixedExportFormatSettings(AValue: TFixedExportFormatSettings); @@ -99,6 +104,7 @@ begin begin CharMode:=TFixedExportFormatSettings(Source).CharMode; HeaderRow:=TFixedExportFormatSettings(Source).HeaderRow; + ColumnSeparatorSpaceCount:=TFixedExportFormatSettings(Source).ColumnSeparatorSpaceCount; end; inherited Assign(Source); end; @@ -252,6 +258,8 @@ procedure TCustomFixedLengthExporter.DoBeforeExecute; begin inherited DoBeforeExecute; OpenTextFile; + FSpaces:=StringOfChar(' ',FormatSettings.ColumnSeparatorSpaceCount); + FSpacesUnicode:=StringOfChar(' ',FormatSettings.ColumnSeparatorSpaceCount); end; procedure TCustomFixedLengthExporter.DoAfterExecute; @@ -318,6 +326,9 @@ end; procedure TCustomFixedLengthExporter.ExportFieldUTF16(EF: TExportFieldItem; isHeader : Boolean = False); begin + if (FormatSettings.ColumnSeparatorSpaceCount>0) and (Length(FCurrentRowUnicode)>0) then + FCurrentRowUnicode:=FCurrentRowUnicode+FSpacesUnicode; + FCurrentRowUnicode:=FCurrentRowUnicode+ExportFieldAsUnicodeString(EF,isHeader); end; @@ -326,6 +337,8 @@ procedure TCustomFixedLengthExporter.ExportFieldUTF8(EF: TExportFieldItem; isHea begin + if (FormatSettings.ColumnSeparatorSpaceCount>0) and (Length(FCurrentRow)>0) then + FCurrentRow:=FCurrentRow+FSpaces; FCurrentRow:=FCurrentRow+UTF8Encode(ExportFieldAsUnicodeString(EF,isHeader)); end; @@ -364,6 +377,8 @@ begin else S:=S+SS; end; + if (FormatSettings.ColumnSeparatorSpaceCount>0) and (Length(FCurrentRow)>0) then + FCurrentRow:=FCurrentRow+FSpaces; FCurrentRow:=FCurrentRow+S; end; diff --git a/packages/fcl-db/tests/testdbexport.pas b/packages/fcl-db/tests/testdbexport.pas index 3f0322a509..8e041b1a58 100644 --- a/packages/fcl-db/tests/testdbexport.pas +++ b/packages/fcl-db/tests/testdbexport.pas @@ -42,6 +42,7 @@ type function FieldSupported(const FieldType: TFieldType; const ExportSubFormat: TDetailedExportFormats): boolean; //Checks if output dataset supports a certain field type procedure GenericExportTest(Exporter: TCustomDatasetExporter; ExportFormat: TDetailedExportFormats); + function GetABCDS: TBufDataset; function GetBooleanDS: TBufDataset; function GetFileSize(const FileName: string): integer; //Gets a file's size function GetWideStringDS: TBufDataset; @@ -61,6 +62,7 @@ type procedure TestFixedTextExportUTF8; procedure TestFixedTextExportUTF16; procedure TestFixedTextExportHeader; + procedure TestFixedTextExportSpaces; procedure TestJSONExport; procedure TestRTFExport; procedure TestSQLExport; @@ -174,7 +176,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; @@ -755,6 +757,36 @@ begin end; end; +Function TTestDBExport.GetABCDS : TBufDataset; + +Var + DS : TBufDataset; + +begin + DS:=TBufDataset.Create(Nil); + try + DS.FieldDefs.Add('A',ftString,2); + DS.FieldDefs.Add('B',ftString,2); + DS.FieldDefs.Add('C',ftString,2); + DS.CreateDataset; + DS.Append; + DS.Fields[0].AsString:='xx'; + DS.Fields[1].AsString:='y'; + DS.Fields[2].AsString:='zz'; + DS.Post; + DS.Append; + DS.Fields[0].AsString:='x'; + DS.Fields[1].AsString:='yy'; + DS.Fields[2].AsString:='z'; + DS.Post; + DS.First; + except + DS.Free; + Raise; + end; + Result:=DS; +end; + procedure TTestDBExport.TestFixedTextExportHeader; @@ -799,6 +831,48 @@ begin end; end; +procedure TTestDBExport.TestFixedTextExportSpaces; +var + DS : TBufDataset; + Exporter: TFixedLengthExporter; + F : text; + S : UTF8String; + haveFile : Boolean; + +begin + haveFile:=False; + Exporter:=Nil; + DS:=GetABCDS; + try + Exporter := TFixedLengthExporter.Create(nil); + Exporter.FormatSettings.BooleanFalse:='false'; + Exporter.FormatSettings.BooleanTrue:='True'; + Exporter.FormatSettings.HeaderRow:=True; + Exporter.FormatSettings.ColumnSeparatorSpaceCount:=2; + Exporter.Dataset:=DS; + Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt'; + Exporter.BuildDefaultFieldMap(Exporter.ExportFields); + AssertEquals('Output count',2,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 header line','A B C ',S); // 1 extra + Readln(F,S); + AssertEquals('Correct first line','xx y zz',S); // 1 extra + Readln(F,S); + AssertEquals('Correct first line','x yy z ',S); // 1 extra + finally + if HaveFile then + closeFile(F); + if (FKeepFilesAfterTest = False) then + DeleteFile(Exporter.FileName); + Exporter.Free; + end; +end; + procedure TTestDBExport.TestJSONExport; var Exporter: TSimpleJSONExporter;