Browse Source

* Add column separator

git-svn-id: trunk@43558 -
michael 5 years ago
parent
commit
cf203a6590
2 changed files with 91 additions and 1 deletions
  1. 15 0
      packages/fcl-db/src/export/fpfixedexport.pp
  2. 76 1
      packages/fcl-db/tests/testdbexport.pas

+ 15 - 0
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;
 

+ 76 - 1
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 TestFixedTextExportUTF16;
     procedure TestFixedTextExportBoolean;
     procedure TestFixedTextExportHeader;
+    procedure TestFixedTextExportSpaces;
     procedure TestJSONExport;
     procedure TestRTFExport;
     procedure TestSQLExport;
@@ -170,7 +172,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;
@@ -712,6 +714,37 @@ begin
   Result:=DS;
 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.TestFixedTextExportBoolean;
 var
   DS : TBufDataset;
@@ -794,6 +827,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;