fpc/packages/fcl-db/src/export/fpcsvexport.pp

unit fpcsvexport;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpDBExport, csvreadwrite;

Type
  { TCSVFormatSettings }

  TCSVFormatSettings = Class(TExportFormatSettings)
  Private
    FDelimiter: String;
    FHeaderRow: Boolean;
    FIgnoreOuterWhiteSpace: Boolean;
    FRowDelimiter: String;
    FQuoteChar: Char;
  Public
    Constructor Create(DoInitSettings : Boolean); 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
    // Properties
    // Delimiter between fields/columns. Traditionally , for CSV.
    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;
    // Whether or not the file should have a header row with field names
    Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true;
    // If fields need to be surrounded by quotes, use this character (e.g. ")
    Property QuoteChar : Char Read FQuoteChar Write FQuoteChar;
  end;

  { TCustomCSVExporter }

  TCustomCSVExporter = Class(TCustomFileExporter)
  private
    FCSVOut: TCSVBuilder;
    function GetCSVFormatsettings: TCSVFormatSettings;
    procedure SetCSVFormatSettings(const AValue: TCSVFormatSettings);
  Protected
    Function CreateFormatSettings : TCustomExportFormatSettings; override;
    Procedure DoBeforeExecute; override;
    Procedure DoAfterExecute; override;
    Procedure DoDataHeader; override;
    Procedure ExportField(EF : TExportFieldItem); override;
    Procedure DoDataRowEnd; override;
  Public
    Constructor Create(Aowner : TComponent); override;
    Property FormatSettings : TCSVFormatSettings Read GetCSVFormatsettings Write SetCSVFormatSettings;
  end;

  { TCSVExporter }
  

  TCSVExporter = Class(TCustomCSVExporter)
  Published
    Property FileName;
    Property Dataset;
    Property ExportFields;
    Property FromCurrent;
    Property RestorePosition;
    Property FormatSettings;
    Property OnExportRow;
  end;

Procedure RegisterCSVExportFormat;
Procedure UnRegisterCSVExportFormat;

Const
  SCSVExport      = 'CSV';
  SCSVExtensions  = '.csv;.txt';

ResourceString
  SCSVDescription = 'Comma-Separated Values (CSV)';


implementation

{ TCustomCSVExporter }

procedure TCustomCSVExporter.DoBeforeExecute;
begin
  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;
  FCSVOut.SetOutput(Stream); //output to the export stream
end;

procedure TCustomCSVExporter.DoAfterExecute;
begin
  FCSVOut.Free;
  CloseTextFile;
  inherited DoAfterExecute;
end;


function TCustomCSVExporter.GetCSVFormatsettings: TCSVFormatSettings;
begin
  Result:=TCSVFormatSettings(Inherited FormatSettings)
end;

procedure TCustomCSVExporter.SetCSVFormatSettings(
  const AValue: TCSVFormatSettings);
begin
  Inherited FormatSettings:=AValue;
end;

function TCustomCSVExporter.CreateFormatSettings: TCustomExportFormatSettings;
begin
  Result:=TCSVFormatSettings.Create(False)
end;


procedure TCustomCSVExporter.DoDataHeader;

Var
  I : Integer;

begin
  If FormatSettings.HeaderRow then
    begin
    For I:=0 to ExportFields.Count-1 do
      if ExportFields[i].Enabled then
        FCSVOut.AppendCell(ExportFields[i].ExportedName);
    FCSVOut.AppendRow; //close off with line ending
    end;
  inherited DoDataHeader;
end;


procedure TCustomCSVExporter.ExportField(EF: TExportFieldItem);
begin
  FCSVOut.AppendCell(FormatField(EF.Field));
end;

procedure TCustomCSVExporter.DoDataRowEnd;
begin
  FCSVOut.AppendRow; //Line ending
end;

constructor TCustomCSVExporter.Create(Aowner: TComponent);
begin
  inherited Create(Aowner);
end;

{ TCSVFormatSettings }

constructor TCSVFormatSettings.Create(DoInitSettings: Boolean);
begin
  // These defaults are meant to be Excel CSV compatible
  inherited Create(DoInitSettings);
  FHeaderRow:=True;
  FDelimiter:=',';
  FQuoteChar:='"';
  FRowDelimiter:=LineEnding;
end;

procedure TCSVFormatSettings.Assign(Source: TPersistent);

Var
  FS : TCSVFormatsettings;

begin
  If (Source is TCSVFormatSettings) then
    begin
    FS:=Source as TCSVFormatSettings;
    FDelimiter:=FS.FDelimiter;
    FHeaderRow:=FS.FHeaderRow;
    FRowDelimiter:=FS.FRowDelimiter;
    FQuoteChar:=FS.FQuoteChar;
    end;
  inherited Assign(Source);
end;

Procedure RegisterCSVExportFormat;

begin
  ExportFormats.RegisterExportFormat(SCSVExport,SCSVDescription,SCSVExtensions,TCSVExporter);
end;

Procedure UnRegisterCSVExportFormat;

begin
  ExportFormats.UnRegisterExportFormat(SCSVExport);
end;


end.