Browse Source

--- Merging r30462 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30462 into '.':
U .
--- Merging r30463 into '.':
U packages/fcl-db/tests/testsqldb.pas
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
G packages/fcl-db/src/sqldb/sqldb.pp
U packages/fcl-db/src/base/dbconst.pas
--- Recording mergeinfo for merge of r30463 into '.':
G .
--- Merging r30467 into '.':
U packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30467 into '.':
G .
--- Merging r30468 into '.':
U packages/fcl-db/src/base/db.pas
U packages/fcl-db/src/base/fields.inc
--- Recording mergeinfo for merge of r30468 into '.':
G .
--- Merging r30482 into '.':
G packages/fcl-db/src/base/db.pas
U packages/fcl-db/src/base/database.inc
--- Recording mergeinfo for merge of r30482 into '.':
G .
--- Merging r30483 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30483 into '.':
G .
--- Merging r30493 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30493 into '.':
G .
--- Merging r30494 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30494 into '.':
G .
--- Merging r30503 into '.':
U packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30503 into '.':
G .
--- Merging r30504 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30504 into '.':
G .
--- Merging r30505 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30505 into '.':
G .
--- Merging r30507 into '.':
G packages/fcl-db/tests/testdbbasics.pas
U packages/fcl-db/tests/sdfdstoolsunit.pas
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30507 into '.':
G .
--- Merging r30508 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30508 into '.':
G .
--- Merging r30509 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30509 into '.':
G .
--- Merging r30513 into '.':
U packages/fcl-db/tests/tcsdfdata.pp
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30513 into '.':
G .
--- Merging r30529 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
G packages/fcl-db/tests/tcsdfdata.pp
--- Recording mergeinfo for merge of r30529 into '.':
G .
--- Merging r30530 into '.':
G packages/fcl-db/tests/tcsdfdata.pp
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30530 into '.':
G .
--- Merging r30531 into '.':
G packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30531 into '.':
G .
--- Merging r30532 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30532 into '.':
G .
--- Merging r30567 into '.':
G packages/fcl-db/tests/tcsdfdata.pp
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30567 into '.':
G .
--- Merging r30568 into '.':
G packages/fcl-db/tests/tcsdfdata.pp
--- Recording mergeinfo for merge of r30568 into '.':
G .
--- Merging r30569 into '.':
G packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30569 into '.':
G .
--- Merging r30570 into '.':
G packages/fcl-db/tests/testdbbasics.pas
--- Recording mergeinfo for merge of r30570 into '.':
G .
--- Merging r30571 into '.':
U packages/fcl-db/src/datadict/fpdatadict.pp
--- Recording mergeinfo for merge of r30571 into '.':
G .

# revisions: 30462,30463,30467,30468,30482,30483,30493,30494,30503,30504,30505,30507,30508,30509,30513,30529,30530,30531,30532,30567,30568,30569,30570,30571

git-svn-id: branches/fixes_3_0@31072 -

marco 10 years ago
parent
commit
a16d796692

+ 35 - 35
packages/fcl-db/src/base/database.inc

@@ -40,10 +40,10 @@ end;
 
 
 procedure TDatabase.DoDisconnect;
 procedure TDatabase.DoDisconnect;
 begin
 begin
-  Closedatasets;
-  Closetransactions;
+  CloseDatasets;
+  CloseTransactions;
   DoInternalDisConnect;
   DoInternalDisConnect;
-  if csloading in ComponentState then
+  if csLoading in ComponentState then
     FOpenAfterRead := false;
     FOpenAfterRead := false;
   FConnected := False;
   FConnected := False;
 end;
 end;
@@ -217,7 +217,7 @@ end;
 
 
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-    TDBdataset
+    TDBDataset
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 Procedure TDBDataset.SetDatabase (Value : TDatabase);
 Procedure TDBDataset.SetDatabase (Value : TDatabase);
@@ -345,7 +345,7 @@ begin
   FActive := false;
   FActive := false;
 end;
 end;
 
 
-procedure TDBTransaction.openTrans;
+procedure TDBTransaction.OpenTrans;
 
 
 begin
 begin
   FActive := true;
   FActive := true;
@@ -368,7 +368,7 @@ end;
 constructor TDBTransaction.Create(AOwner: TComponent);
 constructor TDBTransaction.Create(AOwner: TComponent);
 
 
 begin
 begin
-  inherited create(AOwner);
+  inherited Create(AOwner);
   FDatasets:=TList.Create;
   FDatasets:=TList.Create;
 end;
 end;
 
 
@@ -403,7 +403,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-destructor TDBTransaction.destroy;
+destructor TDBTransaction.Destroy;
 
 
 begin
 begin
   Database:=Nil;
   Database:=Nil;
@@ -423,25 +423,25 @@ begin
       TDBDataset(FDataSets[i]).Transaction:=Nil;
       TDBDataset(FDataSets[i]).Transaction:=Nil;
 end;
 end;
 
 
-function TDBTransaction.GetDataSetCount: Longint;
+function TDBTransaction.GetDataset(Index: longint): TDBDataset;
 
 
 begin
 begin
-  If Assigned(FDatasets) Then
-    Result:=FDatasets.Count
+  If Assigned(FDatasets) then
+    Result:=TDBDataset(FDatasets[Index])
   else
   else
-    Result:=0;
+  begin
+    Result := nil;
+    DatabaseError(SNoDatasets);
+  end;
 end;
 end;
 
 
-procedure TDBTransaction.UnRegisterDataset (DS : TDBDataset);
-
-Var I : longint;
+function TDBTransaction.GetDataSetCount: Longint;
 
 
 begin
 begin
-  I:=FDatasets.IndexOf(DS);
-  If I<>-1 then
-    FDatasets.Delete(I)
+  If Assigned(FDatasets) Then
+    Result:=FDatasets.Count
   else
   else
-    DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
+    Result:=0;
 end;
 end;
 
 
 procedure TDBTransaction.RegisterDataset (DS : TDBDataset);
 procedure TDBTransaction.RegisterDataset (DS : TDBDataset);
@@ -456,27 +456,22 @@ begin
     DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
     DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
 end;
 end;
 
 
-function TDBTransaction.GetDataset(Index: longint): TDBDataset;
+procedure TDBTransaction.UnRegisterDataset (DS : TDBDataset);
+
+Var I : longint;
 
 
 begin
 begin
-  If Assigned(FDatasets) then
-    Result:=TDBDataset(FDatasets[Index])
+  I:=FDatasets.IndexOf(DS);
+  If I<>-1 then
+    FDatasets.Delete(I)
   else
   else
-  begin
-    result := nil;
-    DatabaseError(SNoDatasets);
-  end;
+    DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
 end;
 end;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     TCustomConnection
     TCustomConnection
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
-procedure TCustomConnection.SetAfterConnect(const AValue: TNotifyEvent);
-begin
-  FAfterConnect:=AValue;
-end;
-
 function TCustomConnection.GetDataSet(Index: Longint): TDataSet;
 function TCustomConnection.GetDataSet(Index: Longint): TDataSet;
 begin
 begin
   Result := nil;
   Result := nil;
@@ -495,6 +490,11 @@ begin
     ShowException(ExceptObject,ExceptAddr);
     ShowException(ExceptObject,ExceptAddr);
 end;
 end;
 
 
+procedure TCustomConnection.SetAfterConnect(const AValue: TNotifyEvent);
+begin
+  FAfterConnect:=AValue;
+end;
+
 procedure TCustomConnection.SetAfterDisconnect(const AValue: TNotifyEvent);
 procedure TCustomConnection.SetAfterDisconnect(const AValue: TNotifyEvent);
 begin
 begin
   FAfterDisconnect:=AValue;
   FAfterDisconnect:=AValue;
@@ -505,6 +505,11 @@ begin
   FBeforeConnect:=AValue;
   FBeforeConnect:=AValue;
 end;
 end;
 
 
+procedure TCustomConnection.SetBeforeDisconnect(const AValue: TNotifyEvent);
+begin
+  FBeforeDisconnect:=AValue;
+end;
+
 procedure TCustomConnection.DoLoginPrompt;
 procedure TCustomConnection.DoLoginPrompt;
 
 
 var
 var
@@ -555,11 +560,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TCustomConnection.SetBeforeDisconnect(const AValue: TNotifyEvent);
-begin
-  FBeforeDisconnect:=AValue;
-end;
-
 procedure TCustomConnection.GetLoginParams(out ADatabaseName, AUserName, APassword: string);
 procedure TCustomConnection.GetLoginParams(out ADatabaseName, AUserName, APassword: string);
 begin
 begin
   if IsPublishedProp(Self,'DatabaseName') then
   if IsPublishedProp(Self,'DatabaseName') then

+ 4 - 3
packages/fcl-db/src/base/db.pas

@@ -315,6 +315,7 @@ type
     procedure SetReadOnly(const AValue: Boolean);
     procedure SetReadOnly(const AValue: Boolean);
     procedure SetVisible(const AValue: Boolean);
     procedure SetVisible(const AValue: Boolean);
     function IsDisplayStored : Boolean;
     function IsDisplayStored : Boolean;
+    function IsDisplayWidthStored: Boolean;
     function GetLookupList: TLookupList;
     function GetLookupList: TLookupList;
     procedure CalcLookupValue;
     procedure CalcLookupValue;
   protected
   protected
@@ -429,7 +430,7 @@ type
     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
     property DisplayLabel : string read GetDisplayName write SetDisplayLabel stored IsDisplayStored;
     property DisplayLabel : string read GetDisplayName write SetDisplayLabel stored IsDisplayStored;
-    property DisplayWidth: Longint read GetDisplayWidth write SetDisplayWidth;
+    property DisplayWidth: Longint read GetDisplayWidth write SetDisplayWidth stored IsDisplayWidthStored;
     property FieldKind: TFieldKind read FFieldKind write FFieldKind;
     property FieldKind: TFieldKind read FFieldKind write FFieldKind;
     property FieldName: string read FFieldName write FFieldName;
     property FieldName: string read FFieldName write FFieldName;
     property HasConstraints: Boolean read FHasConstraints;
     property HasConstraints: Boolean read FHasConstraints;
@@ -1914,7 +1915,7 @@ type
     Function AllowClose(DS: TDBDataset): Boolean; virtual;
     Function AllowClose(DS: TDBDataset): Boolean; virtual;
     Procedure SetDatabase (Value : TDatabase); virtual;
     Procedure SetDatabase (Value : TDatabase); virtual;
     procedure CloseTrans;
     procedure CloseTrans;
-    procedure openTrans;
+    procedure OpenTrans;
     Procedure CheckDatabase;
     Procedure CheckDatabase;
     Procedure CheckActive;
     Procedure CheckActive;
     Procedure CheckInactive;
     Procedure CheckInactive;
@@ -1928,7 +1929,7 @@ type
     procedure Loaded; override;
     procedure Loaded; override;
   Public
   Public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
-    Destructor destroy; override;
+    Destructor Destroy; override;
     procedure CloseDataSets;
     procedure CloseDataSets;
     Property DataBase : TDatabase Read FDatabase Write SetDatabase;
     Property DataBase : TDatabase Read FDatabase Write SetDatabase;
   published
   published

+ 1 - 0
packages/fcl-db/src/base/dbconst.pas

@@ -122,6 +122,7 @@ Resourcestring
   SErrRefreshNotSingleton     = 'Refresh SQL resulted in multiple records: %d.';
   SErrRefreshNotSingleton     = 'Refresh SQL resulted in multiple records: %d.';
   SErrRefreshEmptyResult      = 'Refresh SQL resulted in empty result set.';
   SErrRefreshEmptyResult      = 'Refresh SQL resulted in empty result set.';
   SErrNoKeyFieldForRefreshClause = 'No key field found to construct refresh SQL WHERE clause';
   SErrNoKeyFieldForRefreshClause = 'No key field found to construct refresh SQL WHERE clause';
+  SErrFailedToFetchReturningResult = 'Failed to fetch returning result';
 
 
 Implementation
 Implementation
 
 

+ 6 - 0
packages/fcl-db/src/base/fields.inc

@@ -632,6 +632,12 @@ begin
   Result:=(DisplayLabel<>FieldName);
   Result:=(DisplayLabel<>FieldName);
 end;
 end;
 
 
+Function TField.IsDisplayWidthStored : Boolean;
+
+begin
+  Result:=(FDisplayWidth<>0);
+end;
+
 function TField.GetLookupList: TLookupList;
 function TField.GetLookupList: TLookupList;
 begin
 begin
   if not Assigned(FLookupList) then
   if not Assigned(FLookupList) then

+ 1 - 0
packages/fcl-db/src/datadict/fpdatadict.pp

@@ -1647,6 +1647,7 @@ end;
 
 
 destructor TFPDataDictionary.Destroy;
 destructor TFPDataDictionary.Destroy;
 begin
 begin
+  FreeAndNil(FDomains);
   FreeAndNil(FSequences);
   FreeAndNil(FSequences);
   FreeAndNil(FTables);
   FreeAndNil(FTables);
   inherited Destroy;
   inherited Destroy;

+ 147 - 173
packages/fcl-db/src/sdf/sdfdata.pp

