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

* Merging revisions r43558 from trunk:

Browse Source 
------------------------------------------------------------------------
    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 -
This commit is contained in:
michael 2019-12-23 14:16:30 +00:00
parent 20b8a0c49b
commit 40d9899d65
2 changed files with 90 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
packages/fcl-db/src/export/fpfixedexport.pp
View File

@ -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
packages/fcl-db/tests/testdbexport.pas
View File

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