mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-07 04:39:33 +01:00
* Changed CSV export to use CSVBuilder to be more RFC 4180 compliant
git-svn-id: trunk@30418 -
This commit is contained in:
parent
6b130438eb
commit
a4ddc64e78
@ -5,7 +5,7 @@ unit fpcsvexport;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, DB, fpDBExport;
|
Classes, SysUtils, fpDBExport, csvreadwrite;
|
||||||
|
|
||||||
Type
|
Type
|
||||||
{ TCSVFormatSettings }
|
{ TCSVFormatSettings }
|
||||||
@ -14,35 +14,40 @@ Type
|
|||||||
Private
|
Private
|
||||||
FDelimiter: String;
|
FDelimiter: String;
|
||||||
FHeaderRow: Boolean;
|
FHeaderRow: Boolean;
|
||||||
FQuoteStrings: TQuoteStrings;
|
FIgnoreOuterWhiteSpace: Boolean;
|
||||||
FRowDelimiter: String;
|
FRowDelimiter: String;
|
||||||
FStringQuoteChar: String;
|
FQuoteChar: Char;
|
||||||
Public
|
Public
|
||||||
Constructor Create(DoInitSettings : Boolean); override;
|
Constructor Create(DoInitSettings : Boolean); override;
|
||||||
Procedure Assign(Source : TPersistent); override;
|
Procedure Assign(Source : TPersistent); override;
|
||||||
|
// Kept for compatibility with older versions; please replace with QuoteChar
|
||||||
|
Property StringQuoteChar : Char Read FQuoteChar Write FQuoteChar; deprecated 'Please replace with QuoteChar';
|
||||||
Published
|
Published
|
||||||
// Properties
|
// Properties
|
||||||
|
// Delimiter between fields/columns. Traditionally , for CSV.
|
||||||
Property FieldDelimiter : String Read FDelimiter Write FDelimiter;
|
Property FieldDelimiter : String Read FDelimiter Write FDelimiter;
|
||||||
|
//If no, CSV is RFC 4180 compliant; if yes, it matches the unofficial Creativyst specification
|
||||||
|
Property IgnoreOuterWhitespace : Boolean Read FIgnoreOuterWhiteSpace write FIgnoreOuterWhiteSpace;
|
||||||
|
// Line ending to be used between rows of data (e.g. #13#10 for standard CSV)
|
||||||
Property RowDelimiter : String Read FRowDelimiter Write FRowDelimiter;
|
Property RowDelimiter : String Read FRowDelimiter Write FRowDelimiter;
|
||||||
|
// Whether or not the file should have a header row with field names
|
||||||
Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true;
|
Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true;
|
||||||
Property QuoteStrings : TQuoteStrings Read FQuoteStrings Write FQuoteStrings;
|
// If fields need to be surrounded by quotes, use this character (e.g. ")
|
||||||
Property StringQuoteChar : String Read FStringQuoteChar Write FStringQuoteChar;
|
Property QuoteChar : Char Read FQuoteChar Write FQuoteChar;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TCustomCSVExporter }
|
{ TCustomCSVExporter }
|
||||||
|
|
||||||
TCustomCSVExporter = Class(TCustomFileExporter)
|
TCustomCSVExporter = Class(TCustomFileExporter)
|
||||||
private
|
private
|
||||||
FCurrentRow:String;
|
FCSVOut: TCSVBuilder;
|
||||||
function GetCSVFormatsettings: TCSVFormatSettings;
|
function GetCSVFormatsettings: TCSVFormatSettings;
|
||||||
procedure OutputRow(const ARow: String);
|
|
||||||
procedure SetCSVFormatSettings(const AValue: TCSVFormatSettings);
|
procedure SetCSVFormatSettings(const AValue: TCSVFormatSettings);
|
||||||
Protected
|
Protected
|
||||||
Function CreateFormatSettings : TCustomExportFormatSettings; override;
|
Function CreateFormatSettings : TCustomExportFormatSettings; override;
|
||||||
Procedure DoBeforeExecute; override;
|
Procedure DoBeforeExecute; override;
|
||||||
Procedure DoAfterExecute; override;
|
Procedure DoAfterExecute; override;
|
||||||
Procedure DoDataHeader; override;
|
Procedure DoDataHeader; override;
|
||||||
Procedure DoDataRowStart; override;
|
|
||||||
Procedure ExportField(EF : TExportFieldItem); override;
|
Procedure ExportField(EF : TExportFieldItem); override;
|
||||||
Procedure DoDataRowEnd; override;
|
Procedure DoDataRowEnd; override;
|
||||||
Public
|
Public
|
||||||
@ -82,27 +87,23 @@ implementation
|
|||||||
procedure TCustomCSVExporter.DoBeforeExecute;
|
procedure TCustomCSVExporter.DoBeforeExecute;
|
||||||
begin
|
begin
|
||||||
inherited DoBeforeExecute;
|
inherited DoBeforeExecute;
|
||||||
|
FCSVOut:=TCSVBuilder.Create;
|
||||||
|
if (FormatSettings.FieldDelimiter<>'') then
|
||||||
|
FCSVOut.Delimiter:=FormatSettings.FieldDelimiter[1];
|
||||||
|
FCSVOut.IgnoreOuterWhitespace:=FormatSettings.IgnoreOuterWhitespace;
|
||||||
|
FCSVOut.LineEnding:=FormatSettings.RowDelimiter;
|
||||||
|
FCSVOut.QuoteChar:=FormatSettings.QuoteChar;
|
||||||
OpenTextFile;
|
OpenTextFile;
|
||||||
|
FCSVOut.SetOutput(Stream); //output to the export stream
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCustomCSVExporter.DoAfterExecute;
|
procedure TCustomCSVExporter.DoAfterExecute;
|
||||||
begin
|
begin
|
||||||
|
FCSVOut.Free;
|
||||||
CloseTextFile;
|
CloseTextFile;
|
||||||
inherited DoAfterExecute;
|
inherited DoAfterExecute;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCustomCSVExporter.OutputRow(Const ARow : String);
|
|
||||||
|
|
||||||
Var
|
|
||||||
RD : String;
|
|
||||||
|
|
||||||
begin
|
|
||||||
RD:=FormatSettings.RowDelimiter;
|
|
||||||
If (RD='') then
|
|
||||||
Writeln(TextFile,ARow)
|
|
||||||
else
|
|
||||||
Write(TextFile,ARow,RD)
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TCustomCSVExporter.GetCSVFormatsettings: TCSVFormatSettings;
|
function TCustomCSVExporter.GetCSVFormatsettings: TCSVFormatSettings;
|
||||||
begin
|
begin
|
||||||
@ -124,84 +125,29 @@ end;
|
|||||||
procedure TCustomCSVExporter.DoDataHeader;
|
procedure TCustomCSVExporter.DoDataHeader;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
S : String;
|
|
||||||
I : Integer;
|
I : Integer;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
If FormatSettings.HeaderRow then
|
If FormatSettings.HeaderRow then
|
||||||
begin
|
begin
|
||||||
S:='';
|
|
||||||
For I:=0 to ExportFields.Count-1 do
|
For I:=0 to ExportFields.Count-1 do
|
||||||
begin
|
begin
|
||||||
If (S<>'') then
|
FCSVOut.AppendCell(ExportFields[i].ExportedName);
|
||||||
S:=S+FormatSettings.FieldDelimiter;
|
|
||||||
S:=S+ExportFields[i].ExportedName;
|
|
||||||
end;
|
end;
|
||||||
OutputRow(S);
|
FCSVOut.AppendRow; //close off with line ending
|
||||||
end;
|
end;
|
||||||
inherited DoDataHeader;
|
inherited DoDataHeader;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TCustomCSVExporter.DoDataRowStart;
|
|
||||||
begin
|
|
||||||
FCurrentRow:='';
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCustomCSVExporter.ExportField(EF: TExportFieldItem);
|
procedure TCustomCSVExporter.ExportField(EF: TExportFieldItem);
|
||||||
|
|
||||||
Function HaveSpace(Const S : String;QS : TQuoteStrings) : Boolean;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=(qsSpace in QS) and (Pos(' ',S)<>0)
|
FCSVOut.AppendCell(FormatField(EF.Field));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function HaveDelimiter(Const S : String;QS : TQuoteStrings) : Boolean;
|
|
||||||
|
|
||||||
Var
|
|
||||||
FD : String;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=(qsDelimiter in QS);
|
|
||||||
If Result then
|
|
||||||
begin
|
|
||||||
FD:=FormatSettings.FieldDelimiter;
|
|
||||||
Result:=(FD<>'') and (Pos(FD,S)<>0);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Var
|
|
||||||
S,C : String;
|
|
||||||
QS : TQuoteStrings;
|
|
||||||
|
|
||||||
begin
|
|
||||||
S:=FormatField(EF.Field);
|
|
||||||
QS:=FormatSettings.QuoteStrings;
|
|
||||||
{If specified, quote everything that can contain delimiters;
|
|
||||||
leave numeric, date fields alone:}
|
|
||||||
If (
|
|
||||||
(EF.Field.DataType in StringFieldTypes) or
|
|
||||||
(EF.Field.DataType in MemoFieldTypes) or
|
|
||||||
(EF.Field.DataType in BlobFieldTypes)
|
|
||||||
)
|
|
||||||
and (QS<>[]) then
|
|
||||||
begin
|
|
||||||
If (qsAlways in QS) or HaveSpace(S,QS) or HaveDelimiter(S,QS) then
|
|
||||||
begin
|
|
||||||
C:=FormatSettings.StringQuoteChar;
|
|
||||||
S:=C+S+C;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
If (FCurrentRow<>'') then
|
|
||||||
FCurrentRow:=FCurrentRow+FormatSettings.FieldDelimiter;
|
|
||||||
FCurrentRow:=FCurrentRow+S;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure TCustomCSVExporter.DoDataRowEnd;
|
procedure TCustomCSVExporter.DoDataRowEnd;
|
||||||
begin
|
begin
|
||||||
OutputRow(FCurrentRow);
|
FCSVOut.AppendRow; //Line ending
|
||||||
FCurrentRow:='';
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TCustomCSVExporter.Create(Aowner: TComponent);
|
constructor TCustomCSVExporter.Create(Aowner: TComponent);
|
||||||
@ -213,14 +159,12 @@ end;
|
|||||||
|
|
||||||
constructor TCSVFormatSettings.Create(DoInitSettings: Boolean);
|
constructor TCSVFormatSettings.Create(DoInitSettings: Boolean);
|
||||||
begin
|
begin
|
||||||
|
// These defaults are meant to be Excel CSV compatible
|
||||||
inherited Create(DoInitSettings);
|
inherited Create(DoInitSettings);
|
||||||
FHeaderRow:=True;
|
FHeaderRow:=True;
|
||||||
FDelimiter:=',';
|
FDelimiter:=',';
|
||||||
FStringQuoteChar:='"';
|
FQuoteChar:='"';
|
||||||
FQuoteStrings:=[qsSpace, qsDelimiter];
|
FRowDelimiter:=LineEnding;
|
||||||
{Sensible defaults as reading unquoted strings with delimiters/spaces will
|
|
||||||
either fail by creating phantom fields (qsDelimiter) or delete leading or
|
|
||||||
trailing data/spaces (qsSpace)}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCSVFormatSettings.Assign(Source: TPersistent);
|
procedure TCSVFormatSettings.Assign(Source: TPersistent);
|
||||||
@ -233,10 +177,9 @@ begin
|
|||||||
begin
|
begin
|
||||||
FS:=Source as TCSVFormatSettings;
|
FS:=Source as TCSVFormatSettings;
|
||||||
FDelimiter:=FS.FDelimiter;
|
FDelimiter:=FS.FDelimiter;
|
||||||
FHeaderRow:=FS.FHEaderRow;
|
FHeaderRow:=FS.FHeaderRow;
|
||||||
FQuoteStrings:=FS.FQuoteStrings;
|
|
||||||
FRowDelimiter:=FS.FRowDelimiter;
|
FRowDelimiter:=FS.FRowDelimiter;
|
||||||
FStringQuoteChar:=FS.FStringQuoteChar;
|
FQuoteChar:=FS.FQuoteChar;
|
||||||
end;
|
end;
|
||||||
inherited Assign(Source);
|
inherited Assign(Source);
|
||||||
end;
|
end;
|
||||||
@ -250,8 +193,8 @@ end;
|
|||||||
Procedure UnRegisterCSVExportFormat;
|
Procedure UnRegisterCSVExportFormat;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
ExportFormats.UnRegisterExportFormat(SCSVExport);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|||||||
@ -517,7 +517,6 @@ begin
|
|||||||
ExportSettings:=TCSVFormatSettings.Create(true);
|
ExportSettings:=TCSVFormatSettings.Create(true);
|
||||||
try
|
try
|
||||||
ExportSettings.FieldDelimiter:=';';
|
ExportSettings.FieldDelimiter:=';';
|
||||||
ExportSettings.QuoteStrings:=[qsAlways,qsSpace,qsDelimiter]; //quote everything we can
|
|
||||||
ExportSettings.StringQuoteChar:='"'; //try explicit assignment
|
ExportSettings.StringQuoteChar:='"'; //try explicit assignment
|
||||||
ExportSettings.RowDelimiter:=#10; //Unix/Linux format
|
ExportSettings.RowDelimiter:=#10; //Unix/Linux format
|
||||||
ExportSettings.BooleanFalse:='onwaar'; //why not a Dutch output format?
|
ExportSettings.BooleanFalse:='onwaar'; //why not a Dutch output format?
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user