@@ -137,7 +137,7 @@ type
 // TRecInfo
 // TRecInfo
   PRecInfo = ^TRecInfo;
   PRecInfo = ^TRecInfo;
   TRecInfo = packed record
   TRecInfo = packed record
-    RecordNumber: PtrInt;
+    Bookmark: PtrInt;
     BookmarkFlag: TBookmarkFlag;
     BookmarkFlag: TBookmarkFlag;
   end;
   end;
 //-----------------------------------------------------------------------------
 //-----------------------------------------------------------------------------
@@ -162,15 +162,14 @@ type
     procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
     procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
   protected
   protected
     FData               :TStringlist;
     FData               :TStringlist;
+    FDataOffset         :Integer;
     FCurRec             :Integer;
     FCurRec             :Integer;
-    FRecBufSize         :Integer;
     FRecordSize         :Integer;
     FRecordSize         :Integer;
-    FLastBookmark       :PtrInt;
+    FRecBufSize         :Integer;
     FRecInfoOfs         :Integer;
     FRecInfoOfs         :Integer;
-    FBookmarkOfs        :Integer;
+    FLastBookmark       :PtrInt;
     FSaveChanges        :Boolean;
     FSaveChanges        :Boolean;
     FDefaultRecordLength:Cardinal;
     FDefaultRecordLength:Cardinal;
-    FDataOffset         : Integer;
   protected
   protected
     function AllocRecordBuffer: TRecordBuffer; override;
     function AllocRecordBuffer: TRecordBuffer; override;
     procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
     procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
@@ -200,8 +199,7 @@ type
     function GetRecNo: Integer; override;
     function GetRecNo: Integer; override;
     procedure SetRecNo(Value: Integer); override;
     procedure SetRecNo(Value: Integer); override;
     function GetCanModify: boolean; override;
     function GetCanModify: boolean; override;
-    function TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
-    function RecordFilter(RecBuf: Pointer; ARecNo: Integer): Boolean;
+    function RecordFilter(RecBuf: TRecordBuffer): Boolean;
     function BufToStore(Buffer: TRecordBuffer): String; virtual;
     function BufToStore(Buffer: TRecordBuffer): String; virtual;
     function StoreToBuf(Source: String): String; virtual;
     function StoreToBuf(Source: String): String; virtual;
   public
   public
@@ -209,6 +207,7 @@ type
       write FDefaultRecordLength default 250;
       write FDefaultRecordLength default 250;
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
     destructor  Destroy; override;
+    function  BookmarkValid(ABookmark: TBookmark): Boolean; override;
     function  GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     function  GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     procedure RemoveBlankRecords; dynamic;
     procedure RemoveBlankRecords; dynamic;
     procedure RemoveExtraColumns; dynamic;
     procedure RemoveExtraColumns; dynamic;
@@ -258,23 +257,21 @@ type
   private
   private
     FDelimiter : Char;
     FDelimiter : Char;
     FFirstLineAsSchema : Boolean;
     FFirstLineAsSchema : Boolean;
-    FFMultiLine        : Boolean;
+    FMultiLine         : Boolean;
     FStripTrailingDelimiters : Boolean;
     FStripTrailingDelimiters : Boolean;
-    procedure DoStripTrailingDelimiters(var S: String; All : Boolean);
+    procedure DoStripTrailingDelimiters(var S: String);
     procedure SetMultiLine(const Value: Boolean);
     procedure SetMultiLine(const Value: Boolean);
     procedure SetFirstLineAsSchema(Value : Boolean);
     procedure SetFirstLineAsSchema(Value : Boolean);
     procedure SetDelimiter(Value : Char);
     procedure SetDelimiter(Value : Char);
   protected
   protected
-    function GetRecordCount: Integer; override;
     procedure InternalInitFieldDefs; override;
     procedure InternalInitFieldDefs; override;
-    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
-             : TGetResult; override;
     function BufToStore(Buffer: TRecordBuffer): String; override;
     function BufToStore(Buffer: TRecordBuffer): String; override;
     function StoreToBuf(Source: String): String; override;
     function StoreToBuf(Source: String): String; override;
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
   published
   published
-    property AllowMultiLine: Boolean read FFMultiLine write SetMultiLine default True; //Whether or not to allow fields containing CR and/or LF
+    // Whether or not to allow fields containing CR and/or LF (on write only)
+    property AllowMultiLine: Boolean read FMultiLine write SetMultiLine;
     property Delimiter: Char read FDelimiter write SetDelimiter;
     property Delimiter: Char read FDelimiter write SetDelimiter;
     property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
     property FirstLineAsSchema: Boolean read FFirstLineAsSchema write SetFirstLineAsSchema;
     // Set this to True if you want to strip all last delimiters
     // Set this to True if you want to strip all last delimiters
@@ -294,7 +291,7 @@ begin
   FFileMustExist  := TRUE;
   FFileMustExist  := TRUE;
   FLoadfromStream := False;
   FLoadfromStream := False;
   FRecordSize   := 0;
   FRecordSize   := 0;
-  FTrimSpace     := TRUE;
+  FTrimSpace    := TRUE;
   FSchema       := TStringList.Create;
   FSchema       := TStringList.Create;
   FData         := TStringList.Create;  // Load the textfile into a stringlist
   FData         := TStringList.Create;  // Load the textfile into a stringlist
   inherited Create(AOwner);
   inherited Create(AOwner);
@@ -374,7 +371,6 @@ procedure TFixedFormatDataSet.InternalOpen;
 var
 var
   Stream : TStream;
   Stream : TStream;
 begin
 begin
-  FCurRec := -1;
   FSaveChanges := FALSE;
   FSaveChanges := FALSE;
   if not Assigned(FData) then
   if not Assigned(FData) then
     FData := TStringList.Create;
     FData := TStringList.Create;
@@ -387,16 +383,16 @@ begin
     FData.LoadFromFile(FileName);
     FData.LoadFromFile(FileName);
   FRecordSize := FDefaultRecordLength;
   FRecordSize := FDefaultRecordLength;
   InternalInitFieldDefs;
   InternalInitFieldDefs;
+  if FRecordSize = 0 then
+    FRecordSize := FDefaultRecordLength;
   if DefaultFields then
   if DefaultFields then
     CreateFields;
     CreateFields;
   BindFields(TRUE);
   BindFields(TRUE);
-  if FRecordSize = 0 then
-    FRecordSize := FDefaultRecordLength;
   BookmarkSize := SizeOf(PtrInt);
   BookmarkSize := SizeOf(PtrInt);
   FRecInfoOfs := FRecordSize + CalcFieldsSize; // Initialize the offset for TRecInfo in the buffer
   FRecInfoOfs := FRecordSize + CalcFieldsSize; // Initialize the offset for TRecInfo in the buffer
-  FBookmarkOfs := FRecInfoOfs + SizeOf(TRecInfo);
-  FRecBufSize := FBookmarkOfs + BookmarkSize;
+  FRecBufSize := FRecInfoOfs + SizeOf(TRecInfo);
   FLastBookmark := FData.Count;
   FLastBookmark := FData.Count;
+  FCurRec := FDataOffset - 1;
 end;
 end;
 
 
 procedure TFixedFormatDataSet.InternalClose;
 procedure TFixedFormatDataSet.InternalClose;
@@ -404,7 +400,7 @@ begin
   if (not FReadOnly) and (FSaveChanges) then  // Write any edits to disk
   if (not FReadOnly) and (FSaveChanges) then  // Write any edits to disk
     FData.SaveToFile(FileName);
     FData.SaveToFile(FileName);
   FLoadfromStream := False;
   FLoadfromStream := False;
-  FData.Clear;
+  FData.Clear;          // Clear data
   BindFields(FALSE);
   BindFields(FALSE);
   if DefaultFields then // Destroy the TField
   if DefaultFields then // Destroy the TField
     DestroyFields;
     DestroyFields;
@@ -480,47 +476,80 @@ end;
 
 
 function TFixedFormatDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
 function TFixedFormatDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
   DoCheck: Boolean): TGetResult;
   DoCheck: Boolean): TGetResult;
+var
+  Accepted : Boolean;
 begin
 begin
-  if (FData.Count < (1+FDataOffset)) then
+  if (FData.Count <= FDataOffset) then
     Result := grEOF
     Result := grEOF
   else
   else
-    Result := TxtGetRecord(Buffer, GetMode);
-  if Result = grOK then
   begin
   begin
-    if (CalcFieldsSize > 0) then
-      GetCalcFields(Buffer);
-    with PRecInfo(Buffer + FRecInfoOfs)^ do
-    begin
-      BookmarkFlag := bfCurrent;
-      RecordNumber := PtrInt(FData.Objects[FCurRec]);
-    end;
-  end
-  else
-    if (Result = grError) and DoCheck then
-      DatabaseError('No Records');
+    Result := grOK;
+    repeat
+      Accepted := TRUE;
+      case GetMode of
+        gmNext:
+          if FCurRec >= FData.Count - 1  then
+            Result := grEOF
+          else
+            Inc(FCurRec);
+        gmPrior:
+          if FCurRec <= FDataOffset then
+            Result := grBOF
+          else
+            Dec(FCurRec);
+        gmCurrent:
+          if (FCurRec < FDataOffset) or (FCurRec >= FData.Count) then
+            Result := grError;
+      end;
+
+      if Result = grOk then
+      begin
+        Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
+        with PRecInfo(Buffer + FRecInfoOfs)^ do
+        begin
+          Bookmark := PtrInt(FData.Objects[FCurRec]);
+          BookmarkFlag := bfCurrent;
+        end;
+        if CalcFieldsSize > 0 then GetCalcFields(Buffer);
+
+        if Filtered then
+        begin
+          Accepted := RecordFilter(Buffer);
+          if not Accepted and (GetMode = gmCurrent) then
+            Inc(FCurRec);
+        end;
+      end
+      else if (Result = grError) and DoCheck then
+        DatabaseError('No Records');
+    until (Result <> grOK) or Accepted;
+  end;
 end;
 end;
 
 
 function TFixedFormatDataSet.GetRecordCount: Longint;
 function TFixedFormatDataSet.GetRecordCount: Longint;
 begin
 begin
-  Result := FData.Count;
+  Result := FData.Count - FDataOffset;
+  if Result < 0 then Result := 0; // closed dataset
 end;
 end;
 
 
 function TFixedFormatDataSet.GetRecNo: Longint;
 function TFixedFormatDataSet.GetRecNo: Longint;
 var
 var
-  BufPtr: TRecordBuffer;
+  RecBuf: TRecordBuffer;
 begin
 begin
-  Result := -1;
-  if GetActiveRecBuf(BufPtr) then
-    Result := PRecInfo(BufPtr + FRecInfoOfs)^.RecordNumber;
+  Result := 0;
+  if GetActiveRecBuf(RecBuf) and (State <> dsInsert) then
+  begin
+    InternalSetToRecord(RecBuf);
+    Result := FCurRec + 1 - FDataOffset;
+  end;
 end;
 end;
 
 
 procedure TFixedFormatDataSet.SetRecNo(Value: Integer);
 procedure TFixedFormatDataSet.SetRecNo(Value: Integer);
 begin
 begin
   CheckBrowseMode;
   CheckBrowseMode;
-  if (Value >= 0) and (Value < FData.Count) and (Value <> RecNo) then
+  if (Value >= 0) and (Value <= RecordCount) and (Value <> RecNo) then
   begin
   begin
     DoBeforeScroll;
     DoBeforeScroll;
-    FCurRec := Value - 1;
+    FCurRec := Value - 1 + FDataOffset;
     Resync([]);
     Resync([]);
     DoAfterScroll;
     DoAfterScroll;
   end;
   end;
@@ -544,54 +573,16 @@ begin
   Result := RecBuf <> nil;
   Result := RecBuf <> nil;
 end;
 end;
 
 
-function TFixedFormatDataSet.TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
-var
-  Accepted : Boolean;
-begin
-  Result := grOK;
-  repeat
-    Accepted := TRUE;
-    case GetMode of
-      gmNext:
-        if FCurRec >= RecordCount - 1  then
-          Result := grEOF
-        else
-          Inc(FCurRec);
-      gmPrior:
-        if FCurRec <= FDataOffset then
-          Result := grBOF
-        else
-          Dec(FCurRec);
-      gmCurrent:
-        if (FCurRec < FDataOffset) or (FCurRec >= RecordCount) then
-          Result := grError;
-    end;
-    if (Result = grOk) then
-    begin
-      Move(PChar(StoreToBuf(FData[FCurRec]))^, Buffer[0], FRecordSize);
-      if Filtered then
-      begin
-        Accepted := RecordFilter(Buffer, FCurRec +1);
-        if not Accepted and (GetMode = gmCurrent) then
-          Inc(FCurRec);
-      end;
-    end;
-  until Accepted;
-end;
-
-function TFixedFormatDataSet.RecordFilter(RecBuf: Pointer; ARecNo: Integer): Boolean;
+function TFixedFormatDataSet.RecordFilter(RecBuf: TRecordBuffer): Boolean;
 var
 var
