ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBCustomDataSet.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBCustomDataSet.pas (file contents):
Revision 106 by tony, Thu Jan 18 14:37:35 2018 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 27 | Line 27
27   {    IBX For Lazarus (Firebird Express)                                  }
28   {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29   {    Portions created by MWA Software are copyright McCallum Whyman      }
30 < {    Associates Ltd 2011 - 2015                                                }
30 > {    Associates Ltd 2011 - 2015                                          }
31   {                                                                        }
32   {************************************************************************}
33  
# Line 76 | Line 76 | type
76      function GetSQL(UpdateKind: TUpdateKind): TStrings; virtual; abstract;
77      procedure InternalSetParams(Params: ISQLParams; buff: PChar); overload;
78      procedure InternalSetParams(Query: TIBSQL; buff: PChar); overload;
79 <    procedure UpdateRecordFromQuery(QryResults: IResults; Buffer: PChar);
79 >    procedure UpdateRecordFromQuery(UpdateKind: TUpdateKind; QryResults: IResults; Buffer: PChar);
80      property DataSet: TIBCustomDataSet read GetDataSet write SetDataSet;
81    public
82      constructor Create(AOwner: TComponent); override;
# Line 371 | Line 371 | type
371  
372    TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object;
373  
374 +  TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object;
375 +
376    TIBCustomDataSet = class(TDataset)
377    private
378      FAllowAutoActivateTransaction: Boolean;
# Line 403 | Line 405 | type
405      FDeletedRecords: Long;
406      FModelBuffer,
407      FOldBuffer: PChar;
408 +    FOnDeleteReturning: TOnDeleteReturning;
409      FOnValidatePost: TOnValidatePost;
410      FOpen: Boolean;
411      FInternalPrepared: Boolean;
# Line 441 | Line 444 | type
444      FInTransactionEnd: boolean;
445      FIBLinks: TList;
446      FFieldColumns: PFieldColumns;
447 +    FBufferUpdatedOnQryReturn: boolean;
448      procedure ColumnDataToBuffer(QryResults: IResults; ColumnIndex,
449        FieldIndex: integer; Buffer: PChar);
450      procedure InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
# Line 465 | Line 469 | type
469      procedure DoBeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
470      procedure DoAfterTransactionEnd(Sender: TObject);
471      procedure DoTransactionFree(Sender: TObject);
472 +    procedure DoDeleteReturning(QryResults: IResults);
473      procedure FetchCurrentRecordToBuffer(Qry: TIBSQL; RecordNumber: Integer;
474                                           Buffer: PChar);
475      function GetDatabase: TIBDatabase;
# Line 685 | Line 690 | type
690      procedure Post; override;
691      function ParamByName(ParamName: String): ISQLParam;
692      property ArrayFieldCount: integer read FArrayFieldCount;
693 +    property DatabaseInfo: TIBDatabaseInfo read FDatabaseInfo;
694      property UpdateObject: TIBDataSetUpdateObject read FUpdateObject write SetUpdateObject;
695      property UpdatesPending: Boolean read FUpdatesPending;
696      property UpdateRecordTypes: TIBUpdateRecordTypes read FUpdateRecordTypes
# Line 729 | Line 735 | type
735                                                   write FOnUpdateError;
736      property OnUpdateRecord: TIBUpdateRecordEvent read FOnUpdateRecord
737                                                     write FOnUpdateRecord;
738 +    property OnDeleteReturning: TOnDeleteReturning read FOnDeleteReturning
739 +                                                   write FOnDeleteReturning;
740    end;
741  
742    TIBParserDataSet = class(TIBCustomDataSet)
# Line 815 | Line 823 | type
823      property OnNewRecord;
824      property OnPostError;
825      property OnValidatePost;
826 +    property OnDeleteReturning;
827    end;
828  
829    { TIBDSBlobStream }
# Line 1964 | Line 1973 | begin
1973      FTransactionFree(Sender);
1974   end;
1975  
1976 + procedure TIBCustomDataSet.DoDeleteReturning(QryResults: IResults);
1977 + begin
1978 +  if assigned(FOnDeleteReturning) then
1979 +     OnDeleteReturning(self,QryResults);
1980 + end;
1981 +
1982   procedure TIBCustomDataSet.InitModelBuffer(Qry: TIBSQL; Buffer: PChar);
1983   var i, j: Integer;
1984      FieldsLoaded: integer;
# Line 2063 | Line 2078 | begin
2078    begin
2079      j := GetFieldPosition(QryResults[i].GetAliasName);
2080      if j > 0 then
2081 +    begin
2082        ColumnDataToBuffer(QryResults,i,j,Buffer);
2083 +      FBufferUpdatedOnQryReturn := true;
2084 +    end;
2085    end;
2086   end;
2087  
# Line 2316 | Line 2334 | begin
2334    begin
2335      SetInternalSQLParams(FQDelete.Params, Buff);
2336      FQDelete.ExecQuery;
2337 +    if (FQDelete.FieldCount > 0)  then
2338 +      DoDeleteReturning(FQDelete.Current);
2339    end;
2340    with PRecordData(Buff)^ do
2341    begin
# Line 2453 | Line 2473 | begin
2473        end;
2474        Inc(arr);
2475      end;
2476 +  FBufferUpdatedOnQryReturn := false;
2477    if Assigned(FUpdateObject) then
2478    begin
2479      if (Qry = FQDelete) then
# Line 2465 | Line 2486 | begin
2486    else begin
2487      SetInternalSQLParams(Qry.Params, Buff);
2488      Qry.ExecQuery;
2489 +    if Qry.FieldCount > 0 then {Has RETURNING Clause}
2490 +      UpdateRecordFromQuery(Qry.Current,Buff);
2491    end;
2469  if Qry.FieldCount > 0 then {Has RETURNING Clause}
2470    UpdateRecordFromQuery(Qry.Current,Buff);
2492    PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
2493    PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
2494    SetModified(False);
2495    WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
2496 <  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
2496 >  if (FForcedRefresh or (FNeedsRefresh and not FBufferUpdatedOnQryReturn)) and CanRefresh then
2497      InternalRefreshRow;
2498   end;
2499  
# Line 2708 | Line 2729 | end;
2729  
2730   procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
2731   begin
2732 <  if (FBase.Database <> Value) then
2732 >  if (csLoading in ComponentState) or (FBase.Database <> Value) then
2733    begin
2734      CheckDatasetClosed;
2735      InternalUnPrepare;
# Line 2748 | Line 2769 | var
2769    fn: string;
2770    st: RawByteString;
2771    OldBuffer: Pointer;
2751  ts: TTimeStamp;
2772    Param: ISQLParam;
2773   begin
2774    if (Buffer = nil) then
# Line 2919 | Line 2939 | end;
2939   procedure TIBCustomDataSet.RegisterIBLink(Sender: TIBControlLink);
2940   begin
2941    if FIBLinks.IndexOf(Sender) = -1 then
2942 +  begin
2943      FIBLinks.Add(Sender);
2944 +    if Active then
2945 +    begin
2946 +      Active := false;
2947 +      Active := true;
2948 +    end;
2949 +  end;
2950   end;
2951  
2952  
# Line 3794 | Line 3821 | var
3821    FieldType: TFieldType;
3822    FieldSize: Word;
3823    FieldDataSize: integer;
3797  charSetID: short;
3824    CharSetSize: integer;
3825    CharSetName: RawByteString;
3826    FieldCodePage: TSystemCodePage;
# Line 4989 | Line 5015 | begin
5015    InternalSetParams(Query.Params,buff);
5016   end;
5017  
5018 < procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(QryResults: IResults;
5019 <  Buffer: PChar);
5018 > procedure TIBDataSetUpdateObject.UpdateRecordFromQuery(UpdateKind: TUpdateKind;
5019 >  QryResults: IResults; Buffer: PChar);
5020   begin
5021    if not Assigned(DataSet) then Exit;
5022 <  DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5022 >  case UpdateKind of
5023 >  ukModify, ukInsert:
5024 >    DataSet.UpdateRecordFromQuery(QryResults, Buffer);
5025 >  ukDelete:
5026 >    DataSet.DoDeleteReturning(QryResults);
5027 >  end;
5028   end;
5029  
5030   function TIBDSBlobStream.GetSize: Int64;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines