* Initial check-in. All compiles

git-svn-id: trunk@9158 -

.gitattributes

@@ -4004,6 +4004,16 @@ packages/fcl-db/src/dbase/testdbf.pp svneol=native#text/plain
 packages/fcl-db/src/dbconst.pas svneol=native#text/plain
 packages/fcl-db/src/dbwhtml.pp svneol=native#text/plain
 packages/fcl-db/src/dsparams.inc svneol=native#text/plain
+packages/fcl-db/src/export/Makefile svneol=native#text/plain
+packages/fcl-db/src/export/Makefile.fpc svneol=native#text/plain
+packages/fcl-db/src/export/fpcsvexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpdbexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpdbfexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpfixedexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpsimplejsonexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpsimplexmlexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpsqlexport.pp svneol=native#text/plain
+packages/fcl-db/src/export/fpstdexports.pp svneol=native#text/plain
 packages/fcl-db/src/fields.inc svneol=native#text/plain
 packages/fcl-db/src/fpmake.inc svneol=native#text/plain
 packages/fcl-db/src/fpmake.pp svneol=native#text/plain

packages/fcl-db/src/export/Makefile.fpc

@@ -0,0 +1,33 @@
+#
+# Makefile.fpc for SQL FCL db units
+#
+
+[package]
+main=fcl-db
+
+[target]
+units=fpdbexport fpcsvexport fpfixedexport fpsqlexport fpsimplexmlexport fpsimplejsonexport fpdbfexport
+rsts=fpdbexport fpcsvexport fpfixedexport fpsqlexport fpsimplexmlexport fpsimplejsonexport fpdbfexport
+
+[compiler]
+options=-S2h
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../../../..
+
+[rules]
+
+fpcsvexport$(PPUEXT): fpdbexport$(PPEXT)
+
+fpfixedexport$(PPUEXT): fpdbexport$(PPEXT)
+
+fpsqlexport$(PPUEXT): fpdbexport$(PPEXT)
+
+fpsimplexmlexport$(PPUEXT): fpdbexport$(PPEXT)
+
+fpsimplejsonexport$(PPUEXT): fpdbexport$(PPEXT)
+
+fpdbfexport$(PPUEXT): fpdbexport$(PPEXT)

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

@@ -0,0 +1,246 @@
+unit fpcsvexport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, fpDBExport;
+
+Type
+  { TCSVFormatSettings }
+
+  TCSVFormatSettings = Class(TExportFormatSettings)
+  Private
+    FDelimiter: String;
+    FHeaderRow: Boolean;
+    FQuoteStrings: TQuoteStrings;
+    FRowDelimiter: String;
+    FStringQuoteChar: String;
+  Public
+    Constructor Create(DoInitSettings : Boolean); override;
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    // Properties
+    Property FieldDelimiter : String Read FDelimiter Write FDelimiter;
+    Property RowDelimiter : String Read FRowDelimiter Write FRowDelimiter;
+    Property HeaderRow : Boolean Read FHeaderRow Write FHeaderRow default true;
+    Property QuoteStrings : TQuoteStrings Read FQuoteStrings Write FQuoteStrings;
+    Property StringQuoteChar : String Read FStringQuoteChar Write FStringQuoteChar;
+  end;
+
+  { TCustomCSVExporter }
+
+  TCustomCSVExporter = Class(TCustomFileExporter)
+  private
+    FCurrentRow:String;
+    function GetCSVFormatsettings: TCSVFormatSettings;
+    procedure OutputRow(const ARow: String);
+    procedure SetCSVFormatSettings(const AValue: TCSVFormatSettings);
+  Protected
+    Function CreateFormatSettings : TCustomExportFormatSettings; override;
+    Procedure DoBeforeExecute; override;
+    Procedure DoAfterExecute; override;
+    Procedure DoDataHeader; override;
+    Procedure DoDataRowStart; 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;
+  OpenTextFile;
+end;
+
+procedure TCustomCSVExporter.DoAfterExecute;
+begin
+  CloseTextFile;
+  inherited DoAfterExecute;
+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;
+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
+  S : String;
+  I : Integer;
+
+begin
+  If FormatSettings.HeaderRow then
+    begin
+    S:='';
+    For I:=0 to ExportFields.Count-1 do
+      begin
+      If (S<>'') then
+        S:=S+FormatSettings.FieldDelimiter;
+      S:=S+ExportFields[i].ExportedName;
+      end;
+    OutputRow(S);
+    end;
+  inherited DoDataHeader;
+end;
+
+
+procedure TCustomCSVExporter.DoDataRowStart;
+begin
+  FCurrentRow:='';
+end;
+
+procedure TCustomCSVExporter.ExportField(EF: TExportFieldItem);
+
+  Function HaveSpace(Const S : String;QS : TQuoteStrings) : Boolean;
+
+  begin
+    Result:=(qsSpace in QS) and (Pos(' ',S)<>0)
+  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 (EF.Field.DataType in StringFieldTypes) 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;
+begin
+  OutputRow(FCurrentRow);
+  FCurrentRow:='';
+end;
+
+constructor TCustomCSVExporter.Create(Aowner: TComponent);
+begin
+  inherited Create(Aowner);
+end;
+
+{ TCSVFormatSettings }
+
+constructor TCSVFormatSettings.Create(DoInitSettings: Boolean);
+begin
+  inherited Create(DoInitSettings);
+  FHeaderRow:=True;
+  FDelimiter:=',';
+  FStringQuoteChar:='"';
+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;
+    FQuoteStrings:=FS.FQuoteStrings;
+    FRowDelimiter:=FS.FRowDelimiter;
+    FStringQuoteChar:=FS.FStringQuoteChar;
+    end;
+  inherited Assign(Source);
+end;
+
+Procedure RegisterCSVExportFormat;
+
+begin
+  ExportFormats.RegisterExportFormat(SCSVExport,SCSVDescription,SCSVExtensions,TCSVExporter);
+end;
+
+Procedure UnRegisterCSVExportFormat;
+
+begin
+end;
+
+
+end.
+

packages/fcl-db/src/export/fpdbfexport.pp