-  Accept: Boolean;
   SaveState: TDataSetState;
   SaveState: TDataSetState;
 begin                          // Returns true if accepted in the filter
 begin                          // Returns true if accepted in the filter
   SaveState := SetTempState(dsFilter);
   SaveState := SetTempState(dsFilter);
   FFilterBuffer := RecBuf;
   FFilterBuffer := RecBuf;
-  PRecInfo(FFilterBuffer + FRecInfoOfs)^.RecordNumber := ARecNo;
-  Accept := TRUE;
-  if Accept and Assigned(OnFilterRecord) then
-    OnFilterRecord(Self, Accept);
+  Result := TRUE;
+  if Result and Assigned(OnFilterRecord) then
+    OnFilterRecord(Self, Result);
   RestoreState(SaveState);
   RestoreState(SaveState);
-  Result := Accept;
 end;
 end;
 
 
 function TFixedFormatDataSet.GetCanModify: boolean;
 function TFixedFormatDataSet.GetCanModify: boolean;
@@ -641,27 +632,28 @@ begin
       TempPos := RecBuf;
       TempPos := RecBuf;
       SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
       SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
       Result := (RecBuf < StrEnd(TempPos));
       Result := (RecBuf < StrEnd(TempPos));
-    end
-    else
-      if (State in [dsBrowse, dsEdit, dsInsert, dsCalcFields]) then
+      if Result and Assigned(Buffer) then
       begin
       begin
-        Inc(RecBuf, FRecordSize + Field.Offset);
-        Result := Boolean(Byte(RecBuf[0]));
+        StrLCopy(Buffer, RecBuf, Field.Size);
+        if FTrimSpace then // trim trailing spaces
+        begin
+          TempPos := StrEnd(Buffer);
+          repeat
+            Dec(TempPos);
+            if (TempPos[0] = ' ') then
+              TempPos[0]:= #0
+            else
+              break;
+          until (TempPos = Buffer);
+        end;
       end;
       end;
-  end;
-  if Result and (Buffer <> nil) then
-  begin
-    StrLCopy(Buffer, RecBuf, Field.Size);
-    if FTrimSpace then
+    end
+    else // fkCalculated, fkLookup
     begin
     begin
-      TempPos := StrEnd(Buffer);
-      repeat
-        Dec(TempPos);
-        if (TempPos[0] = ' ') then
-          TempPos[0]:= #0
-        else
-          break;
-      until (TempPos = Buffer);
+      Inc(RecBuf, FRecordSize + Field.Offset); // Offset is calculated using DataSize not Size
+      Result := Boolean(RecBuf[0]);
+      if Result and Assigned(Buffer) then
+        Move(RecBuf[1], Buffer^, Field.DataSize);
     end;
     end;
   end;
   end;
 end;
 end;
@@ -683,7 +675,7 @@ begin
       DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
       DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
     if State in [dsEdit, dsInsert, dsNewValue] then
     if State in [dsEdit, dsInsert, dsNewValue] then
       Field.Validate(Buffer);
       Field.Validate(Buffer);
-    if Field.FieldKind <> fkInternalCalc then
+    if Assigned(Buffer) and (Field.FieldKind <> fkInternalCalc) then
     begin
     begin
       SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
       SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
       BufEnd := StrEnd(pansichar(ActiveBuffer));  // Fill with blanks when necessary
       BufEnd := StrEnd(pansichar(ActiveBuffer));  // Fill with blanks when necessary
@@ -699,7 +691,9 @@ begin
   else // fkCalculated, fkLookup
   else // fkCalculated, fkLookup
   begin
   begin
     Inc(RecBuf, FRecordSize + Field.Offset);
     Inc(RecBuf, FRecordSize + Field.Offset);
-    Move(Buffer^, RecBuf[0], Field.Size);
+    Boolean(RecBuf[0]) := Assigned(Buffer);
+    if Assigned(Buffer) then
+      Move(Buffer^, RecBuf[1], Field.DataSize);
   end;
   end;
   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
   if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
     DataEvent(deFieldChange, Ptrint(Field));
     DataEvent(deFieldChange, Ptrint(Field));
@@ -720,7 +714,7 @@ end;
 // Navigation / Editing
 // Navigation / Editing
 procedure TFixedFormatDataSet.InternalFirst;
 procedure TFixedFormatDataSet.InternalFirst;
 begin
 begin
-  FCurRec := -1;
+  FCurRec := FDataOffset - 1;
 end;
 end;
 
 
 procedure TFixedFormatDataSet.InternalLast;
 procedure TFixedFormatDataSet.InternalLast;
@@ -730,14 +724,12 @@ end;
 
 
 procedure TFixedFormatDataSet.InternalPost;
 procedure TFixedFormatDataSet.InternalPost;
 begin
 begin
+  inherited InternalPost;
   FSaveChanges := TRUE;
   FSaveChanges := TRUE;
-  inherited UpdateRecord;
   if (State = dsEdit) then // just update the data in the string list
   if (State = dsEdit) then // just update the data in the string list
-  begin
-    FData[FCurRec] := BufToStore(ActiveBuffer);
-  end
-  else
-    InternalAddRecord(ActiveBuffer, FALSE);
+    FData[FCurRec] := BufToStore(ActiveBuffer)
+  else // append or insert
+    InternalAddRecord(ActiveBuffer, GetBookmarkFlag(ActiveBuffer)=bfEOF);
 end;
 end;
 
 
 procedure TFixedFormatDataSet.InternalEdit;
 procedure TFixedFormatDataSet.InternalEdit;
@@ -759,12 +751,17 @@ begin
   Inc(FLastBookmark);
   Inc(FLastBookmark);
   if DoAppend then
   if DoAppend then
     InternalLast;
     InternalLast;
-  if (FCurRec >=0) then
+  if (FCurRec >= FDataOffset) then
     FData.InsertObject(FCurRec, BufToStore(Buffer), TObject(Pointer(FLastBookmark)))
     FData.InsertObject(FCurRec, BufToStore(Buffer), TObject(Pointer(FLastBookmark)))
   else
   else
     FData.AddObject(BufToStore(Buffer), TObject(Pointer(FLastBookmark)));
     FData.AddObject(BufToStore(Buffer), TObject(Pointer(FLastBookmark)));
 end;
 end;
 
 
+function TFixedFormatDataSet.BookmarkValid(ABookmark: TBookmark): Boolean;
+begin
+  Result := Assigned(ABookmark) and (FData.IndexOfObject(TObject(PPtrInt(ABookmark)^)) <> -1);
+end;
+
 procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
 procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
 var
 var
   Index: Integer;
   Index: Integer;
@@ -779,7 +776,7 @@ end;
 procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
 procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
 begin
 begin
   if (State <> dsInsert) then
   if (State <> dsInsert) then
-    InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs)^.RecordNumber);
+    InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs)^.Bookmark);
 end;
 end;
 
 
 function TFixedFormatDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
 function TFixedFormatDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
@@ -858,13 +855,13 @@ begin
   inherited Create(AOwner);
   inherited Create(AOwner);
   FDelimiter := ',';
   FDelimiter := ',';
   FFirstLineAsSchema := FALSE;
   FFirstLineAsSchema := FALSE;
-  FFMultiLine :=False;
+  FMultiLine := False;
 end;
 end;
 
 
 procedure TSdfDataSet.InternalInitFieldDefs;
 procedure TSdfDataSet.InternalInitFieldDefs;
 var
 var
   pStart, pEnd, len : Integer;
   pStart, pEnd, len : Integer;
-  SL,Fn : String;
+  SchemaLine, FN : String;
 
 
 begin
 begin
   if not IsCursorOpen then
   if not IsCursorOpen then
@@ -875,79 +872,63 @@ begin
     FData.Append(Schema.DelimitedText);
     FData.Append(Schema.DelimitedText);
   end
   end
   else if (FData.Count = 0) or (Trim(FData[0]) = '') then
   else if (FData.Count = 0) or (Trim(FData[0]) = '') then
-    begin
+  begin
     FirstLineAsSchema := FALSE;
     FirstLineAsSchema := FALSE;
-    FDataOffset:=0;
-    end
-  else if (Schema.Count = 0) or (FirstLineAsSchema) then
+  end
+  else if (Schema.Count = 0) or FirstLineAsSchema then
   begin
   begin
     Schema.Clear;
     Schema.Clear;
-    SL:=FData[0];
+    SchemaLine:=FData[0];
     if StripTrailingDelimiters then
     if StripTrailingDelimiters then
-      DoStripTrailingDelimiters(SL,True);
-    len := Length(SL);
+      DoStripTrailingDelimiters(SchemaLine);
+    len := Length(SchemaLine);
     pEnd := 1;
     pEnd := 1;
     repeat
     repeat
-      while (pEnd<=len) and (SL[pEnd] in [#1..' ']) do
+      // skip leading white-spaces
+      while (pEnd<=len) and (SchemaLine[pEnd] in [#1..' ']) do
         Inc(pEnd);
         Inc(pEnd);
+
       if (pEnd > len) then
       if (pEnd > len) then
         break;
         break;
+
       pStart := pEnd;
       pStart := pEnd;
-      if (SL[pStart] = '"') then
+      if (SchemaLine[pStart] = '"') then
+        // quoted field name
         begin
         begin
         repeat
         repeat
           Inc(pEnd);
           Inc(pEnd);
-        until (pEnd > len)  or (SL[pEnd] = '"');
-        if (SL[pEnd] = '"') then
+        until (pEnd > len)  or (SchemaLine[pEnd] = '"');
+        if (SchemaLine[pEnd] = '"') then
           Inc(pStart);
           Inc(pStart);
         end
         end
       else
       else
-        while (pEnd<=len) and (SL[pEnd]<>Delimiter) do
+        // unquoted field name
+        while (pEnd<=len) and (SchemaLine[pEnd]<>Delimiter) do
           Inc(pEnd);
           Inc(pEnd);
-      if (FirstLineAsSchema) then
-        FN:=Copy(SL,pStart,pEnd - pStart)
+
+      if FirstLineAsSchema then
+        FN:=Copy(SchemaLine, pStart, pEnd - pStart)
       else
       else
         FN:='';
         FN:='';
-      if (FN='') then // Pend-PStart=0 is possible: a,b,,c
+      if FN='' then // pEnd-pStart=0 is possible: a,b,,c
         FN:=Format('Field%d', [Schema.Count + 1]);
         FN:=Format('Field%d', [Schema.Count + 1]);
       Schema.Add(FN);
       Schema.Add(FN);
-      if (Pend<=Len) and (SL[pEnd] = '"') then
-        while (pEnd <= len) and (SL[pEnd] <> Delimiter) do
+
+      // skip all after trailing quote until next Delimiter
+      if (pEnd<=Len) and (SchemaLine[pEnd] = '"') then
+        while (pEnd <= len) and (SchemaLine[pEnd] <> Delimiter) do
           Inc(pEnd);
           Inc(pEnd);
-//      if (SL[pEnd]=Delimiter) then
-        Inc(pEnd);
+
+      Inc(pEnd);
     until (pEnd > len);
     until (pEnd > len);
+
     // Special case: f1,f2, is 3 fields, last unnamed.
     // Special case: f1,f2, is 3 fields, last unnamed.
-    if (Len>0) and (SL[Len]=Delimiter) then
+    if (Len>0) and (SchemaLine[Len]=Delimiter) then
       Schema.Add(Format('Field%d', [Schema.Count + 1]));
       Schema.Add(Format('Field%d', [Schema.Count + 1]));
-
   end;
   end;
   inherited;
   inherited;
 end;
 end;
 
 
-function TSdfDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
-  DoCheck: Boolean): TGetResult;
-begin
-  if FirstLineAsSchema then
-  begin
-    if (FData.Count < 2) then
-      begin
-      if GetMode=gmPrior then
-       Result := grBOF
-      else
-       Result := grEOF
-      end
-    else
-      begin
-      If (FCurrec=-1) and (GetMode=gmNext) then
-        inc(FCurrec);
-      Result := inherited GetRecord(Buffer, GetMode, DoCheck);
-      end;
-  end
-  else
-    Result := inherited GetRecord(Buffer, GetMode, DoCheck);
-end;
-
 function TSdfDataSet.StoreToBuf(Source: String): String;
 function TSdfDataSet.StoreToBuf(Source: String): String;
 const
 const
  CR    :char = #13;
  CR    :char = #13;
@@ -979,7 +960,7 @@ begin
     IsQuoted := false;
     IsQuoted := false;
     while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
     while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
     begin
     begin
-     if FFMultiLine then
+     if FMultiLine then
       begin
       begin
        if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
        if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
         begin
         begin
@@ -1002,7 +983,7 @@ begin
     if (pStr[0] = Quote) then
     if (pStr[0] = Quote) then
      begin
      begin
       IsQuoted := true; // See below: accept end of string without explicit quote
       IsQuoted := true; // See below: accept end of string without explicit quote
-      if FFMultiLine then
+      if FMultiLine then
        begin
        begin
         repeat
         repeat
          Inc(pStrEnd);
          Inc(pStrEnd);
@@ -1078,7 +1059,7 @@ begin
     QuoteMe:=false;
     QuoteMe:=false;
     Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
     Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
     Inc(p, FieldDefs[i].Size);
     Inc(p, FieldDefs[i].Size);
-    if FFMultiLine then
+    if FMultiLine then
       begin
       begin
        // If multiline enabled, quote whenever we find carriage return or linefeed
        // If multiline enabled, quote whenever we find carriage return or linefeed
        if (not QuoteMe) and (StrScan(PChar(Str), #10) <> nil) then QuoteMe:=true;
        if (not QuoteMe) and (StrScan(PChar(Str), #10) <> nil) then QuoteMe:=true;
@@ -1101,10 +1082,10 @@ begin
       end;
       end;
     Result := Result + Str + FDelimiter;
     Result := Result + Str + FDelimiter;
   end;
   end;
-  DoStripTrailingDelimiters(Result,StripTrailingDelimiters)
+  DoStripTrailingDelimiters(Result)
 end;
 end;
 
 
-procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String; All: Boolean);
+procedure TSdfDataSet.DoStripTrailingDelimiters(var S: String);
 
 
 var
 var
   L,P : integer;
   L,P : integer;
@@ -1112,8 +1093,8 @@ begin
 //  Write('S "',S,'" -> "');
 //  Write('S "',S,'" -> "');
   L:=Length(S);
   L:=Length(S);
   P:=L;
   P:=L;
-  while (p>0) and (S[p]=FDelimiter) and (All or (P=L)) do
-    Dec(p);
+  while (P>0) and (S[P]=FDelimiter) and ((P=L) or StripTrailingDelimiters) do
+    Dec(P);
   if P<L then
   if P<L then
     S:=Copy(S,1,P);
     S:=Copy(S,1,P);
 //  Writeln(s,'"');
 //  Writeln(s,'"');
@@ -1125,13 +1106,6 @@ begin
   FDelimiter := Value;
   FDelimiter := Value;
 end;
 end;
 
 
-function TSdfDataSet.GetRecordCount: Integer;
-begin
-  Result:=Inherited GetRecordCount;
-  If Result>0 then
-    Result:=Result-Ord(FirstLineAsSchema);
-end;
-
 procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
 procedure TSdfDataSet.SetFirstLineAsSchema(Value : Boolean);
 begin
 begin
   CheckInactive;
   CheckInactive;
@@ -1141,7 +1115,7 @@ end;
 
 
 procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
 procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
 begin
 begin
-  FFMultiLine:=Value;
+  FMultiLine:=Value;
 end;
 end;
 
 
 
 

+ 1 - 1
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -180,7 +180,7 @@ constructor TIBConnection.Create(AOwner : TComponent);
 
 
 begin
 begin
   inherited;
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
+  FConnOptions := FConnOptions + [sqSupportParams, sqEscapeRepeat, sqSupportReturning];
   FBlobSegmentSize := 65535; //Shows we're using the maximum segment size
   FBlobSegmentSize := 65535; //Shows we're using the maximum segment size
   FDialect := INVALID_DATA;
   FDialect := INVALID_DATA;
   ResetDatabaseInfo;
   ResetDatabaseInfo;

+ 1 - 1
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -274,7 +274,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
 
 
 begin
 begin
   inherited;
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction];
+  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning];
   FieldNameQuoteChars:=DoubleQuotes;
   FieldNameQuoteChars:=DoubleQuotes;
   VerboseErrors:=True;
   VerboseErrors:=True;
   FConnectionPool:=TThreadlist.Create;
   FConnectionPool:=TThreadlist.Create;

+ 141 - 81
packages/fcl-db/src/sqldb/sqldb.pp

@@ -138,7 +138,7 @@ type
 
 
   { TSQLConnection }
   { TSQLConnection }
 
 
-  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID);
+  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning);
   TConnOptions= set of TConnOption;
   TConnOptions= set of TConnOption;
 
 
   TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);
   TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);
