paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-26 01:10:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add header row

Browse Source 
git-svn-id: trunk@43557 -
This commit is contained in:
michael 2019-11-22 14:44:14 +00:00
parent 94e0b499df
commit 0c25ada935
3 changed files with 116 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/fcl-db/src/export/fpdbexport.pp
View File

@ -23,10 +23,10 @@ Type
FEnabled: Boolean;
FField: TField;
FFieldName: String;
FExportedName: String;
function GetExportedName: String;
FExportedName: UTF8String;
function GetExportedName: UTF8String;
function GetExporter: TCustomDatasetExporter;
procedure SetExportedName(const AValue: String);
procedure SetExportedName(const AValue: UTF8String);
Protected
Procedure BindField (ADataset : TDataset); virtual;
procedure SetFieldName(const AValue: String); virtual;
@ -38,7 +38,7 @@ Type
Published
Property Enabled : Boolean Read FEnabled Write FEnabled default True;
Property FieldName : String Read FFieldName Write SetFieldName;
Property ExportedName : String Read GetExportedName Write SetExportedName;
Property ExportedName : UTF8String Read GetExportedName Write SetExportedName;
end;
{ TExportFields }
@ -335,7 +335,7 @@ begin
FEnabled:=True;
end;
function TExportFieldItem.GetExportedName: String;
function TExportFieldItem.GetExportedName: UTF8String;
begin
Result:=FExportedName;
If (Result='') then
@ -348,7 +348,7 @@ begin
Result:=(Collection as TExportFields).Exporter;
end;
procedure TExportFieldItem.SetExportedName(const AValue: String);
procedure TExportFieldItem.SetExportedName(const AValue: UTF8String);
Var
I : TExportFieldItem;

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