@@ -0,0 +1,272 @@
+unit fpdbfexport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, dbf, fpdbexport;
+  
+Type
+
+  { TDBFExportFieldItem }
+
+  TDBFExportFieldItem = Class(TExportFieldItem)
+  private
+    FDestField: TField;
+  Protected
+    Property DestField : TField Read FDestField;
+  end;
+
+  { TDBFExportFormatSettings }
+
+  TTableFormat = (tfDBaseIII,tfDBaseIV,tfDBaseVII,tfFoxPro);
+  
+  TDBFExportFormatSettings = class(TExportFormatSettings)
+  private
+    FAutoRename: Boolean;
+    FTableFormat: TTableFormat;
+  public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property TableFormat : TTableFormat Read FTableFormat Write FTableFormat;
+    Property AutoRenameFields : Boolean Read FAutoRename Write FAutoRename;
+  end;
+  { TFPCustomDBFExport }
+
+  TFPCustomDBFExport = Class(TCustomDatasetExporter)
+  Private
+    FDBF : TDBF;
+    FFileName: String;
+    FAppendData: Boolean;
+    function GetSettings: TDBFExportFormatSettings;
+    procedure SetSettings(const AValue: TDBFExportFormatSettings);
+  Protected
+    Procedure CheckExportFieldNames; virtual;
+    Function BindFields : Boolean; override;
+    Function CreateFormatSettings : TCustomExportFormatSettings; override;
+
+    Function CreateExportFields : TExportFields; override;
+    Procedure DoBeforeExecute; override;
+    Procedure DoAfterExecute; override;
+    Procedure DoDataRowStart; override;
+    Procedure DoDataRowEnd; override;
+    Procedure ExportField(EF : TExportFieldItem); override;
+    Property FileName : String Read FFileName Write FFileName;
+    Property AppendData : Boolean Read FAppendData Write FAppendData;
+    Property DBF : TDBF Read FDBF;
+  public
+    Property FormatSettings : TDBFExportFormatSettings Read GetSettings Write SetSettings;
+  end;
+
+  TFPDBFExport = Class(TFPCustomDBFExport)
+  Published
+    Property FileName;
+    Property Dataset;
+    Property ExportFields;
+    Property FromCurrent;
+    Property RestorePosition;
+    Property FormatSettings;
+    Property OnExportRow;
+  end;
+  
+Procedure RegisterDBFExportFormat;
+Procedure UnRegisterDBFExportFormat;
+
+Const
+  SDBFExport = 'DBF';
+  SDBFFilter = '*.dbf';
+  
+ResourceString
+  SErrFailedToDeleteFile = 'Failed to delete existing DBF file: %s';
+  SDBFDescription = 'DBF files';
+
+implementation
+
+
+{ TFPCustomDBFExport }
+
+function TFPCustomDBFExport.GetSettings: TDBFExportFormatSettings;
+begin
+  Result:=TDBFExportFormatSettings(Inherited FormatSettings);
+end;
+
+procedure TFPCustomDBFExport.SetSettings(const AValue: TDBFExportFormatSettings
+  );
+begin
+  Inherited FormatSettings.Assign(AValue);
+end;
+
+procedure TFPCustomDBFExport.CheckExportFieldNames;
+
+Var
+  I,J : Integer;
+  EF : TExportFieldItem;
+  FN : String;
+  
+begin
+  For I:=0 to ExportFields.Count-1 do
+    begin
+    EF:=ExportFields[i];
+    If (Length(EF.ExportedName)>10) then
+      begin
+      FN:=Copy(EF.ExportedName,1,10);
+      If ExportFIelds.IndexOfExportedName(FN)<>-1 then
+        begin
+        J:=1;
+        Repeat
+          FN:=Copy(EF.ExportedName,1,8)+Format('%.2d',[J]);
+        Until (ExportFIelds.IndexOfExportedName(FN)=-1);
+        end;
+      EF.ExportedName:=FN;
+      end;
+    end;
+end;
+
+function TFPCustomDBFExport.BindFields: Boolean;
+
+Const
+  Levels : Array[TTableFormat] of integer = (3,4,7,25);
+  
+Var
+  EF : TDBFExportFieldItem;
+  I : Integer;
+  
+begin
+  If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat=tfDbaseIII) then
+    CheckExportFieldNames;
+  Result:=Inherited;
+  try
+    with FDBF.FieldDefs do
+      begin
+      Clear;
+      For I:=0 to ExportFields.Count-1 do
+        begin
+        EF:=ExportFIelds[i] as TDBFExportFieldItem;
+        If EF.ENabled and Assigned(EF.Field) then
+          Add(EF.ExportedName,EF.FIeld.DataType,EF.Field.Size);
+        end;
+      FDBF.TableLevel:=Levels[FormatSettings.TableFormat];
+      FDBF.CreateTable;
+      FDBF.Exclusive := true;
+      FDBF.Open;
+      end;
+    For I:=0 to ExportFields.Count-1 do
+      begin
+      EF:=ExportFIelds[i] as TDBFExportFieldItem;
+      If EF.Enabled then
+        EF.FDestField:=FDBF.FieldByName(EF.ExportedName);
+      end;
+  except
+    UnBindFields;
+    Raise;
+  end;
+end;
+
+function TFPCustomDBFExport.CreateFormatSettings: TCustomExportFormatSettings;
+begin
+  Result:=TDBFExportFormatSettings.Create(False);
+end;
+
+function TFPCustomDBFExport.CreateExportFields: TExportFields;
+begin
+  Result:=TExportFields.Create(TDBFExportFieldItem);
+end;
+
+procedure TFPCustomDBFExport.DoBeforeExecute;
+
+Var
+  FE : Boolean;
+  
+begin
+  Inherited;
+  FDBF:=TDBF.Create(Self);
+  FDBF.TableName:=FFileName;
+  FE:=FileExists(FFileName);
+  If FAppendData and FE then
+    FDBF.Open
+  else
+    begin
+    If FE and Not AppendData then
+      begin
+      If not DeleteFile(FFileName) then
+        Raise EDataExporter.CreateFmt(SErrFailedToDeleteFile,[FFileName]);
+      end;
+    end;
+end;
+
+procedure TFPCustomDBFExport.DoAfterExecute;
+begin
+  try
+    FreeAndNil(FDBF);
+  finally
+    Inherited;
+  end;
+end;
+
+procedure TFPCustomDBFExport.DoDataRowStart;
+begin
+  FDBF.Append;
+end;
+
+procedure TFPCustomDBFExport.DoDataRowEnd;
+begin
+  FDBF.Post;
+end;
+
+procedure TFPCustomDBFExport.ExportField(EF: TExportFieldItem);
+
+Var
+  F : TDBFExportFieldItem;
+  
+begin
+  F:=EF as TDBFExportFieldItem;
+  With F do
+    If FIeld.IsNull then
+      DestField.Clear
+    else If Field.Datatype in IntFieldTypes then
+      DestField.AsInteger:=Field.AsInteger
+    else if Field.dataType in [ftString,ftFixedChar] then
+      DestField.AsString:=Field.AsString
+    else if Field.DataType=ftBoolean then
+      DestField.AsBoolean:=Field.AsBoolean
+    else if (Field.DataType in ([ftWidestring,ftFixedWideChar]+BlobFieldTypes)) then
+      DestField.AsWideString:=Field.AsWideString
+    else if field.DataType in DateFieldTypes then
+      DestField.AsDatetime:=Field.AsDateTime
+    else
+      DestField.AsDatetime:=Field.AsDateTime
+end;
+
+Procedure RegisterDBFExportFormat;
+begin
+  RegisterExportFormat(SDBFExport,SDBFDescription,SDBFFilter,TFPDBFExport);
+end;
+
+Procedure UnRegisterDBFExportFormat;
+begin
+  UnregisterExportFormat(SDBFExport);
+end;
+
+{ TDBFExportFormatSettings }
+
+procedure TDBFExportFormatSettings.Assign(Source: TPersistent);
+
+Var
+  FS : TDBFExportFormatSettings;
+  
+begin
+  If Source is TDBFExportFormatSettings then
+    begin
+    FS:=Source as TDBFExportFormatSettings;
+    AutoRenameFields:=FS.AutoRenameFields;
+    TableFormat:=FS.TableFormat;
+    end;
+  inherited Assign(Source);
+end;
+
+initialization
+//Function RegisterExportFormat(Const AName,ADescription,AExtensions : String; AClass : TCustomDatasetExporterClass) : TExportFormatItem;
+  RegisterDBFExportFormat;
+end.
+