@@ -172,11 +172,11 @@ type
     // One day, this may be factored out to a TSQLResolver class.
     // One day, this may be factored out to a TSQLResolver class.
     // The following allow construction of update queries. They can be adapted as needed by descendents to fit the DB engine.
     // The following allow construction of update queries. They can be adapted as needed by descendents to fit the DB engine.
     procedure AddFieldToUpdateWherePart(var sql_where: string; UpdateMode : TUpdateMode; F: TField); virtual;
     procedure AddFieldToUpdateWherePart(var sql_where: string; UpdateMode : TUpdateMode; F: TField); virtual;
-    function ConstructInsertSQL(Query: TCustomSQLQuery): string; virtual;
-    function ConstructUpdateSQL(Query: TCustomSQLQuery): string; virtual;
+    function ConstructInsertSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string; virtual;
+    function ConstructUpdateSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string; virtual;
     function ConstructDeleteSQL(Query: TCustomSQLQuery): string; virtual;
     function ConstructDeleteSQL(Query: TCustomSQLQuery): string; virtual;
     function ConstructRefreshSQL(Query: TCustomSQLQuery; UpdateKind : TUpdateKind): string; virtual;
     function ConstructRefreshSQL(Query: TCustomSQLQuery; UpdateKind : TUpdateKind): string; virtual;
-    function InitialiseUpdateStatement(Query: TCustomSQLQuery; var qry: TCustomSQLStatement): TCustomSQLStatement;
+    function InitialiseUpdateStatement(Query: TCustomSQLQuery; var qry: TCustomSQLQuery): TCustomSQLQuery;
     procedure ApplyFieldUpdate(C : TSQLCursor; P: TSQLDBParam; F: TField; UseOldValue: Boolean); virtual;
     procedure ApplyFieldUpdate(C : TSQLCursor; P: TSQLDBParam; F: TField; UseOldValue: Boolean); virtual;
     // This is the call that updates a record, it used to be in TSQLQuery.
     // This is the call that updates a record, it used to be in TSQLQuery.
     procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual;
     procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual;
@@ -402,7 +402,7 @@ type
 
 
   { TCustomSQLQuery }
   { TCustomSQLQuery }
 
 
-  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh);
+  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoPreferRefresh);
   TSQLQueryOptions = Set of TSQLQueryOption;
   TSQLQueryOptions = Set of TSQLQueryOption;
 
 
   TCustomSQLQuery = class (TCustomBufDataset)
   TCustomSQLQuery = class (TCustomBufDataset)
@@ -433,7 +433,7 @@ type
 
 
     FInsertQry,
     FInsertQry,
     FUpdateQry,
     FUpdateQry,
-    FDeleteQry           : TCustomSQLStatement;
+    FDeleteQry           : TCustomSQLQuery;
     FSequence            : TSQLSequence;
     FSequence            : TSQLSequence;
     procedure FreeFldBuffers;
     procedure FreeFldBuffers;
     function GetParamCheck: Boolean;
     function GetParamCheck: Boolean;
@@ -466,6 +466,7 @@ type
     Function RefreshLastInsertID(Field: TField): Boolean; virtual;
     Function RefreshLastInsertID(Field: TField): Boolean; virtual;
     Function NeedRefreshRecord (UpdateKind: TUpdateKind): Boolean; virtual;
     Function NeedRefreshRecord (UpdateKind: TUpdateKind): Boolean; virtual;
     Function RefreshRecord (UpdateKind: TUpdateKind) : Boolean; virtual;
     Function RefreshRecord (UpdateKind: TUpdateKind) : Boolean; virtual;
+    Procedure ApplyReturningResult(Q : TCustomSQLQuery; UpdateKind : TUpdateKind);
     Function Cursor : TSQLCursor;
     Function Cursor : TSQLCursor;
     Function LogEvent(EventType : TDBEventType) : Boolean;
     Function LogEvent(EventType : TDBEventType) : Boolean;
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
@@ -860,12 +861,27 @@ begin
     begin
     begin
     FDatabase.FreeNotification(Self);
     FDatabase.FreeNotification(Self);
     FDatabase.RegisterStatement(Self);
     FDatabase.RegisterStatement(Self);
-    if (Transaction=nil) and (Assigned(FDatabase.Transaction)) then
-      transaction := FDatabase.Transaction;
+    if Assigned(Database.Transaction) and (not Assigned(Transaction) or (Transaction.DataBase <> Database)) then
+      Transaction := Database.Transaction;
     OnChangeSQL(Self);
     OnChangeSQL(Self);
     end;
     end;
 end;
 end;
 
 
+procedure TCustomSQLStatement.SetTransaction(AValue: TSQLTransaction);
+begin
+  if FTransaction=AValue then Exit;
+  UnPrepare;
+  if Assigned(FTransaction) then
+    FTransaction.RemoveFreeNotification(Self);
+  FTransaction:=AValue;
+  if Assigned(FTransaction) then
+    begin
+    FTransaction.FreeNotification(Self);
+    if Assigned(Transaction.DataBase) and (Database <> Transaction.DataBase) then
+      Database := Transaction.DataBase as TSQLConnection;
+    end;
+end;
+
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 
 begin
 begin
@@ -893,21 +909,6 @@ begin
   FSQL.Assign(AValue);
   FSQL.Assign(AValue);
 end;
 end;
 
 
-procedure TCustomSQLStatement.SetTransaction(AValue: TSQLTransaction);
-begin
-  if FTransaction=AValue then Exit;
-  UnPrepare;
-  if Assigned(FTransaction) then
-    FTransaction.RemoveFreeNotification(Self);
-  FTransaction:=AValue;
-  if Assigned(FTransaction) then
-    begin
-    FTransaction.FreeNotification(Self);
-    If (Database=Nil) then
-      Database:=Transaction.Database as TSQLConnection;
-    end;
-end;
-
 Procedure TCustomSQLStatement.DoExecute;
 Procedure TCustomSQLStatement.DoExecute;
 begin
 begin
   FRowsAffected:=-1;
   FRowsAffected:=-1;
@@ -985,7 +986,7 @@ begin
   Database:=Nil;
   Database:=Nil;
   DataSource:=Nil;
   DataSource:=Nil;
   FreeAndNil(FDataLink);
   FreeAndNil(FDataLink);
-  FreeAndNil(Fparams);
+  FreeAndNil(FParams);
   FreeAndNil(FSQL);
   FreeAndNil(FSQL);
   inherited Destroy;
   inherited Destroy;
 end;
 end;
@@ -1587,15 +1588,18 @@ begin
 end;
 end;
 
 
 
 
-function TSQLConnection.InitialiseUpdateStatement(Query : TCustomSQLQuery; var qry : TCustomSQLStatement): TCustomSQLStatement;
+function TSQLConnection.InitialiseUpdateStatement(Query : TCustomSQLQuery; var qry : TCustomSQLQuery): TCustomSQLQuery;
 
 
 begin
 begin
   if not assigned(qry) then
   if not assigned(qry) then
   begin
   begin
-    qry := TCustomSQLStatement.Create(nil);
+    qry := TCustomSQLQuery.Create(nil);
     qry.ParseSQL := False;
     qry.ParseSQL := False;
     qry.DataBase := Self;
     qry.DataBase := Self;
     qry.Transaction := Query.SQLTransaction;
     qry.Transaction := Query.SQLTransaction;
+    qry.Unidirectional:=True;
+    qry.UsePrimaryKeyAsKey:=False;
+    qry.PacketRecords:=1;
   end;
   end;
   Result:=qry;
   Result:=qry;
 end;
 end;
@@ -1620,16 +1624,19 @@ begin
 end;
 end;
 
 
 
 
-function TSQLConnection.ConstructInsertSQL(Query : TCustomSQLQuery) : string;
+function TSQLConnection.ConstructInsertSQL(Query : TCustomSQLQuery; Var ReturningClause : Boolean) : string;
 
 
 var x          : integer;
 var x          : integer;
     sql_fields : string;
     sql_fields : string;
     sql_values : string;
     sql_values : string;
+    returning_fields : String;
     F : TField;
     F : TField;
 
 
+
 begin
 begin
   sql_fields := '';
   sql_fields := '';
   sql_values := '';
   sql_values := '';
+  returning_fields :='';
   for x := 0 to Query.Fields.Count -1 do
   for x := 0 to Query.Fields.Count -1 do
     begin
     begin
     F:=Query.Fields[x];
     F:=Query.Fields[x];
@@ -1638,37 +1645,60 @@ begin
       sql_fields := sql_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
       sql_fields := sql_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
       sql_values := sql_values + ':"' + F.FieldName + '",';
       sql_values := sql_values + ':"' + F.FieldName + '",';
       end;
       end;
+    if ReturningClause and (pfRefreshOnInsert in F.ProviderFlags) then
+      returning_fields :=returning_fields+FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
     end;
     end;
   if length(sql_fields) = 0 then
   if length(sql_fields) = 0 then
     DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
     DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
   setlength(sql_fields,length(sql_fields)-1);
   setlength(sql_fields,length(sql_fields)-1);
   setlength(sql_values,length(sql_values)-1);
   setlength(sql_values,length(sql_values)-1);
-
   result := 'insert into ' + Query.FTableName + ' (' + sql_fields + ') values (' + sql_values + ')';
   result := 'insert into ' + Query.FTableName + ' (' + sql_fields + ') values (' + sql_values + ')';
+  if ReturningClause then
+    begin
+    ReturningClause:=length(returning_fields) <> 0 ;
+    if ReturningClause then
+      begin
+      setlength(returning_fields,length(returning_fields)-1);
+      result:=Result+' returning '+returning_fields;
+      end;
+    end;
 end;
 end;
 
 
 
 
