Delphi DataSetProvider BeforeUpdateRecord WideMemoField OldValue missing

973 views Asked by At

Writing a little change log for our DB application, and I'm facing the following problem: in the BeforeUpdateRecord event of my DataSetProvider, the OldValue of any (modified) WideMemo field is missing.

It is present in the ClientDataSet before I ApplyUpdates, obviously, so somewhere in the creation of the delta or its unpacking by the DataSetProvider, it gets dropped.

How can I get that value?

Just in case it's relevant, here are the components I use

Client-side: TClientDataSet TDataSource

Server-side: TIBQuery TDataSetProvider

Connecting to a Firebird DB

Delphi Tokyo and Datasnap

Cheers!

1

There are 1 answers

5
MartynA On BEST ANSWER

I thought I would post this as a new answer as a new answer to what I now understand from the OP's comments to be his specific problem. What the OP wants to do is to catch the OldValue of a dataset field on the server side, that is at the IBQuery, rather than the client side of a TDatasetProvider. I will take my previous answer down once I'm sure the OP has seen this one.

Consider the following code:

type
  TMyIBQuery = Class(TIBQuery)

  end;

procedure TForm1.IBQuery1BeforePost(DataSet: TDataSet);
var
  OldValue : Variant;
  PrvState : TDataSetState;
begin
  PrvState := IBQuery1.State;
  try
    TMyIBQuery(IBQuery1).SetTempState(dsOldValue);
    OldValue := IBQuery1.FieldByName('AValue').OldValue;
    Memo1.Lines.Add('OldValue: ' + OldValue);
  finally
    TMyIBQuery(IBQuery1).RestoreState(PrvState);
  end;
end;

If the DataSetProvider has default settings, IBQuery1BeforePost is not called when ApplyUpdates is called on the CDS connected to the DSP, because the process of applying updates bypasses the normal IBQuery editing process.

However, if you set the DSP's ResolveToDataSet property to True, IBQuery1BeforePost DOES execute and correctly extracts the OldValue of the AValue field, which is a WideMemo field in my setup. The reason the BeforePost code executes, of course, is that when ResolveToDataSet is set True, the usual IBQuery editing methods are used.

Update Here are the project extracts I mentioned in a comment:

Code extract

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    Memo1: TMemo;
    IBEvents1: TIBEvents;
    IBQuery1: TIBQuery;
    IBUpdateSQL1: TIBUpdateSQL;
    LblTrans: TLabel;
    Timer1: TTimer;
    IBQuery1ID: TIntegerField;
    IBQuery1ANAME: TIBStringField;
    IBQuery1AVALUE: TWideMemoField;
    DBMemo1: TDBMemo;
    DataSetProvider1: TDataSetProvider;
    CDS1: TClientDataSet;
    [...]
  end;

[...]
procedure TForm1.FormDestroy(Sender: TObject);
begin
  IBQuery1.Close;
  if IBTransaction1.InTransaction then
    IBTransaction1.Commit;
  if IBTransaction1.Active then
    IBTransaction1.Active := False;
  if IBEvents1.Registered then
    IBEvents1.Registered := False;
  IBDatabase1.Connected := False;
end;

procedure TForm1.RefreshTable2;
begin
  if IBQuery1.Modified then
    IBDatabase1.ApplyUpdates([IBQuery1]);
  RefreshDS;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  UpdateTransLabel;
end;

procedure TForm1.UpdateTransLabel;
begin
  if IBTransaction1.Active then
    lblTrans.Caption := 'Trans Active'
  else
    lblTrans.Caption := 'Trans Inactive';
end;

procedure TForm1.CDS1AfterPost(DataSet: TDataSet);
begin
  CDS1.ApplyUpdates(0);
end;

procedure TForm1.DBNavigator1BeforeAction(Sender: TObject; Button:
    TNavigateBtn);
begin
 if IBQuery1.CanModify then
   lblTrans.Caption := lblTrans.Caption + ' RW'
 else
   lblTrans.Caption := lblTrans.Caption + ' RO'
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := ExtractFileName(Application.ExeName) + ' / ' + IBDatabase1.Params.Values['user_name'];
  IBQuery1.Open;
end;

procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
begin
  IBDatabase1.Connected := True;
  IBEvents1.Registered := True;
end;

procedure TForm1.IBEvents1EventAlert(Sender: TObject; EventName: string;
    EventCount: Integer; var CancelAlerts: Boolean);
begin
  Memo1.Lines.Add('Evt: (' + IntToStr(EventCount) + ') ' + EventName);
end;

procedure TForm1.CommitAndRefresh;
begin
  IBTransaction1.CommitRetaining;
  RefreshTable2;
end;

procedure TForm1.IBQuery1AfterDelete(DataSet: TDataSet);
begin
  CommitAndRefresh;
end;

procedure TForm1.IBQuery1AfterPost(DataSet: TDataSet);
begin
  CommitAndRefresh;
end;

type
  TMyIBQuery = Class(TIBQuery)
  end;

procedure TForm1.IBQuery1BeforePost(DataSet: TDataSet);
var
  OldValue : Variant;
  PrvState : TDataSetState;
begin
  PrvState := IBQuery1.State;
  try
    TMyIBQuery(IBQuery1).SetTempState(dsOldValue);
    OldValue := IBQuery1.FieldByName('AValue').OldValue;
    Memo1.Lines.Add('OldValue: ' + OldValue);
  finally
    TMyIBQuery(IBQuery1).RestoreState(PrvState);
  end;