packages/fcl-db/src/export/fpfixedexport.pp

@@ -0,0 +1,210 @@
+unit fpfixedexport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, fpDBExport;
+  
+  { TFixedLengthExportFieldItem }
+
+Type
+  TFixedLengthExportFieldItem = Class(TExportFieldItem)
+  private
+    FWidth: Integer;
+    FAlignField: TAlignField;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property Width : Integer Read FWidth Write FWidth;
+    Property AlignField: TAlignField Read FAlignField write FAlignField;
+  end;
+
+  { TCustomFixedLengthExporter }
+
+  TCustomFixedLengthExporter = Class(TCustomFileExporter)
+  Private
+    FCurrentRow : String;
+    procedure OutputRow(const ARow: String);
+  Protected
+    Procedure BuildDefaultFieldMap(AMap : TExportFields); override;
+    Function  CreateExportFields : TExportFields; override;
+    Procedure DoBeforeExecute; override;
+    Procedure DoAfterExecute; override;
+    Procedure DoDataRowStart; override;
+    Procedure ExportField(EF : TExportFieldItem); override;
+    Procedure DoDataRowEnd; override;
+  end;
+
+  TFixedLengthExporter = Class(TCustomFixedLengthExporter)
+  Published
+    Property FileName;
+    Property Dataset;
+    Property ExportFields;
+    Property FromCurrent;
+    Property RestorePosition;
+    Property FormatSettings;
+    Property OnExportRow;
+  end;
+
+Procedure RegisterFixedExportFormat;
+Procedure UnRegisterFixedExportFormat;
+
+Const
+  SFixedLengthExport      = 'Fixed';
+  SFixedLengthExtensions  = '.txt';
+
+Resourcestring
+  SFixedLengthDescription = 'Text file with fixed length records';
+
+
+
+implementation
+
+{ TFixedLengthExportFieldItem }
+
+procedure TFixedLengthExportFieldItem.Assign(Source: TPersistent);
+
+Var
+  FL : TFixedLengthExportFieldItem;
+
+begin
+  If Source is TFixedLengthExportFieldItem then
+    begin
+    FL:=Source as TFixedLengthExportFieldItem;
+    Width:=FL.Width;
+    AlignField:=FL.AlignFIeld;
+    end;
+  inherited Assign(Source);
+end;
+
+{ TCustomFixedLengthExporter }
+
+procedure TCustomFixedLengthExporter.OutputRow(const ARow: String);
+begin
+  Writeln(TextFile,ARow);
+end;
+
+procedure TCustomFixedLengthExporter.BuildDefaultFieldMap(AMap: TExportFields);
+
+{  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
+    ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
+    ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
+    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
+    ftWideString, ftLargeint, ftADT, ftArray, ftReference,
+    ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
+    ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo);
+}
+Const
+  FieldWidths : Array[TFieldType] of integer
+              = (-1,0,3,10,5,
+                  1,20,20,20,10,8,20,
+                  0,0,10,0,0,0,0,
+                  0,0,0,0,0,
+                  0,0,0,0,0,
+                  0,0,0,0,0,
+                  0,0,0,0,0,0);
+
+Var
+  I,W : Integer;
+  F : TField;
+  FL : TFixedLengthExportFieldItem;
+
+begin
+  inherited BuildDefaultFieldMap(AMap);
+  For I:=0 to AMap.Count-1 do
+    begin
+    FL:=TFixedLengthExportFieldItem(AMAP[i]);
+    F:=Dataset.Fields[i];
+    W:= FieldWidths[F.DataType];
+    If (W>0) then
+      FL.Width:=W
+    else if (W=0) then
+      begin
+      if (F.DataType in StringFieldTypes) then
+        FL.Width:=F.Size;
+      end;
+    If (F.DataType in IntFieldTypes) then
+      Fl.AlignField:=afRight;
+    end;
+end;
+
+function TCustomFixedLengthExporter.CreateExportFields: TExportFields;
+begin
+  Result:=TExportFields.Create(TFixedLengthExportFieldItem);
+end;
+
+procedure TCustomFixedLengthExporter.DoBeforeExecute;
+begin
+  inherited DoBeforeExecute;
+  OpenTextFile;
+end;
+
+procedure TCustomFixedLengthExporter.DoAfterExecute;
+begin
+  CloseTextFile;
+  inherited DoAfterExecute;
+end;
+
+
+procedure TCustomFixedLengthExporter.DoDataRowStart;
+begin
+  FCurrentRow:='';
+end;
+
+procedure TCustomFixedLengthExporter.ExportField(EF: TExportFieldItem);
+
+Var
+  S,SS : String;
+  W,L : Integer;
+  FL : TFixedLengthExportFieldItem;
+
+begin
+  S:=FormatField(EF.Field);
+  If EF is TFixedLengthExportFieldItem then
+    begin
+    FL:=TFixedLengthExportFieldItem(EF);
+    W:=FL.Width;
+    end
+  else
+    W:=Length(S);
+  L:=Length(S);
+  If L>W then
+    begin
+    If (FL.AlignField=afLeft) then
+      S:=Copy(S,1,W)
+    else
+      Delete(S,1,L-W);
+    end
+  else if (L<W) then
+    begin
+    SS:=StringOfChar(' ',W-L);
+    If FL.AlignField=afRight then
+      S:=SS+S
+    else
+      S:=S+SS;
+    end;
+  FCurrentRow:=FCurrentRow+S;
+end;
+
+procedure TCustomFixedLengthExporter.DoDataRowEnd;
+begin
+  OutputRow(FCurrentRow);
+  FCurrentRow:='';
+end;
+
+Procedure RegisterFixedExportFormat;
+
+begin
+  ExportFormats.RegisterExportFormat(SFixedLengthExport,SFixedLengthDescription,SFixedLengthExtensions,TFixedLengthExporter);
+end;
+
+Procedure UnRegisterFixedExportFormat;
+
+begin
+  Exportformats.UnregisterExportFormat(SFixedLengthExport);
+end;
+
+end.
+