-function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery): string;
+function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string;
 
 
 var x : integer;
 var x : integer;
     F : TField;
     F : TField;
     sql_set    : string;
     sql_set    : string;
     sql_where  : string;
     sql_where  : string;
+    returning_fields : String;
 
 
 begin
 begin
   sql_set := '';
   sql_set := '';
   sql_where := '';
   sql_where := '';
+  returning_fields :='';
   for x := 0 to Query.Fields.Count -1 do
   for x := 0 to Query.Fields.Count -1 do
     begin
     begin
     F:=Query.Fields[x];
     F:=Query.Fields[x];
     AddFieldToUpdateWherePart(sql_where,Query.UpdateMode,F);
     AddFieldToUpdateWherePart(sql_where,Query.UpdateMode,F);
     if (pfInUpdate in F.ProviderFlags) and (not F.ReadOnly) then
     if (pfInUpdate in F.ProviderFlags) and (not F.ReadOnly) then
       sql_set := sql_set +FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] +'=:"' + F.FieldName + '",';
       sql_set := sql_set +FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] +'=:"' + F.FieldName + '",';
+    if ReturningClause and (pfRefreshOnUpdate in F.ProviderFlags) then
+      returning_fields :=returning_fields+FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
     end;
     end;
   if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
   if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
   setlength(sql_set,length(sql_set)-1);
   setlength(sql_set,length(sql_set)-1);
   if length(sql_where) = 0 then DatabaseErrorFmt(sNoWhereFields,['update'],self);
   if length(sql_where) = 0 then DatabaseErrorFmt(sNoWhereFields,['update'],self);
   result := 'update ' + Query.FTableName + ' set ' + sql_set + ' where ' + sql_where;
   result := 'update ' + Query.FTableName + ' set ' + sql_set + ' where ' + sql_where;
+  if ReturningClause then
+    begin
+    ReturningClause:=length(returning_fields) <> 0 ;
+    if ReturningClause then
+      begin
+      setlength(returning_fields,length(returning_fields)-1);
+      result:=Result+' returning '+returning_fields;
+      end;
+    end;
 end;
 end;
 
 
 
 
@@ -1737,24 +1767,27 @@ end;
 procedure TSQLConnection.ApplyRecUpdate(Query: TCustomSQLQuery; UpdateKind: TUpdateKind);
 procedure TSQLConnection.ApplyRecUpdate(Query: TCustomSQLQuery; UpdateKind: TUpdateKind);
 
 
 var
 var
-  qry : TCustomSQLStatement;
+  qry : TCustomSQLQuery;
   s   : string;
   s   : string;
   x   : integer;
   x   : integer;
   Fld : TField;
   Fld : TField;
   P : TParam;
   P : TParam;
-  B : Boolean;
+  B,ReturningClause : Boolean;
 
 
 begin
 begin
+  qry:=Nil;
+  ReturningClause:=(sqSupportReturning in Connoptions) and not (sqoPreferRefresh in Query.Options);
   case UpdateKind of
   case UpdateKind of
     ukInsert : begin
     ukInsert : begin
                s := trim(Query.FInsertSQL.Text);
                s := trim(Query.FInsertSQL.Text);
-               if s = '' then s := ConstructInsertSQL(Query);
+               if s = '' then
+                 s := ConstructInsertSQL(Query,ReturningClause);
                qry := InitialiseUpdateStatement(Query,Query.FInsertQry);
                qry := InitialiseUpdateStatement(Query,Query.FInsertQry);
                end;
                end;
     ukModify : begin
     ukModify : begin
                s := trim(Query.FUpdateSQL.Text);
                s := trim(Query.FUpdateSQL.Text);
                if (s='') and (not assigned(Query.FUpdateQry) or (Query.UpdateMode<>upWhereKeyOnly)) then //first time or dynamic where part
                if (s='') and (not assigned(Query.FUpdateQry) or (Query.UpdateMode<>upWhereKeyOnly)) then //first time or dynamic where part
-                 s := ConstructUpdateSQL(Query);
+                 s := ConstructUpdateSQL(Query,ReturningClause);
                qry := InitialiseUpdateStatement(Query,Query.FUpdateQry);
                qry := InitialiseUpdateStatement(Query,Query.FUpdateQry);
                end;
                end;
     ukDelete : begin
     ukDelete : begin
@@ -1762,11 +1795,12 @@ begin
                if (s='') and (not assigned(Query.FDeleteQry) or (Query.UpdateMode<>upWhereKeyOnly)) then
                if (s='') and (not assigned(Query.FDeleteQry) or (Query.UpdateMode<>upWhereKeyOnly)) then
                  s := ConstructDeleteSQL(Query);
                  s := ConstructDeleteSQL(Query);
                qry := InitialiseUpdateStatement(Query,Query.FDeleteQry);
                qry := InitialiseUpdateStatement(Query,Query.FDeleteQry);
+               ReturningClause:=False;
                end;
                end;
   end;
   end;
   if (s<>'') and (qry.SQL.Text<>s) then
   if (s<>'') and (qry.SQL.Text<>s) then
     qry.SQL.Text:=s; //assign only when changed, to avoid UnPrepare/Prepare
     qry.SQL.Text:=s; //assign only when changed, to avoid UnPrepare/Prepare
-  assert(qry.sql.Text<>'');
+  Assert(qry.sql.Text<>'');
   for x:=0 to Qry.Params.Count-1 do
   for x:=0 to Qry.Params.Count-1 do
     begin
     begin
     P:=Qry.Params[x];
     P:=Qry.Params[x];
@@ -1777,9 +1811,18 @@ begin
     Fld:=Query.FieldByName(S);
     Fld:=Query.FieldByName(S);
     ApplyFieldUpdate(Query.Cursor,P as TSQLDBParam,Fld,B);
     ApplyFieldUpdate(Query.Cursor,P as TSQLDBParam,Fld,B);
     end;
     end;
-  Qry.Execute;
+  if ReturningClause then
+    Qry.Open
+  else
+    Qry.Execute;
   if (scoApplyUpdatesChecksRowsAffected in Options) and (Qry.RowsAffected<>1) then
   if (scoApplyUpdatesChecksRowsAffected in Options) and (Qry.RowsAffected<>1) then
+    begin
+    if ReturningClause then
+      Qry.Close;
     DatabaseErrorFmt(SErrFailedToUpdateRecord, [Qry.RowsAffected], Query);
     DatabaseErrorFmt(SErrFailedToUpdateRecord, [Qry.RowsAffected], Query);
+    end;
+  if ReturningClause then
+    Query.ApplyReturningResult(Qry,UpdateKind);
 end;
 end;
 
 
 function TSQLConnection.RefreshLastInsertID(Query: TCustomSQLQuery; Field: TField): Boolean;
 function TSQLConnection.RefreshLastInsertID(Query: TCustomSQLQuery; Field: TField): Boolean;
@@ -1857,6 +1900,21 @@ end;
 
 
 { TSQLTransaction }
 { TSQLTransaction }
 
 
+constructor TSQLTransaction.Create(AOwner : TComponent);
+begin
+  inherited Create(AOwner);
+  FParams := TStringList.Create;
+  Action := caRollBack;
+end;
+
+destructor TSQLTransaction.Destroy;
+begin
+  EndTransaction;
+  FreeAndNil(FTrans);
+  FreeAndNil(FParams);
+  inherited Destroy;
+end;
+
 procedure TSQLTransaction.EndTransaction;
 procedure TSQLTransaction.EndTransaction;
 
 
 begin
 begin
@@ -2001,40 +2059,21 @@ begin
     end;
     end;
 end;
 end;
 
 
-constructor TSQLTransaction.Create(AOwner : TComponent);
-begin
-  inherited Create(AOwner);
-  FParams := TStringList.Create;
-  Action := caRollBack;
-end;
-
-destructor TSQLTransaction.Destroy;
-begin
-  EndTransaction;
-  FreeAndNil(FTrans);
-  FreeAndNil(FParams);
-  inherited Destroy;
-end;
-
 Procedure TSQLTransaction.SetDatabase(Value: TDatabase);
 Procedure TSQLTransaction.SetDatabase(Value: TDatabase);
 
 
 begin
 begin
   If Value<>Database then
   If Value<>Database then
     begin
     begin
     if Assigned(Value) and not (Value is TSQLConnection) then
     if Assigned(Value) and not (Value is TSQLConnection) then
-      DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
+      DatabaseErrorFmt(SErrNotASQLConnection, [Value.Name], Self);
     CheckInactive;
     CheckInactive;
     if (stoUseImplicit in Options) and Assigned(Value) and Not (sqImplicitTransaction in TSQLConnection(Value).ConnOptions) then
     if (stoUseImplicit in Options) and Assigned(Value) and Not (sqImplicitTransaction in TSQLConnection(Value).ConnOptions) then
-           DatabaseErrorFmt(SErrNoImplicitTransaction,[Value.ClassName]);
+      DatabaseErrorFmt(SErrNoImplicitTransaction, [Value.ClassName]);
     If Assigned(Database) then
     If Assigned(Database) then
-      begin
-      with SQLConnection do
-        if Transaction = self then Transaction := nil;
-      end;
-    inherited SetDatabase(Value);
+      if SQLConnection.Transaction = Self then SQLConnection.Transaction := nil;
+    inherited;
     If Assigned(Database) and not (csLoading in ComponentState) then
     If Assigned(Database) and not (csLoading in ComponentState) then
-      If (SQLConnection.Transaction=Nil) then
-        SQLConnection.Transaction:=Self;
+      If SQLConnection.Transaction = Nil then SQLConnection.Transaction := Self;
     end;
     end;
 end;
 end;
 
 
@@ -2247,34 +2286,33 @@ begin
   CheckInactive;
   CheckInactive;
 end;
 end;
 
 
-procedure TCustomSQLQuery.SetTransaction(Value: TDBTransaction);
+procedure TCustomSQLQuery.SetDatabase(Value : TDatabase);
+
+var DB : TSQLConnection;
 
 
 begin
 begin
+  if Database = Value then Exit;
+  if Assigned(Value) and not (Value is TSQLConnection) then
+    DatabaseErrorFmt(SErrNotASQLConnection, [Value.Name], Self);
   UnPrepare;
   UnPrepare;
-  inherited;
+  DB := TSQLConnection(Value);
   If Assigned(FStatement) then
   If Assigned(FStatement) then
-    FStatement.Transaction:=TSQLTransaction(Value);
-  If (Transaction<>Nil) and (Database=Nil) then
-    Database:=SQLTransaction.Database;
+    FStatement.Database := DB;
+  inherited;
+  if Assigned(DB) and Assigned(DB.Transaction) and (not Assigned(Transaction) or (Transaction.DataBase<>Database)) then
+    Transaction := DB.Transaction;
 end;
 end;
 
 
-procedure TCustomSQLQuery.SetDatabase(Value : TDatabase);
-
-var db : tsqlconnection;
+procedure TCustomSQLQuery.SetTransaction(Value: TDBTransaction);
 
 
 begin
 begin
-  if (Database <> Value) then
-    begin
-    if assigned(value) and not (Value is TSQLConnection) then
-      DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
-    UnPrepare;
-    db := TSQLConnection(Value);
-    If Assigned(FStatement) then
-      FStatement.Database:=DB;
-    inherited setdatabase(value);
-    if assigned(value) and (Transaction = nil) and (Assigned(db.Transaction)) then
-      transaction := Db.Transaction;
-    end;
+  if Transaction = Value then Exit;
+  UnPrepare;
+  inherited;
+  If Assigned(FStatement) then
+    FStatement.Transaction := TSQLTransaction(Value);
+  If Assigned(Transaction) and Assigned(Transaction.DataBase) and (Database<>Transaction.DataBase) then
+    Database := Transaction.Database;
 end;
 end;
 
 
 function TCustomSQLQuery.IsPrepared: Boolean;
 function TCustomSQLQuery.IsPrepared: Boolean;
@@ -2310,9 +2348,12 @@ function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean;
 Var
 Var
   PF : TProviderFlag;
   PF : TProviderFlag;
   I : Integer;
   I : Integer;
+  DoReturning : Boolean;
+
 begin
 begin
   Result:=(FRefreshSQL.Count<>0);
   Result:=(FRefreshSQL.Count<>0);
-  if Not Result then
+  DoReturning:=(sqSupportReturning in SQLConnection.ConnOptions) and not (sqoPreferRefresh in Options);
+  if Not (Result or DoReturning) then
     begin
     begin
     PF:=RefreshFlags[UpdateKind];
     PF:=RefreshFlags[UpdateKind];
     I:=0;
     I:=0;
@@ -2374,6 +2415,25 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TCustomSQLQuery.ApplyReturningResult(Q: TCustomSQLQuery; UpdateKind : TUpdateKind);
+
+Var
+  S : TDataSetState;
+  refreshFlag  : TProviderFlag;
+  F : TField;
+
+begin
+  RefreshFlag:=RefreshFlags[UpdateKind];
+  S:=SetTempState(dsRefreshFields);
+  try
+    For F in Fields do
+      if RefreshFlag in F.ProviderFlags then
+        F.Assign(Q.FieldByName(F.FieldName));
+  finally
+    RestoreState(S);
+  end;
+end;
+
 procedure TCustomSQLQuery.ApplyFilter;
 procedure TCustomSQLQuery.ApplyFilter;
 
 
 begin
 begin