end;

procedure TForm1.IBQuery1UpdateError(DataSet: TDataSet; E: EDatabaseError;
    UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction);
begin
  UpdateAction := UpdateErrorForm.HandleError(DataSet, E, UpdateKind);
end;

procedure TForm1.RefreshDS;
var
  BM : TBookmark;
begin
  BM := IBQuery1.GetBookmark;
  try
    IBQuery1.Close;
    IBQuery1.Open;
  finally
    if IBQuery1.BookmarkValid(BM) then
      IBQuery1.GotoBookmark((BM));
    IBQuery1.FreeBookmark(BM);
  end;
end;

end.

DFM Extract

object Form1: TForm1
  [...]
  object LblTrans: TLabel
    [...]
    Alignment = taRightJustify
    Caption = '???'
  end
  object DBGrid1: TDBGrid
    [...]
    DataSource = DataSource1
    Columns = <
      item
        Expanded = False
        FieldName = 'ID'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'ANAME'
        Width = 80
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'AVALUE'
        Width = 200
        Visible = True
      end>
  end
  object DBNavigator1: TDBNavigator
    [...]
    DataSource = DataSource1
  end
  object Memo1: TMemo
    [...]
  end
  object DBMemo1: TDBMemo
    [...]
    DataField = 'AVALUE'
    DataSource = DataSource1
  end
  object DataSource1: TDataSource
    DataSet = CDS1
  end
  object IBDatabase1: TIBDatabase
    Connected = True
    DatabaseName = 'LocalHost:D:\Delphi\Interbase\Databases\MA.GDB'
    Params.Strings = (
      'user_name=SYSDBA'
      'password=masterkey')
    LoginPrompt = False
    DefaultTransaction = IBTransaction1
    ServerType = 'IBServer'
    TraceFlags = [tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect, tfTransact, tfBlob, tfService, tfMisc]
    AfterConnect = IBDatabase1AfterConnect
  end
  object IBTransaction1: TIBTransaction
    Active = True
    DefaultDatabase = IBDatabase1
    DefaultAction = TACommitRetaining
    Params.Strings = (
      'read_committed'
      'rec_version'
      'nowait')
  end
  object IBEvents1: TIBEvents
    AutoRegister = False
    Database = IBDatabase1
    Events.Strings = (
      'NewRow'
      'RowDeleted'
      'RowUpdated')
    Registered = False
    OnEventAlert = IBEvents1EventAlert
  end
  object IBQuery1: TIBQuery
    Database = IBDatabase1
    Transaction = IBTransaction1
    AfterDelete = IBQuery1AfterDelete
    AfterPost = IBQuery1AfterPost
    BeforePost = IBQuery1BeforePost
    BufferChunks = 1000
    CachedUpdates = False
    ParamCheck = True
    SQL.Strings = (
      'select * from table2')
    UpdateObject = IBUpdateSQL1
    Left = 112
      FieldName = 'ID'
      Origin = '"TABLE2"."ID"'
      ProviderFlags = [pfInUpdate, pfInWhere, pfInKey]
    end
    object IBQuery1ANAME: TIBStringField
      FieldName = 'ANAME'
      Origin = '"TABLE2"."ANAME"'
      Size = 80
    end
    object IBQuery1AVALUE: TWideMemoField
      FieldName = 'AVALUE'
      Origin = '"TABLE2"."AVALUE"'
      ProviderFlags = [pfInUpdate]
      BlobType = ftWideMemo
      Size = 8
    end
  end
  object IBUpdateSQL1: TIBUpdateSQL
    RefreshSQL.Strings = (
      'Select '
      'from table2 '
      'where'
      '  ID = :ID')
    ModifySQL.Strings = (
      'update table2'
      'set'
      '  ID = :ID,'
      '  ANAME = :ANAME,'
      '  AVALUE = :AVALUE'
      'where'
      '  ID = :OLD_ID')
    InsertSQL.Strings = (
      'insert into table2'
      '  (ID, ANAME, AVALUE)'
      'values'
      '  (:ID, :ANAME, :AVALUE)')
    DeleteSQL.Strings = (
      'delete from table2'
      'where'
      '  ID = :OLD_ID')
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
  end
  object DataSetProvider1: TDataSetProvider
    DataSet = IBQuery1
    ResolveToDataSet = True
  end
  object CDS1: TClientDataSet
    Active = True
    Aggregates = <>
    Params = <>
    ProviderName = 'DataSetProvider1'
    AfterPost = CDS1AfterPost
  end
end

Table DDL

CREATE TABLE "TABLE2"
(
  "ID"  INTEGER NOT NULL,
  "ANAME"   VARCHAR(80),
  "AVALUE"  BLOB SUB_TYPE TEXT SEGMENT SIZE 80
);

CREATE TRIGGER "GETTABLE2ID" FOR "TABLE2"
ACTIVE BEFORE INSERT POSITION 0
AS
begin
  new.ID = gen_id("TABLE2ID", 1);
  POST_EVENT('NewRow');
end

CREATE TRIGGER "UPDATETABLE2ROW" FOR "TABLE2"
ACTIVE AFTER UPDATE POSITION 0
AS
begin
  POST_EVENT('T2 RowUpdated');
end

COMMIT WORK