packages/fcl-db/src/export/fpsimplejsonexport.pp

@@ -0,0 +1,278 @@
+unit fpsimplejsonexport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, fpDBExport;
+  
+Type
+  TJSONRowFormat = (rfArray,rfObject);
+  TJSONColumnFormat = (cfObject,cfArray);
+
+  { TSimpleJSONFormatSettings }
+
+  TSimpleJSONFormatSettings = Class(TExportFormatSettings)
+  private
+    FColumnFormat: TJSONColumnFormat;
+    FIndentSize: Integer;
+    FRowElementName: String;
+    FRowFormat: TJSONRowFormat;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property RowElementName : String Read FRowElementName Write FRowElementName;
+    Property RowFormat : TJSONRowFormat Read FRowFormat Write FRowFormat;
+    Property ColumnFormat : TJSONColumnFormat Read FColumnFormat Write FColumnFormat;
+    Property IndentSize : Integer Read FIndentSize Write FIndentSize;
+  end;
+
+  { TCustomSimpleJSONExporter }
+
+  TCustomSimpleJSONExporter = Class(TCustomFileExporter)
+  Private
+    FCurrentRow : String;
+    FIndent : String;
+    FIS : Integer;
+    FREN : String;
+    FCF : TJSONColumnFormat;
+    FRF : TJSONRowFormat;
+    FRC : Int64;
+    procedure DecIndent;
+    function GetJSONFormatsettings: TSimpleJSONFormatSettings;
+    procedure IncIndent;
+    procedure OutputRow(const ARow: String);
+    procedure SetJSONFormatSettings(const AValue: TSimpleJSONFormatSettings);
+    function TextString(S: String): String;
+  Protected
+    Function  CreateFormatSettings : TCustomExportFormatSettings; override;
+    Procedure DoBeforeExecute; override;
+    Procedure DoAfterExecute; override;
+    Procedure DoDataRowStart; override;
+    Procedure DoDataHeader; override;
+    Procedure DoDataFooter; override;
+    Procedure ExportField(EF : TExportFieldItem); override;
+    Procedure DoDataRowEnd; override;
+  Public
+    Property FormatSettings : TSimpleJSONFormatSettings Read GetJSONFormatsettings Write SetJSONFormatSettings;
+  end;
+
+  TSimpleJSONExporter = Class(TCustomSimpleJSONExporter)
+  Published
+    Property FileName;
+    Property Dataset;
+    Property ExportFields;
+    Property FromCurrent;
+    Property RestorePosition;
+    Property FormatSettings;
+    Property OnExportRow;
+  end;
+
+Procedure RegisterSimpleJSONExportFormat;
+Procedure UnRegisterSimpleJSONExportFormat;
+
+Const
+  SSimpleJSON            = 'SimpleJSON';
+  SSimpleJSONExtensions  = '.json';
+  
+Resourcestring
+  SSimpleJSONDescription = 'Simple ASCII JSON file';
+
+implementation
+
+
+{ TSimpleJSONFormatSettings }
+
+procedure TSimpleJSONFormatSettings.Assign(Source: TPersistent);
+
+Var
+  FS : TSimpleJSONFormatSettings;
+
+begin
+  if (Source is TSimpleJSONFormatSettings) then
+    begin
+    FS:=Source as TSimpleJSONFormatSettings;
+    FColumnFormat:=FS.FColumnFormat;
+    FRowElementName:=FS.FRowElementName;
+    FRowFormat:=FS.FRowFormat;
+    FIndentSize:=FS.IndentSize;
+    end;
+  inherited Assign(Source);
+end;
+
+{ TCustomSimpleJSONExporter }
+
+procedure TCustomSimpleJSONExporter.DecIndent;
+begin
+  If (FIS>0) and (length(FIndent)>=FIS) then
+    Delete(FIndent,1,FIS);
+end;
+
+function TCustomSimpleJSONExporter.GetJSONFormatsettings: TSimpleJSONFormatSettings;
+begin
+  Result:=TSimpleJSONFormatSettings(Inherited formatsettings)
+end;
+
+procedure TCustomSimpleJSONExporter.IncIndent;
+begin
+  If FIS>0 then
+    FIndent:=FIndent+StringOfChar(' ',FIS);
+end;
+
+procedure TCustomSimpleJSONExporter.OutputRow(const ARow: String);
+begin
+  Writeln(TextFile,FIndent,ARow);
+end;
+
+procedure TCustomSimpleJSONExporter.SetJSONFormatSettings(
+  const AValue: TSimpleJSONFormatSettings);
+begin
+  Inherited FormatSettings.Assign(AValue);
+end;
+
+function TCustomSimpleJSONExporter.TextString(S: String): String;
+
+Var
+  I,J,L : Integer;
+  P : Pchar;
+
+begin
+  I:=1;
+  J:=1;
+  Result:='';
+  L:=Length(S);
+  P:=PChar(S);
+  While I<=L do
+    begin
+    if (P^ in ['"','/','\',#8,#9,#10,#12,#13]) then
+      begin
+      Result:=Result+Copy(S,J,I-J);
+      Case P^ of
+        '\' : Result:=Result+'\\';
+        '/' : Result:=Result+'\/';
+        '"' : Result:=Result+'\"';
+        #8  : Result:=Result+'\b';
+        #9  : Result:=Result+'\t';
+        #10 : Result:=Result+'\n';
+        #12 : Result:=Result+'\f';
+        #13 : Result:=Result+'\r';
+      end;
+      J:=I+1;
+      end;
+    Inc(I);
+    Inc(P);
+    end;
+  Result:=Result+Copy(S,J,I-1);
+end;
+
+function TCustomSimpleJSONExporter.CreateFormatSettings: TCustomExportFormatSettings;
+begin
+  Result:=TSimpleJSONFormatSettings.Create(False);
+end;
+
+procedure TCustomSimpleJSONExporter.DoBeforeExecute;
+begin
+  inherited DoBeforeExecute;
+  OpenTextFile;
+  FREN:=FormatSettings.RowElementName;
+  FRF:=FormatSettings.RowFormat;
+  FCF:=FormatSettings.ColumnFormat;
+  If (FREN='') and (FRF=rfObject) then
+    FREN:='ROW';
+  FIS:=FormatSettings.IndentSize;
+  FIndent:='';
+  FRC:=0;
+end;
+
+procedure TCustomSimpleJSONExporter.DoAfterExecute;
+begin
+  CloseTextFile;
+  inherited DoAfterExecute;
+end;
+
+procedure TCustomSimpleJSONExporter.DoDataRowStart;
+begin
+  Inc(FRC);
+  FCurrentRow:='';
+end;
+
+procedure TCustomSimpleJSONExporter.DoDataHeader;
+begin
+  If FRF=rfObject then
+    OutputRow('{')
+  else
+    OutputRow('[');
+  IncIndent;
+end;
+
+procedure TCustomSimpleJSONExporter.DoDataFooter;
+begin
+  DecIndent;
+  If FRF=rfObject then
+    OutputRow('}')
+  else
+    OutputRow(']');
+end;
+
+procedure TCustomSimpleJSONExporter.ExportField(EF: TExportFieldItem);
+
+Var
+  S : String;
+
+begin
+  if EF.Field.IsNull then
+    S:='NULL' // do not localize
+  else if EF.Field.DataType=ftBoolean then
+    begin
+    If EF.FIeld.AsBoolean then
+      S:='True' // Do not localize
+    else
+      S:='False';// Do not localize
+    end
+  else if EF.Field.DataType=ftFloat then
+    Str(EF.FIeld.asFloat,S)
+  else
+    S:=FormatField(EF.Field);
+  if not (EF.Field.isnull or (ef.field.Datatype in (ordFieldTypes+[ftFloat]))) then
+    S:='"'+TextString(S)+'"';
+  If FCF=cfObject then
+    S:='"'+EF.ExportedName+'" : '+S;
+  If (FCurrentRow<>'') then
+    if FCF=cfObject then
+      FCurrentRow:=FCurrentRow+'; '
+    else
+      FCurrentRow:=FCurrentRow+', ';
+  FCurrentRow:=FCurrentRow+S;
+end;
+
+procedure TCustomSimpleJSONExporter.DoDataRowEnd;
+
+begin
+  If FcF=cfObject then
+    FCurrentRow:='{ '+FCurrentRow+' }'
+  else
+    FCurrentRow:='[ '+FCurrentRow+' ]';
+  If FRF = rfObject then
+    FCurrentRow:=Format('"%s%d" : %s',[FREN,FRC,FCurrentRow]);
+  if not Dataset.EOF then
+    If FRF=rfObject then
+      FCurrentRow:=FCurrentRow+';'
+    else
+      FCurrentRow:=FCurrentRow+',';
+  OutputRow(FCurrentRow);
+end;
+
+Procedure RegisterSimpleJSONExportFormat;
+
+begin
+  ExportFormats.RegisterExportFormat(SSimpleJSON,SSimpleJSONDescription,SSimpleJSONExtensions,TSimpleJSONExporter);
+end;
+Procedure UnRegisterSimpleJSONExportFormat;
+
+begin
+  ExportFormats.UnRegisterExportFormat(SSimpleJSON);
+end;
+
+end.
+

packages/fcl-db/src/export/fpsimplexmlexport.pp

@@ -0,0 +1,313 @@
+unit fpSimpleXMLExport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, fpDBExport;
+  
+Type
+  { TSimpleXMLFormatSettings }
+
+  TSimpleXMLFormatSettings = Class(TExportFormatSettings)
+  private
+    FFieldAsAttribute: Boolean;
+    FIndentSize: Integer;
+    FRowElementName: String;
+    FStartNodePath: String;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property StartNodePath : String Read FStartNodePath Write FStartNodePath;
+    Property RowElementName : String Read FRowElementName Write FRowElementName;
+    Property FieldAsAttributes : Boolean Read FFieldAsAttribute Write FFieldAsAttribute;
+    Property IndentSize : Integer Read FIndentSize Write FIndentSize;
+  end;
+
+  { TCustomSimpleXMlExporter }
+  TCustomSimpleXMLExporter = Class(TCustomFileExporter)
+  Private
+    FCurrentRow : String;
+    FIndent : String;
+    FRowElementName : String;
+    FRootNode : String;
+    FAA : Boolean;
+    FIS : Integer;
+    function AttrString(S: String): String;
+    procedure DecIndent;
+    function GetXMLFormatsettings: TSimpleXMLFormatSettings;
+    procedure IncIndent;
+    procedure OutputRow(const ARow: String);
+    procedure SetXMLFormatSettings(const AValue: TSimpleXMLFormatSettings);
+    function TextString(S: String): String;
+  Protected
+    Function  CreateFormatSettings : TCustomExportFormatSettings; override;
+    Procedure DoBeforeExecute; override;
+    Procedure DoAfterExecute; override;
+    Procedure DoDataRowStart; override;
+    Procedure DoDataHeader; override;
+    Procedure DoDataFooter; override;
+    Procedure ExportField(EF : TExportFieldItem); override;
+    Procedure DoDataRowEnd; override;
+  Public
+    Property FormatSettings : TSimpleXMLFormatSettings Read GetXMLFormatsettings Write SetXMLFormatSettings;
+  end;
+
+  TSimpleXMLExporter = Class(TCustomSimpleXMLExporter)
+  Published
+    Property FileName;
+    Property Dataset;
+    Property ExportFields;
+    Property FromCurrent;
+    Property RestorePosition;
+    Property FormatSettings;
+    Property OnExportRow;
+  end;
+
+Procedure RegisterSimpleXMLExportFormat;
+Procedure UnRegisterSimpleXMLExportFormat;
+
+Const
+  SSimpleXML             = 'SimpleXml';
+  SSimpleXMLExtensions   = '.xml';
+
+Resourcestring
+  SSimpleXMLDescription = 'Simple ASCII XML file';
+
+implementation
+
+{ TCustomSimpleXMLExporter }
+
+procedure TCustomSimpleXMLExporter.OutputRow(const ARow: String);
+begin
+  Writeln(TextFile,FIndent,ARow);
+end;
+
+function TCustomSimpleXMLExporter.GetXMLFormatsettings: TSimpleXMLFormatSettings;
+begin
+  Result:=TSimpleXMLFormatSettings(Inherited FormatSettings);
+end;
+
+procedure TCustomSimpleXMLExporter.SetXMLFormatSettings(
+  const AValue: TSimpleXMLFormatSettings);
+begin
+   Inherited FormatSettings:=AValue;
+end;
+
+function TCustomSimpleXMLExporter.CreateFormatSettings: TCustomExportFormatSettings;
+begin
+  Result:=TSimpleXMLFormatSettings.Create(False);
+end;
+
+procedure TCustomSimpleXMLExporter.DoBeforeExecute;
+begin
+  inherited DoBeforeExecute;
+  OpenTextFile;
+  FRowElementName:=FormatSettings.RowElementName;
+  If FRowElementname='' then
+    FRowElementName:='ROW';
+  FRootNode:=Formatsettings.StartNodePath;
+  If (FRootNode='') or (FRootNode='/')then
+    FRootNode:='/ROWDATA/';
+  FIS:=FormatSettings.IndentSize;
+  FAA:=Formatsettings.FieldAsAttributes;
+  FIndent:='';
+end;
+
+procedure TCustomSimpleXMLExporter.DoAfterExecute;
+begin
+  CloseTextFile;
+  inherited DoAfterExecute;
+end;
+
+procedure TCustomSimpleXMLExporter.DoDataRowStart;
+begin
+  If FAA then
+    FCurrentRow:='<'+FRowElementName
+  else
+    begin
+    FCurrentRow:='';
+    OutputRow('<'+FRowElementName+'>');
+    IncIndent;
+    end;
+end;
+
+const
+  QuotStr = '&quot;';
+  AmpStr = '&amp;';
+  ltStr = '&lt;';
+  gtStr = '&gt;';
+
+Procedure AddToResult(Var Res : String; S : String; P : integer; Var J : Integer; Const Add : String);
+
+begin
+  Res:=Res+Copy(S,J,P-J+1);
+  If (Add<>'') then
+    Res:=Res+Add;
+  J:=P+1;
+end;
+
+Function TCustomSimpleXMLExporter.AttrString(S : String) : String;
+
+Var
+  I,J : Integer;
+
+
+begin
+  Result:='';
+  J:=1;
+  For I:=1 to Length(S) do
+    case S[i] of
+      '"': AddToResult(Result,S,I,J,QuotStr);
+      '&': AddToResult(Result,S,I,J,AmpStr);
+      '<': AddToResult(Result,S,I,J,ltStr);
+      #9 : AddToResult(Result,S,I,J,'&#x9;');
+      #10: AddToResult(Result,S,I,J,'&#xA;');
+      #13: AddToResult(Result,S,I,J,'&#xD;');
+    end;
+  AddToResult(Result,S,Length(S)+1,J,'');
+end;
+
+Function TCustomSimpleXMLExporter.TextString(S : String) : String;
+
+
+Var
+  I,J : Integer;
+
+begin
+  Result:='';
+  J:=1;
+  For I:=1 to Length(S) do
+    case S[i] of
+      '<': AddToResult(Result,S,I,J,ltStr);
+      '>': AddToResult(Result,S,I,J,gtStr);
+      '&': AddToResult(Result,S,I,J,AmpStr);
+    end;
+  AddToResult(Result,S,Length(S)+1,J,'');
+end;
+
+procedure TCustomSimpleXMLExporter.IncIndent;
+
+begin
+  If FIS>0 then
+    FIndent:=FIndent+StringOfChar(' ',FIS);
+end;
+
+procedure TCustomSimpleXMLExporter.DecIndent;
+
+begin
+  If (FIS>0) and (length(FIndent)>=FIS) then
+    Delete(FIndent,1,FIS);
+end;
+
+procedure TCustomSimpleXMLExporter.DoDataHeader;
+
+Var
+  S : String;
+  P : Integer;
+
+begin
+  // Proper UTF-8 support would be good.
+  Writeln(TextFile,'<?xml version="1.0" encoding = "ISO 8859-1" ?>');
+  S:=FRootNode;
+  if S[Length(S)]<>'/' then
+    S:=S+'/';
+  If (S[1]='/') then
+    Delete(S,1,1);
+  Repeat
+    P:=Pos('/',S);
+    OutputRow('<'+Copy(S,1,P-1)+'>');
+    Delete(S,1,P);
+    IncIndent;
+  Until (S='');
+end;
+
+procedure TCustomSimpleXMLExporter.DoDataFooter;
+
+Var
+  P,L : Integer;
+  S : String;
+
+begin
+  S:=FRootNode;
+  if (S[1]<>'/') then
+    S:='/'+S;
+  L:=Length(S);
+  If (S[L]='/') then
+    S:=Copy(S,1,L-1);
+  Repeat
+    L:=Length(S);
+    P:=L;
+    While (P>0) and (S[P]<>'/') do
+      Dec(P);
+    DecIndent;
+    OutputRow('</'+Copy(S,P+1,L-P)+'>');
+    S:=Copy(S,1,P-1);
+  Until (S='');
+  inherited DoDataFooter;
+end;
+
+procedure TCustomSimpleXMLExporter.ExportField(EF: TExportFieldItem);
+
+Var
+  S : String;
+
+begin
+  S:=FormatField(EF.Field);
+  If FormatSettings.FieldAsAttributes then
+    FCurrentRow:=FCurrentRow+' '+EF.ExportedName+'="'+AttrString(S)+'"'
+  else
+    begin
+    FCurrentRow:='<'+EF.ExportedName+'>'+TextString(S)+'</'+EF.ExportedName+'>';
+    OutputRow(FCurrentRow);
+    end;
+end;
+
+procedure TCustomSimpleXMLExporter.DoDataRowEnd;
+
+begin
+  If FormatSettings.FieldAsAttributes then
+    OutputRow(FCurrentRow+'/>')
+  else
+    begin
+    DecIndent;
+    OutputRow('</'+FRowElementName+'>');
+    end;
+  FCurrentRow:='';
+  inherited DoDataRowEnd;
+end;
+
+{ TSimpleXMLFormatSettings }
+
+procedure TSimpleXMLFormatSettings.Assign(Source: TPersistent);
+
+Var
+  XS : TSimpleXMLFormatSettings;
+
+begin
+  If Source is TSimpleXMLFormatSettings then
+    begin
+    Xs:=TSimpleXMLFormatSettings(Source);
+    StartNodePath:=XS.StartNodePath;
+    RowElementName:=XS.RowElementName;
+    FieldAsAttributes:=XS.FieldAsAttributes;
+    IndentSize:=XS.IndentSize;
+    end;
+  inherited Assign(Source);
+end;
+
+Procedure RegisterSimpleXMLExportFormat;
+
+begin
+  ExportFormats.RegisterExportFormat(SSimpleXML,SSimpleXMLDescription,SSimpleXMLExtensions,TSimpleXMLExporter);
+end;
+
+Procedure UnRegisterSimpleXMLExportFormat;
+
+begin
+  ExportFormats.UnregisterExportFormat(SSimpleXML);
+end;
+
+end.
+

packages/fcl-db/src/export/fpsqlexport.pp

@@ -0,0 +1,309 @@
+unit fpSQLExport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, fpDBExport;
+  
+Type
+  { TSQLExportFieldItem }
+
+  TSQLExportFieldItem = Class(TExportFieldItem)
+  private
+    FKeyField: Boolean;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property KeyField : Boolean Read FKeyField Write FKeyField;
+  end;
+
+  TSQLEscapeStyle = (sesFirebird,sesMySQL);
+  TSQLStatementKind = (skInsert,skFullInsert,skUpdate);
+  { TSQLFormatSettings }
+
+  TSQLFormatSettings = class(TExportFormatSettings)
+  private
+    FEscapeStyle: TSQLEscapeStyle;
+    FQuoteChar: String;
+    FQuoteIdentifiers: Boolean;
+    FStatementKind: TSQLStatementKind;
+    FTableName: String;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property EscapeStyle : TSQLEscapeStyle Read FEscapeStyle Write FEscapeStyle;
+    Property StatementKind : TSQLStatementKind Read FStatementKind Write FStatementKind;
+    Property QuoteIdentifiers : Boolean Read FQuoteIdentifiers Write FQuoteIdentifiers;
+    Property QuoteChar : String Read FQuoteChar Write FQuoteChar;
+    Property TableName : String Read FTableName Write FTableName;
+  end;
+
+  { TCustomSQLExporter }
+
+  TCustomSQLExporter = Class(TCustomFileExporter)
+  private
+    FES : TSQLEscapeStyle;
+    FQI : Boolean;
+    FTN : String;
+    FSK : TSQLStatementKind;
+    FQC : String;
+    FUS : Boolean;
+    FCurrentRow : String;
+    function GetSQLFormatsettings: TSQLFormatSettings;
+    function QuoteField(const S: String): String;
+    function SQLValue(F: TField): String;
+    procedure SetSQLFormatSettings(const AValue: TSQLFormatSettings);
+  Protected
+    Function CreateFormatSettings : TCustomExportFormatSettings; override;
+    Function  CreateExportFields : TExportFields; override;
+    Procedure DoBeforeExecute; override;
+    Procedure DoAfterExecute; override;
+    Procedure DoDataRowStart; override;
+    Procedure ExportField(EF : TExportFieldItem); override;
+    Procedure DoDataRowEnd; override;
+    Function MaybeQuote(Const S : String) : String;
+    Procedure OutputRow(Const ARow : String);
+  Public
+    Property FormatSettings : TSQLFormatSettings Read GetSQLFormatsettings Write SetSQLFormatSettings;
+  end;
+
+  TSQLExporter = Class(TCustomSQLExporter)
+  Published
+    Property FileName;
+    Property Dataset;
+    Property ExportFields;
+    Property FromCurrent;
+    Property RestorePosition;
+    Property FormatSettings;
+    Property OnExportRow;
+  end;
+
+Procedure RegisterSQLExportFormat;
+Procedure UnRegisterSQLExportFormat;
+
+Const
+  SSQLExport     = 'SQL';
+  SSQLExtensions = '.sql';
+  
+Resourcestring
+  SSQLDescription         = 'SQL INSERT/Update Statements';
+  SErrMissingTableName    = 'No tablename set for SQL Export';
+  SErrNoKeyFieldForUpdate = 'No key fields defined for update statement in SQL export';
+
+implementation
+
+{ TSQLFormatSettings }
+
+procedure TSQLFormatSettings.Assign(Source: TPersistent);
+
+Var
+  FS : TSQLFormatSettings;
+
+begin
+  if (Source is TSQLFormatSettings) then
+    begin
+    FS:=(Source as TSQLFormatSettings);
+    EscapeStyle:=FS.EscapeStyle;
+    StatementKind:=FS.StatementKind;
+    QuoteIdentifiers:=FS.QuoteIdentifiers;
+    QuoteChar:=FS.QuoteChar;
+    TableName:=FS.TableName;
+    end;
+  inherited Assign(Source);
+end;
+
+{ TCustomSQLExporter }
+
+function TCustomSQLExporter.GetSQLFormatsettings: TSQLFormatSettings;
+begin
+  Result:=TSQLFormatSettings(Inherited Formatsettings);
+end;
+
+procedure TCustomSQLExporter.SetSQLFormatSettings(
+  const AValue: TSQLFormatSettings);
+begin
+  Inherited FormatSettings:=AValue;
+end;
+
+function TCustomSQLExporter.CreateFormatSettings: TCustomExportFormatSettings;
+begin
+  Result:=TSQLFOrmatSettings.Create(False);
+end;
+
+function TCustomSQLExporter.CreateExportFields: TExportFields;
+begin
+  Result:=TExportFields.Create(TSQLExportFieldItem);
+end;
+
+procedure TCustomSQLExporter.DoBeforeExecute;
+
+Var
+  OK : Boolean;
+  I : Integer;
+
+begin
+  If (FormatSettings.TableName='') then
+    ExportError(SErrMissingTableName);
+  if (FormatSettings.StatementKind=skUpdate) then
+    begin
+    OK:=False;
+    I:=0;
+    While (I<ExportFields.Count) and Not OK do
+      begin
+      OK:=TSQLExportFieldItem(ExportFields[i]).KeyField;
+      Inc(I);
+      end;
+    If Not OK then
+      ExportError(SErrNoKeyFieldForUpdate);
+    end;
+  inherited DoBeforeExecute;
+  OpenTextFile;
+  FES:=FormatSettings.EscapeStyle;
+  FQI:=FormatSettings.QuoteIdentifiers;
+  FTN:=FormatSettings.TableName;
+  FSK:=FormatSettings.StatementKind;
+  FQC:=FormatSettings.QuoteChar;
+end;
+
+procedure TCustomSQLExporter.DoAfterExecute;
+begin
+  CloseTextFile;
+  inherited DoAfterExecute;
+end;
+
+procedure TCustomSQLExporter.DoDataRowStart;
+begin
+  FCurrentRow:=''
+end;
+
+function TCustomSQLExporter.QuoteField (Const S : String) : String;
+
+begin
+  If FES=sesFirebird then
+    Result:=StringReplace(S,'''','''''',[rfReplaceAll])
+  else
+    Result:=StringReplace(S,'''','\''',[rfReplaceAll]);
+end;
+
+Function TCustomSQLExporter.SQLValue(F : TField) : String;
+
+begin
+  Result:=FormatField(F);
+  If (F.DataType in StringFieldTypes+DateFieldTypes) then
+    Result:=''''+QuoteFIeld(Result)+'''';
+end;
+
+procedure TCustomSQLExporter.ExportField(EF: TExportFieldItem);
+
+Var
+  S : string;
+
+begin
+  If (FSK<>skUpdate) or (Not TSQLExportFieldItem(EF).KeyField) then
+    begin
+    If (FCurrentRow<>'') then
+      FCurrentRow:=FcurrentRow+', ';
+    S:=SQLValue(EF.FIeld);
+    If FSK<>skUpdate then
+      FCurrentRow:=FCurrentRow+S
+    else
+      FCurrentRow:=FCurrentRow+MaybeQuote(EF.ExportedName)+'='+S;
+    end;
+end;
+
+function TCustomSQLExporter.MaybeQuote (Const S : String) : String;
+
+begin
+  Result:=S;
+  If FQI then
+    Result:=FQC+Result+FQC;
+end;
+
+procedure TCustomSQLExporter.OutputRow(const ARow: String);
+begin
+  Writeln(TextFile,ARow);
+end;
+
+procedure TCustomSQLExporter.DoDataRowEnd;
+
+Var
+  S,T : String;
+  I   : Integer;
+  EF  : TExportFieldItem;
+
+begin
+  If FSK<>skUpdate then
+    begin
+    S:='INSERT INTO '+MaybeQuote(FTN);
+    If FSK=skFullInsert then
+      begin
+      S:=S+' (';
+      T:='';
+      For I:=0 to ExportFields.Count-1 do
+        begin
+        EF:=ExportFields[i];
+        If EF.Enabled then
+          begin
+          If (T<>'') then
+            T:=T+', ';
+          T:=T+MaybeQuote(EF.ExportedName);
+          end;
+        end;
+      S:=S+T+')';
+      OutputRow(S);
+      S:=''
+      end;
+    S:=S+' VALUES ('+FCurrentRow+');';
+    end
+  else
+    begin
+    S:='UPDATE '+MaybeQuote(FTN)+' SET '+FCurrentRow;
+    OutputRow(S);
+    S:='(';
+    For I:=0 to ExportFields.Count-1 do
+      begin
+      EF:=ExportFields[i];
+      If TSQLExportFieldItem(EF).KeyField then
+        begin
+        If (S<>'(') then
+          S:=S+') AND (';
+        S:=S+MaybeQuote(EF.ExportedName)+' = '+SQLValue(EF.Field);
+        end;
+      end;
+    S:=' WHERE '+S+');';
+    end;
+  OutputRow(S);
+end;
+
+{ TSQLExportFieldItem }
+
+procedure TSQLExportFieldItem.Assign(Source: TPersistent);
+
+Var
+  FI : TSQLExportFieldItem;
+
+begin
+  If Source is TSQLExportFieldItem then
+    begin
+    FI:=Source as TSQLExportFieldItem;
+    KeyField:=FI.KeyField;
+    end;
+  inherited Assign(Source);
+end;
+
+Procedure RegisterSQLExportFormat;
+
+begin
+  ExportFormats.RegisterExportFormat(SSQLExport,SSQLDescription,SSQLExtensions,TSQLExporter);
+end;
+
+Procedure UnRegisterSQLExportFormat;
+
+begin
+  ExportFormats.UnRegisterExportFormat(SSQLExport);
+end;
+
+end.
+

packages/fcl-db/src/export/fpstdexports.pp

@@ -0,0 +1,166 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2007 by Michael Van Canneyt, member of the
+    Free Pascal development team
+
+    Standard export formats registration.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+  This unit has a routine and a component to register standard distributed
+  export formats in an application. The Component version is meant for
+  use in Lazarus: Drop it on a form, set the formats you want to see
+  registered, and set active to true. When the form is created a run-time,
+  the selected formats will be registered.
+  
+  The simple call takes an optional single argument, a set which tells
+  the call which formats to register. If none is specified, all formats
+  are registered.
+
+}
+unit fpstdexports;
+
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpDBExport;
+  
+Type
+  TStdExportformat = (sefCSV,sefFixedLength,sefSimpleXMl,sefSimpleJSON,sefSQL,sefDBF);
+  TStdExportformats = Set of TStdExportFormat;
+
+Const
+  AllStdExportFormats = [sefCSV,sefFixedLength,sefSimpleXMl,sefSimpleJSON,sefSQL,sefDBF];
+
+Type
+
+  { TStandardExportFormats }
+
+  TStandardExportFormats = Class(TComponent)
+  private
+    FActive: Boolean;
+    FFormats: TStdExportFormats;
+    FRegistered : TStdExportFormats;
+    procedure SetActive(const AValue: Boolean);
+  Protected
+    Procedure Loaded; override;
+    Procedure DoRegister;
+    Procedure DoUnregister;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Active : Boolean Read FActive Write SetActive;
+    Property Formats : TStdExportFormats Read FFormats Write FFormats Default AllStdExportFormats;
+  end;
+  
+Function RegisterStdFormats(Fmts : TStdExportFormats) : TStdExportFormats; overload;
+Function RegisterStdFormats : TStdExportFormats; overload;
+Function UnRegisterStdFormats(Fmts : TStdExportFormats) : TStdExportFormats;
+
+implementation
+
+uses
+  fpcsvexport,
+  fpfixedexport,
+  fpsimplexmlexport,
+  fpsimplejsonexport,
+  fpsqlexport,
+  fpdbfexport;
+
+Const
+  StdExportNames : Array[TStdExportFormat] of string
+                 = (SCSVExport,SFixedLengthExport,SSimpleXML,
+                    SSimpleJSON,SSQLExport,SDBFExport);
+  StdExportRegProcs : Array[TStdExportFormat] of Procedure
+                 = (@RegisterCSVExportFormat,@RegisterFixedExportFormat,@RegisterSimpleXMLExportFormat,
+                    @RegisterSimpleJSONExportFormat,@RegisterSQLExportFormat,@RegisterDBFExportFormat);
+  StdExportUnRegProcs : Array[TStdExportFormat] of Procedure
+                 = (@UnRegisterCSVExportFormat,@UNRegisterFixedExportFormat,@UnRegisterSimpleXMLExportFormat,
+                    @UnRegisterSimpleJSONExportFormat,@UnRegisterSQLExportFormat,@UnRegisterDBFExportFormat);
+
+Function RegisterStdFormats : TStdExportFormats;
+
+begin
+  Result:=RegisterStdFormats(AllStdExportFormats);
+end;
+
+
+function RegisterStdFormats(Fmts: TStdExportFormats): TStdExportFormats;
+
+Var
+  F : TStdExportFormat;
+
+begin
+  Result:=[];
+  For F:=Low(TStdExportFormat) to High(TStdExportFormat) do
+    If (F in Fmts) and (ExportFormats.IndexOfFormat(StdExportNames[f])=-1) then
+      begin
+      StdExportRegProcs[f];
+      Include(Result,F);
+      end;
+end;
+
+function UnRegisterStdFormats(Fmts: TStdExportFormats): TStdExportFormats;
+
+Var
+  F : TStdExportFormat;
+
+begin
+  Result:=[];
+  For F:=Low(TStdExportFormat) to High(TStdExportFormat) do
+    If (F in Fmts) and (ExportFormats.IndexOfFormat(StdExportNames[f])<>-1) then
+      begin
+      StdExportUnRegProcs[f];
+      Include(Result,F);
+      end;
+
+end;
+
+{ TStandardExportFormats }
+
+procedure TStandardExportFormats.SetActive(const AValue: Boolean);
+begin
+  if FActive=AValue then
+    exit;
+  FActive:=AValue;
+  If Not (csLoading in ComponentState) then
+    If Active then
+      DoRegister
+    else
+      DoUnregister;
+end;
+
+procedure TStandardExportFormats.Loaded;
+begin
+  If FActive then
+    DoRegister;
+end;
+
+procedure TStandardExportFormats.DoRegister;
+begin
+  FRegistered:=RegisterSTdFormats(FFormats);
+end;
+
+procedure TStandardExportFormats.DoUnRegister;
+begin
+  FRegistered:=RegisterSTdFormats(FRegistered);
+end;
+
+constructor TStandardExportFormats.Create(AOwner: TComponent);
+begin
+  Inherited;
+  FFormats:=AllStdExportFormats;
+end;
+
+end.
+