@@ -2626,7 +2686,7 @@ end;
 
 
 procedure TCustomSQLQuery.InternalRefresh;
 procedure TCustomSQLQuery.InternalRefresh;
 begin
 begin
-  if (sqoCancelUpdatesOnRefresh in Options) then
+  if (ChangeCount>0) and (sqoCancelUpdatesOnRefresh in Options) then
     CancelUpdates;
     CancelUpdates;
   inherited InternalRefresh;
   inherited InternalRefresh;
 end;
 end;

+ 2 - 3
packages/fcl-db/tests/sdfdstoolsunit.pas

@@ -71,8 +71,6 @@ begin
         // work properly)
         // work properly)
         Post;
         Post;
         end;
         end;
-      if state = dsinsert then
-        Post;
       Close;
       Close;
       Free;
       Free;
       end;
       end;
@@ -86,9 +84,9 @@ begin
   with TSdfDataSet.Create(nil) do
   with TSdfDataSet.Create(nil) do
     begin
     begin
     FileName := dbname+PathDelim+'fpdev_field.dat';
     FileName := dbname+PathDelim+'fpdev_field.dat';
-      DeleteFile(FileName);
     // Make sure the directory exists so we can write
     // Make sure the directory exists so we can write
     ForceDirectories(dbname);
     ForceDirectories(dbname);
+    DeleteFile(FileName);
     FileMustExist:=False;
     FileMustExist:=False;
     
     
     SetFieldDatasetSchema(Schema);
     SetFieldDatasetSchema(Schema);
@@ -102,6 +100,7 @@ begin
       Post;
       Post;
       end;
       end;
     Close;
     Close;
+    Free;
     end;
     end;
 end;
 end;
 
 

+ 149 - 145
packages/fcl-db/tests/tcsdfdata.pp

@@ -6,7 +6,7 @@ unit tcsdfdata;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, Fpcunit, Testutils, Testregistry, testdecorator,
+  Classes, SysUtils, Fpcunit, TestRegistry,
   dateutils,sdfdata,ToolsUnit;
   dateutils,sdfdata,ToolsUnit;
 
 
 type
 type
@@ -15,7 +15,7 @@ type
 
 
   Ttestsdfspecific = class(Ttestcase)
   Ttestsdfspecific = class(Ttestcase)
   private
   private
-    procedure TestEmptyFieldContents;
+    function TestFileName(const FileName: string=''): string;
   protected
   protected
     TestDataset: TSDFDataset;
     TestDataset: TSDFDataset;
     procedure Setup; override;
     procedure Setup; override;
@@ -33,25 +33,39 @@ type
     procedure TestInputOurFormat;
     procedure TestInputOurFormat;
     }
     }
     procedure TestDelimitedTextOutput;
     procedure TestDelimitedTextOutput;
-    procedure TestEmptyHeader;
-    Procedure TestEmptyHeader2;
-    Procedure TestEmptyHeaderStripTrailingDelimiters;
+    procedure TestEmptyFieldHeader;
+    Procedure TestEmptyFieldNoHeader;
+    procedure TestEmptyFieldContents;
+    Procedure TestEmptyFieldHeaderStripTrailingDelimiters;
     Procedure TestStripTrailingDelimiters;
     Procedure TestStripTrailingDelimiters;
   end;
   end;
 
 
 implementation
 implementation
 
 
-procedure Ttestsdfspecific.TestEmptyFileHeader;
-// An empty file should return 0 records even if it has a header
+function Ttestsdfspecific.TestFileName(const FileName: string): string;
 const
 const
-  InputFilename='empty.csv';
+  DefaultTestFileName = 'test.csv';
 begin
 begin
-  TestDataSet.Close;
+  if FileName = '' then
+    Result := DefaultTestFileName
+  else
+    Result := FileName;
+
+  if dbname <> '' then
+    begin
+    ForceDirectories(dbname);
+    Result := IncludeTrailingPathDelimiter(dbname) + Result;
+    end;
 
 
-  if FileExists(InputFilename) then DeleteFile(InputFilename);
-  TestDataset.FileMustExist:=false;
-  TestDataset.FirstLineAsSchema := True;  
-  TestDataset.FileName:=InputFilename;
+  if FileExists(Result) then DeleteFile(Result);
+end;
+
+procedure Ttestsdfspecific.TestEmptyFileHeader;
+// An empty file should return 0 records even if it has a header
+begin
+  // with Schema, with Header line
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.FileName := TestFileName('empty.csv');
   TestDataset.Open;
   TestDataset.Open;
 
 
   TestDataset.Last;
   TestDataset.Last;
@@ -62,15 +76,10 @@ end;
 
 
 procedure Ttestsdfspecific.TestEmptyFileNoHeader;
 procedure Ttestsdfspecific.TestEmptyFileNoHeader;
 // An empty file should return 0 records even if it has a header
 // An empty file should return 0 records even if it has a header
-const
-  InputFilename='empty.csv';
 begin
 begin
-  TestDataSet.Close;
-
-  if FileExists(InputFilename) then DeleteFile(InputFilename);
-  TestDataset.FileMustExist:=false;
-  TestDataset.FirstLineAsSchema := false;  
-  TestDataset.FileName:=InputFilename;
+  // with Schema, without Header line
+  TestDataset.FirstLineAsSchema := False;
+  TestDataset.FileName := TestFileName('empty.csv');
   TestDataset.Open;
   TestDataset.Open;
 
 
   TestDataset.Last;
   TestDataset.Last;
@@ -81,73 +90,71 @@ end;
 
 
 procedure Ttestsdfspecific.TestSingleLineHeader;
 procedure Ttestsdfspecific.TestSingleLineHeader;
 // A file with a single data line and header should return 1 records
 // A file with a single data line and header should return 1 records
-const
-  InputFilename='singleh.csv';
 var
 var
   FileStrings: TStringList;
   FileStrings: TStringList;
 begin
 begin
-  TestDataSet.Close;
+  // with Schema, with Header line, which differs from Schema
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.FileName := TestFileName('singleh.csv');
 
 
-  if FileExists(InputFilename) then DeleteFile(InputFilename);
   FileStrings:=TStringList.Create;
   FileStrings:=TStringList.Create;
   try
   try
-    FileStrings.Add('ID,NAME,BIRTHDAY');
-    FileStrings.Add('1,SimpleName,31-12-1976');
-    FileStrings.SaveToFile(InputFileName);
+    FileStrings.Add('ID,NAME,BIRTHDAY,GENDER'); // 4 fields override 3 fields in Schema
+    FileStrings.Add('1,SimpleName,31-12-1976,M');
+    FileStrings.SaveToFile(TestDataset.FileName);
   finally
   finally
     FileStrings.Free;
     FileStrings.Free;
   end;
   end;
 
 
-  TestDataset.FileMustExist:=false;
-  TestDataset.FirstLineAsSchema := true;
-  TestDataset.FileName:=InputFilename;
   TestDataset.Open;
   TestDataset.Open;
+  AssertEquals('FieldDefs.Count', 4, TestDataset.FieldDefs.Count);
+  AssertEquals('1', TestDataset.Fields[0].AsString); // just after Open
 
 
   TestDataset.Last;
   TestDataset.Last;
   TestDataset.First;
   TestDataset.First;
-  AssertEquals('Number of records in test dataset', 1, TestDataset.RecordCount);
+  AssertEquals('RecNo', 1, TestDataset.RecNo);
+  AssertEquals('RecordCount', 1, TestDataset.RecordCount);
   TestDataset.Close;
   TestDataset.Close;
+  AssertEquals('RecordCount after Close', 0, TestDataset.RecordCount);
 end;
 end;
 
 
 procedure Ttestsdfspecific.TestSingleLineNoHeader;
 procedure Ttestsdfspecific.TestSingleLineNoHeader;
 // A file with a single data line, no header should return 1 records
 // A file with a single data line, no header should return 1 records
-const
-  InputFilename='single.csv';
 var
 var
   FileStrings: TStringList;
   FileStrings: TStringList;
 begin
 begin
-  TestDataSet.Close;
+  // with Schema, without Header line
+  TestDataset.FirstLineAsSchema := False;
+  TestDataset.FileName := TestFileName('singleh.csv');
 
 
-  if FileExists(InputFilename) then DeleteFile(InputFilename);
   FileStrings:=TStringList.Create;
   FileStrings:=TStringList.Create;
   try
   try
     FileStrings.Add('1,SimpleName,31-12-1976');
     FileStrings.Add('1,SimpleName,31-12-1976');
-    FileStrings.SaveToFile(InputFileName);
+    FileStrings.SaveToFile(TestDataset.FileName);
   finally
   finally
     FileStrings.Free;
     FileStrings.Free;
   end;
   end;
 
 
-  TestDataset.FileMustExist:=false;
-  TestDataset.FirstLineAsSchema := false;
-  TestDataset.FileName:=InputFilename;
   TestDataset.Open;
   TestDataset.Open;
+  AssertEquals('FieldDefs.Count', 3, TestDataset.FieldDefs.Count);
+  AssertEquals('1', TestDataset.Fields[0].AsString);
 
 
   TestDataset.Last;
   TestDataset.Last;
   TestDataset.First;
   TestDataset.First;
-  AssertEquals('Number of records in test dataset', 1, TestDataset.RecordCount);
+  AssertEquals('RecNo', 1, TestDataset.RecNo);
+  AssertEquals('RecordCount', 1, TestDataset.RecordCount);
   TestDataset.Close;
   TestDataset.Close;
+  AssertEquals('RecordCount after Close', 0, TestDataset.RecordCount);
 end;
 end;
 
 
 procedure Ttestsdfspecific.TestOutput;
 procedure Ttestsdfspecific.TestOutput;
 // Basic assignment test: assign some difficult data to records and
 // Basic assignment test: assign some difficult data to records and
-// see if the recordcount is correct.
-const
-  OutputFilename='output.csv';
+// see if the RecordCount is correct.
+var
+  i: integer;
 begin
 begin
-  TestDataSet.Close;
-
-  if FileExists(OutputFilename) then DeleteFile(OutputFileName);
-  TestDataset.FileName:=OutputFileName;
+  // with Schema, with Header line
+  TestDataset.FileName := TestFileName('output.csv');
   TestDataset.Open;
   TestDataset.Open;
   // Fill test data
   // Fill test data
   TestDataset.Append;
   TestDataset.Append;
@@ -165,25 +172,35 @@ begin
   TestDataset.Post;
   TestDataset.Post;
 
 
   TestDataset.Append;
   TestDataset.Append;
-  TestDataset.FieldByName('ID').AsInteger := 3;
+  TestDataset.FieldByName('ID').AsInteger := 4;
   //Data with delimiter and quote (to test 19376)
   //Data with delimiter and quote (to test 19376)
   TestDataset.FieldByName('NAME').AsString := 'Delimiter,"and";quote';
   TestDataset.FieldByName('NAME').AsString := 'Delimiter,"and";quote';
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.Post;
   TestDataset.Post;
 
 
-
-  TestDataset.Append;
-  TestDataset.FieldByName('ID').AsInteger := 4;
+  TestDataset.Insert;
+  TestDataset.FieldByName('ID').AsInteger := 3;
   // Regular data
   // Regular data
   TestDataset.FieldByName('NAME').AsString := 'Just a long line of text without anything special';
   TestDataset.FieldByName('NAME').AsString := 'Just a long line of text without anything special';
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.FieldByName('BIRTHDAY').AsDateTime := ScanDateTime('yyyymmdd', '19761231', 1);
   TestDataset.Post;
   TestDataset.Post;
 
 
-  TestDataset.Last;
+  // test sequential order of records
   TestDataset.First;
   TestDataset.First;
-  // This fails - seems it sees the header as a record, too?
-  AssertEquals('Number of records in test dataset', 4, TestDataset.RecordCount);
+  for i:=1 to 4 do begin
+    AssertEquals('RecNo', i, TestDataset.RecNo);
+    AssertEquals(i, TestDataset.FieldByName('ID').AsInteger);
+    TestDataset.Next;
+  end;
+  // set/test RecNo
+  for i:=1 to 4 do begin
+    TestDataset.RecNo := i;
+    AssertEquals('RecNo', i, TestDataset.RecNo);
+    AssertEquals(i, TestDataset.FieldByName('ID').AsInteger);
+  end;
+  AssertEquals('RecordCount', 4, TestDataset.RecordCount);
   TestDataset.Close;
   TestDataset.Close;