@ -29,9 +29,13 @@ Type
TFixedExportFormatSettings = Class (TExportFormatSettings)
private
FCharMode: TCharMode;
FHeaderRow: Boolean;
Public
Procedure Assign(Source: TPersistent); override;
Published
// Whether or not the file should have a header row with field names
Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true;
// How to handle Unicode ?
Property CharMode : TCharMode Read FCharMode Write FCharMode;
end;
@ -41,12 +45,12 @@ Type
FCurrentRowUnicode : UnicodeString;
function GetCharMode: TCharMode;
function GeTFixedExportFormatSettings: TFixedExportFormatSettings;
procedure SeTFixedExportFormatSettings(AValue: 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;
function ExportFieldAsUniCodeString(EF: TExportFieldItem; isHeader: Boolean=False): UnicodeString; virtual;
procedure ExportFieldAnsi(EF: TExportFieldItem; isHeader: Boolean=False); virtual;
procedure ExportFieldUTF16(EF: TExportFieldItem; isHeader: Boolean=False); virtual;
procedure ExportFieldUTF8(EF: TExportFieldItem; isHeader: Boolean=False); virtual;
Procedure BuildDefaultFieldMap(AMap : TExportFields); override;
Function CreateExportFields : TExportFields; override;
Function CreateFormatSettings: TCustomExportFormatSettings; override;
@ -55,13 +59,12 @@ Type
Procedure DoDataRowStart; override;
Procedure ExportField(EF : TExportFieldItem); override;
Procedure DoDataRowEnd; override;
Procedure DoDataHeader; override;
Property CharMode : TCharMode Read GetCharMode;
Property FixedFormatSettings : TFixedExportFormatSettings Read GeTFixedExportFormatSettings Write SeTFixedExportFormatSettings;
Property FormatSettings : TFixedExportFormatSettings Read GetFixedExportFormatSettings Write SetFixedExportFormatSettings;
end;
TFixedLengthExporter = Class(TCustomFixedLengthExporter)
Public
Property FixedFormatSettings;
Published
Property FileName;
Property Dataset;
@ -93,7 +96,10 @@ uses math;
procedure TFixedExportFormatSettings.Assign(Source: TPersistent);
begin
if (Source is TFixedExportFormatSettings) then
begin
CharMode:=TFixedExportFormatSettings(Source).CharMode;
HeaderRow:=TFixedExportFormatSettings(Source).HeaderRow;
end;
inherited Assign(Source);
end;
@ -117,19 +123,19 @@ end;
{ TCustomFixedLengthExporter }
procedure TCustomFixedLengthExporter.SeTFixedExportFormatSettings(AValue: TFixedExportFormatSettings);
procedure TCustomFixedLengthExporter.SetFixedExportFormatSettings(AValue: TFixedExportFormatSettings);
begin
FormatSettings:=AValue;
Inherited FormatSettings:=AValue;
end;
function TCustomFixedLengthExporter.GetCharMode: TCharMode;
begin
Result:=FixedFormatSettings.CharMode;
Result:=FormatSettings.CharMode;
end;
function TCustomFixedLengthExporter.GeTFixedExportFormatSettings: TFixedExportFormatSettings;
begin
Result:=Formatsettings as TFixedExportFormatSettings;
Result:=(Inherited Formatsettings) as TFixedExportFormatSettings;
end;
procedure TCustomFixedLengthExporter.BuildDefaultFieldMap(AMap: TExportFields);
@ -190,12 +196,12 @@ Const
Case charmode of
cmUTF8:
begin
LTrue:=Length(UTF8Decode(FixedFormatSettings.BooleanTrue));
LFalse:=Length(UTF8Decode(FixedFormatSettings.BooleanFalse));
LTrue:=Length(UTF8Decode(FormatSettings.BooleanTrue));
LFalse:=Length(UTF8Decode(FormatSettings.BooleanFalse));
end;
else
LTrue:=Length(FixedFormatSettings.BooleanTrue);
LFalse:=Length(FixedFormatSettings.BooleanFalse);
LTrue:=Length(FormatSettings.BooleanTrue);
LFalse:=Length(FormatSettings.BooleanFalse);
end;
Result:=Max(LTrue,LFalse);
end;
@ -271,7 +277,7 @@ begin
end;
Function TCustomFixedLengthExporter.ExportFieldAsUniCodeString(EF: TExportFieldItem) : UnicodeString;
Function TCustomFixedLengthExporter.ExportFieldAsUniCodeString(EF: TExportFieldItem; isHeader : Boolean = False) : UnicodeString;
Var
S,SS : UnicodeString;
@ -279,7 +285,10 @@ Var
L,W : Integer;
begin
S:=UTF8Decode(FormatField(EF.Field));
if isHeader then
S:=UTF8Decode(EF.ExportedName)
else
S:=UTF8Decode(FormatField(EF.Field));
If EF is TFixedLengthExportFieldItem then
begin
FL:=TFixedLengthExportFieldItem(EF);
@ -306,21 +315,21 @@ begin
Result:=S;
end;
procedure TCustomFixedLengthExporter.ExportFieldUTF16(EF: TExportFieldItem);
procedure TCustomFixedLengthExporter.ExportFieldUTF16(EF: TExportFieldItem; isHeader : Boolean = False);
begin
FCurrentRowUnicode:=FCurrentRowUnicode+ExportFieldAsUnicodeString(EF);
FCurrentRowUnicode:=FCurrentRowUnicode+ExportFieldAsUnicodeString(EF,isHeader);
end;
procedure TCustomFixedLengthExporter.ExportFieldUTF8(EF: TExportFieldItem);
procedure TCustomFixedLengthExporter.ExportFieldUTF8(EF: TExportFieldItem; isHeader : Boolean = False);
begin
FCurrentRow:=FCurrentRow+UTF8Encode(ExportFieldAsUnicodeString(EF));
FCurrentRow:=FCurrentRow+UTF8Encode(ExportFieldAsUnicodeString(EF,isHeader));
end;
procedure TCustomFixedLengthExporter.ExportFieldAnsi(EF: TExportFieldItem);
procedure TCustomFixedLengthExporter.ExportFieldAnsi(EF: TExportFieldItem; isHeader : Boolean = False);
Var
S,SS : String;
@ -328,7 +337,10 @@ Var
FL : TFixedLengthExportFieldItem;
begin
S:=FormatField(EF.Field);
if isHeader then
S:=EF.ExportedName
else
S:=FormatField(EF.Field);
If EF is TFixedLengthExportFieldItem then
begin
FL:=TFixedLengthExportFieldItem(EF);
@ -365,6 +377,31 @@ begin
FCurrentRowUnicode:='';
end;
procedure TCustomFixedLengthExporter.DoDataHeader;
Var
I : Integer;
EF: TExportFieldItem;
begin
FCurrentRow:='';
if FormatSettings.HeaderRow then
begin
For I:=0 to ExportFields.Count-1 do
begin
EF:=ExportFields[I];
If EF.Enabled then
Case CharMode of
cmANSI : ExportFieldAnsi(EF,True);
cmUTF8 : ExportFieldUTF8(EF,True);
cmUTF16 : ExportFieldUTF16(EF,True);
end;
end;
DoDataRowEnd;
end;
inherited DoDataHeader;
end;
Procedure RegisterFixedExportFormat;
begin

54
packages/fcl-db/tests/testdbexport.pas
View File

@ -60,6 +60,7 @@ type
procedure TestFixedTextExportUTF8;
procedure TestFixedTextExportUTF16;
procedure TestFixedTextExportBoolean;
procedure TestFixedTextExportHeader;
procedure TestJSONExport;
procedure TestRTFExport;
procedure TestSQLExport;
@ -169,7 +170,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;
@ -621,7 +622,7 @@ begin
try
Exporter := TFixedLengthExporter.Create(nil);
Exporter.Dataset:=DS;
Exporter.FixedFormatSettings.CharMode:=cmUTF8;
Exporter.FormatSettings.CharMode:=cmUTF8;
Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt';
Exporter.BuildDefaultFieldMap(Exporter.ExportFields);
TFixedLengthExportFieldItem(Exporter.ExportFields[0]).Width:=3;
@ -662,7 +663,7 @@ begin
try
Exporter := TFixedLengthExporter.Create(nil);
Exporter.Dataset:=DS;
Exporter.FixedFormatSettings.CharMode:=cmUTF16;
Exporter.FormatSettings.CharMode:=cmUTF16;
Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt';
Exporter.BuildDefaultFieldMap(Exporter.ExportFields);
TFixedLengthExportFieldItem(Exporter.ExportFields[0]).Width:=3;
@ -725,8 +726,8 @@ begin
DS:=GetBooleanDS;
try
Exporter := TFixedLengthExporter.Create(nil);
Exporter.FixedFormatSettings.BooleanFalse:='false';
Exporter.FixedFormatSettings.BooleanTrue:='True';
Exporter.FormatSettings.BooleanFalse:='false';
Exporter.FormatSettings.BooleanTrue:='True';
Exporter.Dataset:=DS;
Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt';
Exporter.BuildDefaultFieldMap(Exporter.ExportFields);
@ -750,6 +751,49 @@ begin
end;
end;
procedure TTestDBExport.TestFixedTextExportHeader;
var
DS : TBufDataset;
Exporter: TFixedLengthExporter;
F : text;
S : UTF8String;
haveFile : Boolean;
begin
haveFile:=False;
Exporter:=Nil;
DS:=GetBooleanDS;
try
Exporter := TFixedLengthExporter.Create(nil);
Exporter.FormatSettings.BooleanFalse:='false';
Exporter.FormatSettings.BooleanTrue:='True';
Exporter.FormatSettings.HeaderRow:=True;
Exporter.Dataset:=DS;
Exporter.FileName := FExportTempDir + lowercase(TestName) + '.txt';
Exporter.BuildDefaultFieldMap(Exporter.ExportFields);
AssertEquals('Correct width',5, TFixedLengthExportFieldItem(Exporter.ExportFields[0]).Width);
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','F ',S); // 1 extra
Readln(F,S);
AssertEquals('Correct first line','True ',S); // 1 extra
Readln(F,S);
AssertEquals('Correct second line','false',S);
finally
if HaveFile then
closeFile(F);
if (FKeepFilesAfterTest = False) then
DeleteFile(Exporter.FileName);
Exporter.Free;
end;
end;
procedure TTestDBExport.TestJSONExport;
var
Exporter: TSimpleJSONExporter;