+  AssertEquals('RecordCount after Close', 0, TestDataset.RecordCount);
 end;
 end;
 
 
 {
 {
@@ -258,7 +275,6 @@ procedure Ttestsdfspecific.TestDelimitedTextOutput;
 // Mainly check if writing & reading quotes works.
 // Mainly check if writing & reading quotes works.
 // to do: more fully test RFC4180
 // to do: more fully test RFC4180
 const
 const
-  OutputFileName='delim.csv';
   Value1='Delimiter,"and";quote';
   Value1='Delimiter,"and";quote';
   Value2='J"T"';
   Value2='J"T"';
   Value3='Just a long line';
   Value3='Just a long line';
@@ -268,21 +284,19 @@ const
   Value7='Some "random" quotes';
   Value7='Some "random" quotes';
 Var
 Var
   F : Text;
   F : Text;
-  FileStrings: TStringList;
-  OneRecord: TStringList;
 begin
 begin
+  // with Schema, with Header line
   TestDataset.Close;
   TestDataset.Close;
-  TestDataset.AllowMultiLine:=true;
-  TestDataset.FirstLineAsSchema:=true;
-  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  Assign(F,OutputFileName);
+  TestDataset.AllowMultiLine := True;
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.FileName := TestFileName('delim.csv');
+  Assign(F, TestDataset.FileName);
   Rewrite(F);
   Rewrite(F);
   Writeln(F,'Field1,Field2,Field3,Field4,Field5,Field6,Field7');
   Writeln(F,'Field1,Field2,Field3,Field4,Field5,Field6,Field7');
   Writeln(F,'"Delimiter,""and"";quote","J""T""",Just a long line,"Just a quoted long line","multi');
   Writeln(F,'"Delimiter,""and"";quote","J""T""",Just a long line,"Just a quoted long line","multi');
   Writeln(F,'line","Delimiter,and;done","Some ""random"" quotes"');
   Writeln(F,'line","Delimiter,and;done","Some ""random"" quotes"');
   Close(F);
   Close(F);
   // Load our dataset
   // Load our dataset
-  TestDataset.FileName:=OutputFileName;
   TestDataset.Open;
   TestDataset.Open;
 //  AssertEquals('Field count',7,TEstDataset.Fielddefs.Count);
 //  AssertEquals('Field count',7,TEstDataset.Fielddefs.Count);
 //  AssertEquals('Record count',1,TEstDataset.RecordCount);
 //  AssertEquals('Record count',1,TEstDataset.RecordCount);
@@ -296,90 +310,104 @@ begin
   AssertEquals('Field7',Value7, TestDataSet.Fields[6].AsString);
   AssertEquals('Field7',Value7, TestDataSet.Fields[6].AsString);
 end;
 end;
 
 
-procedure Ttestsdfspecific.TestEmptyHeader;
+procedure Ttestsdfspecific.TestEmptyFieldContents;
+Var
+  F : Text;
+begin
+  // with empty Field name in Header line
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName := TestFileName();
+
+  Assign(F, TestDataset.FileName);
+  Rewrite(F);
+  Writeln(F,'1;2;3;;5');
+  Writeln(F,'11;12;13;;15');
+  Close(F);
 
 
-const
-  OutputFileName='delim.csv';
+  TestDataset.Open;
+  AssertEquals('FieldDefs.Count',5,TestDataset.FieldDefs.Count);
+  AssertEquals('RecordCount',1,TestDataset.RecordCount);
+end;
 
 
+procedure Ttestsdfspecific.TestEmptyFieldHeader;
 Var
 Var
   F : Text;
   F : Text;
 begin
 begin
-  TestDataset.Close;
-  TestDataset.AllowMultiLine:=False;
-  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  Assign(F,OutputFileName);
+  // with empty Field name in Header line
+  TestDataset.Delimiter := ';';
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.FileName := TestFileName();
+
+  Assign(F, TestDataset.FileName);
   Rewrite(F);
   Rewrite(F);
   Writeln(F,'1;2;3;;5');
   Writeln(F,'1;2;3;;5');
   Close(F);
   Close(F);
-  TestDataset.FirstLineAsSchema:=True;
-  TestDataset.Delimiter := ';';
-  TestDataset.FileName:=OutputFileName;
+
   TestDataset.Open;
   TestDataset.Open;
-  AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
+  AssertEquals('FieldDefs.Count',5,TestDataset.FieldDefs.Count);
+  AssertEquals('RecordCount', 0, TestDataset.RecordCount);
 end;
 end;
 
 
-procedure Ttestsdfspecific.TestEmptyHeader2;
-
-const
-  OutputFileName='delim.csv';
+procedure Ttestsdfspecific.TestEmptyFieldNoHeader;
 
 
 Var
 Var
   F : Text;
   F : Text;
   S : String;
   S : String;
 
 
 begin
 begin
-  TestDataset.Close;
-  TestDataset.AllowMultiLine:=False;
-  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  Assign(F,OutputFileName);
+  // without Schema, without Header line
+  TestDataset.Schema.Clear;
+  TestDataset.FirstLineAsSchema := False;
+  TestDataset.Delimiter := ';';
+  TestDataset.FileName := TestFileName();
+
+  Assign(F, TestDataset.FileName);
   Rewrite(F);
   Rewrite(F);
   Writeln(F,'value1;value2;;;');
   Writeln(F,'value1;value2;;;');
   Close(F);
   Close(F);
-  TestDataset.FirstLineAsSchema:=False;
-  TestDataset.Delimiter := ';';
-  TestDataset.FileName:=OutputFileName;
-  TestDataset.Schema.Clear;
+
   TestDataset.Open;
   TestDataset.Open;
-  AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
+  AssertEquals('FieldDefs.Count',5,TestDataset.FieldDefs.Count);
+  AssertEquals('RecordCount', 1, TestDataset.RecordCount);
   TestDataset.Edit;
   TestDataset.Edit;
   TestDataset.Fields[0].AsString:='Value1';
   TestDataset.Fields[0].AsString:='Value1';
   TestDataset.Post;
   TestDataset.Post;
   TestDataset.Close;
   TestDataset.Close;
-  Assign(F,OutputFileName);
+
+  Assign(F, TestDataset.FileName);
   Reset(F);
   Reset(F);
   ReadLn(F,S);
   ReadLn(F,S);
   Close(F);
   Close(F);
   AssertEquals('No data lost','Value1;value2;;;',S);
   AssertEquals('No data lost','Value1;value2;;;',S);
 end;
 end;
 
 
-procedure Ttestsdfspecific.TestEmptyHeaderStripTrailingDelimiters;
-const
-  OutputFileName='delim.csv';
-
+procedure Ttestsdfspecific.TestEmptyFieldHeaderStripTrailingDelimiters;
 Var
 Var
   F : Text;
   F : Text;
   S : String;
   S : String;
 
 
 begin
 begin
-  TestDataset.Close;
-  TestDataset.AllowMultiLine:=False;
-  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  Assign(F,OutputFileName);
+  // without Schema, without Header line
+  TestDataset.Schema.Clear;
+  TestDataset.FirstLineAsSchema := False;
+  TestDataset.Delimiter := ';';
+  TestDataset.StripTrailingDelimiters := True;
+  TestDataset.FileName := TestFileName();
+
+  Assign(F, TestDataset.FileName);
   Rewrite(F);
   Rewrite(F);
   Writeln(F,'value1;value2;;;');
   Writeln(F,'value1;value2;;;');
   Close(F);
   Close(F);
-  TestDataset.StripTrailingDelimiters:=True;
-  TestDataset.FirstLineAsSchema:=False;
-  TestDataset.Delimiter := ';';
-  TestDataset.FileName:=OutputFileName;
-  TestDataset.Schema.Clear;
+
   TestDataset.Open;
   TestDataset.Open;
-  AssertEquals('Correct field count',2,TestDataset.FieldDefs.Count);
+  AssertEquals('FieldDefs.Count',2,TestDataset.FieldDefs.Count);
   TestDataset.Edit;
   TestDataset.Edit;
   TestDataset.Fields[0].AsString:='Value1';
   TestDataset.Fields[0].AsString:='Value1';
   TestDataset.Post;
   TestDataset.Post;
   TestDataset.Close;
   TestDataset.Close;
-  Assign(F,OutputFileName);
+
+  Assign(F, TestDataset.FileName);
   Reset(F);
   Reset(F);
   ReadLn(F,S);
   ReadLn(F,S);
   Close(F);
   Close(F);
@@ -387,63 +415,38 @@ begin
 end;
 end;
 
 
 procedure Ttestsdfspecific.TestStripTrailingDelimiters;
 procedure Ttestsdfspecific.TestStripTrailingDelimiters;
-const
-  OutputFileName='delim.csv';
-
 Var
 Var
   F : Text;
   F : Text;
-  S,S2 : String;
+  S1,S2 : String;
 
 
 begin
 begin
-  TestDataset.Close;
-  TestDataset.AllowMultiLine:=False;
-  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  Assign(F,OutputFileName);
+  // without Schema, with Header line
+  TestDataset.Schema.Clear;
+  TestDataset.FirstLineAsSchema := True;
+  TestDataset.Delimiter := ';';
+  TestDataset.StripTrailingDelimiters := True;
+  TestDataset.FileName := TestFileName();;
+
+  Assign(F, TestDataset.FileName);
   Rewrite(F);
   Rewrite(F);
   Writeln(F,'value1;value2;;;');
   Writeln(F,'value1;value2;;;');
   Writeln(F,'value1;value2;;;');
   Writeln(F,'value1;value2;;;');
   Close(F);
   Close(F);
-  TestDataset.StripTrailingDelimiters:=True;
-  TestDataset.FirstLineAsSchema:=False;
-  TestDataset.Delimiter := ';';
-  TestDataset.FileName:=OutputFileName;
-  TestDataset.Schema.Clear;
+
   TestDataset.Open;
   TestDataset.Open;
-  AssertEquals('Correct field count',2,TestDataset.FieldDefs.Count);
+  AssertEquals('FieldDefs.Count',2,TestDataset.FieldDefs.Count);
   TestDataset.Edit;
   TestDataset.Edit;
   TestDataset.Fields[0].AsString:='Value1';
   TestDataset.Fields[0].AsString:='Value1';
   TestDataset.Post;
   TestDataset.Post;
   TestDataset.Close;
   TestDataset.Close;
-  Assign(F,OutputFileName);
+
+  Assign(F, TestDataset.FileName);
   Reset(F);
   Reset(F);
-  ReadLn(F,S);
+  ReadLn(F,S1);
   ReadLn(F,S2);
   ReadLn(F,S2);
   Close(F);
   Close(F);
-  AssertEquals('Headers lost','Value1;value2',S);
-  AssertEquals('Data lost','Value1;value2',S);
-end;
-
-procedure Ttestsdfspecific.TestEmptyFieldContents;
-
-const
-  OutputFileName='delim.csv';
-
-Var
-  F : Text;
-begin
-  TestDataset.Close;
-  TestDataset.AllowMultiLine:=False;
-  if FileExists(OutputFileName) then DeleteFile(OutputFileName);
-  Assign(F,OutputFileName);
-  Rewrite(F);
-  Writeln(F,'1;2;3;;5');
-  Writeln(F,'11;12;13;;15');
-  Close(F);
-  TestDataset.FirstLineAsSchema:=True;
-  TestDataset.Delimiter := ';';
-  TestDataset.FileName:=OutputFileName;
-  TestDataset.Open;
-  AssertEquals('Correct field count',5,TestDataset.FieldDefs.Count);
+  AssertEquals('Headers lost','value1;value2;;;',S1); // should striping affect also header line ?
+  AssertEquals('Data lost','Value1;value2',S2);
 end;
 end;
 
 
 
 
@@ -452,8 +455,9 @@ procedure Ttestsdfspecific.Setup;
 begin
 begin
   TestDataset := TSDFDataset.Create(nil);
   TestDataset := TSDFDataset.Create(nil);
   TestDataset.Delimiter := ',';
   TestDataset.Delimiter := ',';
-  TestDataset.FileMustExist:=false;
+  TestDataset.FileMustExist := False;
   TestDataset.FirstLineAsSchema := True;
   TestDataset.FirstLineAsSchema := True;
+  TestDataset.AllowMultiLine := False;
   TestDataset.Schema.Add('ID');
   TestDataset.Schema.Add('ID');
   TestDataset.Schema.Add('NAME');
   TestDataset.Schema.Add('NAME');
   TestDataset.Schema.Add('BIRTHDAY');
   TestDataset.Schema.Add('BIRTHDAY');

+ 42 - 30
packages/fcl-db/tests/testdbbasics.pas

@@ -199,7 +199,7 @@ type THackDataLink=class(TDataLink);
 
 
 procedure TTestCursorDBBasics.TestAppendOnEmptyDataset;
 procedure TTestCursorDBBasics.TestAppendOnEmptyDataset;
 begin
 begin
-  with DBConnector.GetNDataset(0) do
+  with DBConnector.GetNDataset(True,0) do
     begin
     begin
     open;
     open;
     CheckTrue(CanModify);
     CheckTrue(CanModify);
@@ -217,7 +217,7 @@ end;
 
 
 procedure TTestCursorDBBasics.TestInsertOnEmptyDataset;
 procedure TTestCursorDBBasics.TestInsertOnEmptyDataset;
 begin
 begin
-  with DBConnector.GetNDataset(0) do
+  with DBConnector.GetNDataset(True,0) do
     begin
     begin
     open;
     open;
     CheckTrue(CanModify);
     CheckTrue(CanModify);
@@ -520,42 +520,54 @@ begin
 
 
     Open;
     Open;
 
 
-    CheckEquals(0,RecordCount);
-    CheckEquals(0,RecNo);
+    CheckEquals(0,RecordCount,'1. record count after open');
+    CheckEquals(0,RecNo,'1. recno after open');
+    CheckEquals(True,EOF and BOF, '1. Empty');
 
 
     first;
     first;
-    CheckEquals(0,RecordCount);
-    CheckEquals(0,RecNo);
+    CheckEquals(0,RecordCount,'2. recordcount after first (empty)');
+    CheckEquals(0,RecNo,'2. recno after first (empty)');
+    CheckEquals(True,EOF and BOF, '1. Empty');
 
 
     last;
     last;
-    CheckEquals(0,RecordCount);
-    CheckEquals(0,RecNo);
+    CheckEquals(0,RecordCount,'3. recordcount after last (empty)');
+    CheckEquals(0,RecNo,'3. recordcount after last (empty)');
+    CheckEquals(True,EOF and BOF, '3. Empty');
 
 
     append;
     append;
-    CheckEquals(0,RecNo);
-    CheckEquals(0,RecordCount);
+    CheckEquals(0,RecNo,'4. recno after append (empty)');
+    CheckEquals(0,RecordCount,'4. recordcount after append (empty)');
+    CheckEquals(False, EOF and BOF, '4. Empty');
 
 
     first;
     first;
-    CheckEquals(0,RecNo);
-    CheckEquals(0,RecordCount);
+    CheckEquals(0,RecNo,'5. recno after first append (empty,append )');
+    CheckEquals(0,RecordCount,'5. recordcount after first (empty, append)');
+    CheckEquals(True,EOF and BOF, '5. Empty');
 
 
     append;
     append;
     FieldByName('id').AsInteger := 1;
     FieldByName('id').AsInteger := 1;
-    CheckEquals(0,RecNo);
-    CheckEquals(0,RecordCount);
+    CheckEquals(0,RecNo,'6. recno after second append (empty,append)');
+    CheckEquals(0,RecordCount,'6. recordcount after second append (empty,append)');
+    CheckEquals(False ,EOF and BOF, '6. Empty');
 
 
     first;
     first;
-    CheckEquals(1,RecNo);
-    CheckEquals(1,RecordCount);
+    CheckEquals(1,RecNo,'7. recno after second append, first (1,append)');
+    CheckEquals(1,RecordCount,'7. recordcount after second append,first (1,append)');
+    CheckEquals(False ,EOF and BOF, '7. Empty');
 
 
     last;
     last;
-    CheckEquals(1,RecNo);
-    CheckEquals(1,RecordCount);
+    CheckEquals(1,RecNo,'8. recno after second append, last (1,append)');
+    CheckEquals(1,RecordCount,'8. recordcount after second append, last (1,append)');
 
 
     append;
     append;
-    FieldByName('id').AsInteger := 1;
-    CheckEquals(0,RecNo,'RecNo after 3rd Append');
-    CheckEquals(1,RecordCount);
+    FieldByName('id').AsInteger := 2;
+    CheckEquals(0,RecNo,'9. RecNo after 3rd Append');
+    CheckEquals(1,RecordCount,'9. Recordcount after 3rd Append');
+    post;
+
+    edit;
+    CheckEquals(2,RecNo,'RecNo after Edit');
+    CheckEquals(2,RecordCount);
 
 
     Close;
     Close;
 
 
@@ -673,9 +685,9 @@ end;
 procedure TTestDBBasics.TestDetectionNonMatchingDataset;
 procedure TTestDBBasics.TestDetectionNonMatchingDataset;
 var
 var
   F: TField;
   F: TField;
-  ds: tdataset;
+  ds: TDataSet;
 begin
 begin
-  // TDataset.Bindfields should detect problems when the underlying data does
+  // TDataset.BindFields should detect problems when the underlying data does
   // not reflect the fields of the dataset. This test is to check if this is
   // not reflect the fields of the dataset. This test is to check if this is
   // really done.
   // really done.
   ds := DBConnector.GetNDataset(true,6);
   ds := DBConnector.GetNDataset(true,6);
@@ -703,7 +715,7 @@ begin
     InsertRecord([152,'TestInsRec']);
     InsertRecord([152,'TestInsRec']);
     CheckEquals(152,fields[0].AsInteger);
     CheckEquals(152,fields[0].AsInteger);
     CheckEquals('TestInsRec',fields[1].AsString);
     CheckEquals('TestInsRec',fields[1].AsString);
-    CheckTrue(state=dsBrowse);
+    CheckTrue(State=dsBrowse);
 
 
     // AppendRecord should append a record, further the same as InsertRecord
     // AppendRecord should append a record, further the same as InsertRecord
     AppendRecord([151,'TestInsRec']);
     AppendRecord([151,'TestInsRec']);
@@ -756,12 +768,12 @@ begin
     CheckEquals(1,FieldByName('id').AsInteger);
     CheckEquals(1,FieldByName('id').AsInteger);
 
 
     next;
     next;
-    delete;
+    delete;           // id=2
 
 
     GotoBookmark(BM2);
     GotoBookmark(BM2);
     CheckEquals(3,FieldByName('id').AsInteger,'After #2 deleted');
     CheckEquals(3,FieldByName('id').AsInteger,'After #2 deleted');
     
     
-    delete;delete;
+    delete;delete;    // id=3,4
 
 
     GotoBookmark(BM3);
     GotoBookmark(BM3);
     CheckEquals(6,FieldByName('id').AsInteger);
     CheckEquals(6,FieldByName('id').AsInteger);
@@ -2786,7 +2798,7 @@ procedure TTestDBBasics.TestCalculatedField;
 var ds   : TDataset;
 var ds   : TDataset;
     AFld1, AFld2, AFld3 : Tfield;
     AFld1, AFld2, AFld3 : Tfield;
 begin
 begin
-  ds := DBConnector.GetNDataset(5);
+  ds := DBConnector.GetNDataset(True,5);
   with ds do
   with ds do
     begin
     begin
     AFld1 := TIntegerField.Create(ds);
     AFld1 := TIntegerField.Create(ds);
@@ -2805,10 +2817,10 @@ begin
     CheckEquals(3,FieldCount);
     CheckEquals(3,FieldCount);
     ds.OnCalcFields := TestcalculatedField_OnCalcfields;
     ds.OnCalcFields := TestcalculatedField_OnCalcfields;
     open;
     open;
-    CheckEquals(1,FieldByName('ID').asinteger);
-    CheckEquals(5,FieldByName('CALCFLD').asinteger);
+    CheckEquals(1, FieldByName('ID').AsInteger);
+    CheckEquals(5, FieldByName('CALCFLD').AsInteger);
     next;
     next;
-    CheckEquals(70000,FieldByName('CALCFLD').asinteger);
+    CheckEquals(70000,FieldByName('CALCFLD').AsInteger);
     next;
     next;
     CheckTrue(FieldByName('CALCFLD').IsNull, '#3 Null');
     CheckTrue(FieldByName('CALCFLD').IsNull, '#3 Null');
     next;
     next;

+ 71 - 1
packages/fcl-db/tests/testsqldb.pas

@@ -54,6 +54,8 @@ type
     Procedure TestRefreshSQLNoRecords;
     Procedure TestRefreshSQLNoRecords;
     Procedure TestFetchAutoInc;
     Procedure TestFetchAutoInc;
     procedure TestSequence;
     procedure TestSequence;
+    procedure TestReturningInsert;
+    procedure TestReturningUpdate;
   end;
   end;
 
 
   { TTestTSQLConnection }
   { TTestTSQLConnection }
@@ -198,7 +200,7 @@ begin
 
 
     Q := SQLDBConnector.Query;
     Q := SQLDBConnector.Query;
     Q.SQL.Text:='select * from FPDEV2';
     Q.SQL.Text:='select * from FPDEV2';
-    Q.Options:=[sqoKeepOpenOnCommit];
+    Q.Options:=[sqoKeepOpenOnCommit,sqoPreferRefresh];
     AssertEquals('PacketRecords forced to -1',-1,Q.PacketRecords);
     AssertEquals('PacketRecords forced to -1',-1,Q.PacketRecords);
     Q.Open;
     Q.Open;
     AssertEquals('Got all records',20,Q.RecordCount);
     AssertEquals('Got all records',20,Q.RecordCount);
@@ -402,6 +404,7 @@ begin
       Transaction.Commit;
       Transaction.Commit;
     end;
     end;
   Q:=SQLDBConnector.Query;
   Q:=SQLDBConnector.Query;
+  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
   Q.SQL.Text:='select * from FPDEV2';
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   Q.RefreshSQL.Text:='SELECT a,b FROM FPDEV2 WHERE (id=:id)';
   Q.RefreshSQL.Text:='SELECT a,b FROM FPDEV2 WHERE (id=:id)';
@@ -440,6 +443,7 @@ begin
   Q:=SQLDBConnector.Query;
   Q:=SQLDBConnector.Query;
   Q.SQL.Text:='select * from FPDEV2';
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
   Q.Open;
   Q.Open;
   With Q.FieldByName('id') do
   With Q.FieldByName('id') do
     ProviderFlags:=ProviderFlags+[pfInKey];
     ProviderFlags:=ProviderFlags+[pfInKey];
@@ -471,6 +475,7 @@ begin
   Q:=SQLDBConnector.Query;
   Q:=SQLDBConnector.Query;
   Q.SQL.Text:='select * from FPDEV2';
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
   Q.Open;
   Q.Open;
   With Q.FieldByName('id') do
   With Q.FieldByName('id') do
     ProviderFlags:=ProviderFlags+[pfInKey];
     ProviderFlags:=ProviderFlags+[pfInKey];
@@ -497,6 +502,7 @@ begin
   FMyQ:=SQLDBConnector.Query;
   FMyQ:=SQLDBConnector.Query;
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.Open;
   FMyQ.Open;
   With FMyQ.FieldByName('id') do
   With FMyQ.FieldByName('id') do
     ProviderFlags:=ProviderFlags-[pfInKey];
     ProviderFlags:=ProviderFlags-[pfInKey];
@@ -521,6 +527,7 @@ begin
       Transaction.Commit;
       Transaction.Commit;
     end;
     end;
   FMyQ:=SQLDBConnector.Query;
   FMyQ:=SQLDBConnector.Query;
+  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2';
@@ -547,6 +554,7 @@ begin
       Transaction.Commit;
       Transaction.Commit;
     end;
     end;
   FMyQ:=SQLDBConnector.Query;
   FMyQ:=SQLDBConnector.Query;
+  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2 where 1=2';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2 where 1=2';
@@ -647,6 +655,68 @@ begin
   SQLDBConnector.CommitDDL;
   SQLDBConnector.CommitDDL;
 end;
 end;
 
 
+procedure TTestTSQLQuery.TestReturningInsert;
+
+begin
+  with SQLDBConnector do
+    begin
+    if not (sqSupportReturning in Connection.ConnOptions) then
+      Ignore(STestNotApplicable);
+    ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
+    if Transaction.Active then
+      Transaction.Commit;
+    ExecuteDirect('insert into FPDEV2 (id) values (123)');
+    if Transaction.Active then
+      Transaction.Commit;
+    end;
+  FMyQ:=SQLDBConnector.Query;
+  FMyQ.SQL.Text:='select * from FPDEV2';
+//  FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  FMyQ.Open;
+  With FMyQ.FieldByName('id') do
+    ProviderFlags:=ProviderFlags+[pfInKey];
+  With FMyQ.FieldByName('a') do
+    ProviderFlags:=ProviderFlags+[pfRefreshOnInsert];
+  With FMyQ.FieldByName('b') do
+    ProviderFlags:=[];
+  FMyQ.Insert;
+  FMyQ.FieldByName('id').AsInteger:=1;
+  FMyQ.Post;
+  FMyQ.ApplyUpdates;
+  AssertEquals('a updated','abcde',FMyQ.FieldByName('a').AsString);
+  AssertEquals('b not updated','',FMyQ.FieldByName('b').AsString);
+end;
+
+procedure TTestTSQLQuery.TestReturningUpdate;
+
+begin
+  with SQLDBConnector do
+    begin
+    if not (sqSupportReturning in Connection.ConnOptions) then
+      Ignore(STestNotApplicable);
+    ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
+    if Transaction.Active then
+      Transaction.Commit;
+    ExecuteDirect('insert into FPDEV2 (id) values (123)');
+    if Transaction.Active then
+      Transaction.Commit;
+    end;
+  FMyQ:=SQLDBConnector.Query;
+  FMyQ.SQL.Text:='select * from FPDEV2';
+  FMyQ.Open;
+  With FMyQ.FieldByName('id') do
+    ProviderFlags:=ProviderFlags+[pfInKey];
+  With FMyQ.FieldByName('b') do
+    ProviderFlags:=[pfRefreshOnUpdate];  // Do not update, just fetch new value
+  FMyQ.Edit;
+  FMyQ.FieldByName('a').AsString:='ccc';
+  FMyQ.Post;
+  SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''123'' where id=123');
+  FMyQ.ApplyUpdates;
+  AssertEquals('a updated','ccc',FMyQ.FieldByName('a').AsString);
+  AssertEquals('b updated','123',FMyQ.FieldByName('b').AsString);
+end;
+
 
 
 { TTestTSQLConnection }
 { TTestTSQLConnection }