Наследник от TIBUpdateSQL с пишущей транзакцией

© 2003 Галимарзанов Фанис

Здесь попытка внедрить в IBX принцип разделения транзакций на "читающие" и "пишущие" для компонентов типа IBCustomDataset. Использование в качестве базового компонента IBUpdateSQL объясняется желанием минимизировать работу по изменению исходного кода и его достаточностью - переделка IBDataset может повлечь за собой вероятные проблемы при использовании новых версий IBX.

К сожалению, автор IBX (Jeff Overcash) стремится обуздать новации и помещает важные для наследования методы в секцию private - наследование сопряжено с большими трудозатратами. Худшая ситуация - метод приватен и статичен, здесь уже ничего не поделаешь :-(((

Для понимания механизма IBUpdateSQL необходимо выделить следующие свойства и методы:

private
  FQueries: array[TUpdateKind] of TIBQuery;
public
  property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;

Свойство-массив FQueries хранит указатели на объекты типа TIBQuery, значения которых в начальный момент равны nil. При первом обращении к Query вызывается метод GetQuery - он создает объект и инициализирует его свойств IBDatabase и IBTransaction. Отмечу, что вероятна ситуация, когда один или несколько объектов TIBQuery просто не будут созданы, т.е. не происходили изменения данных и FDataset не обращался к методу UpdateObject.Apply. Проще говоря, компонент IBUpdateSQL делает "ручную" работу вроде

var
  MySql:TIBSQL;

initialization

  MySql:=TIBSQL.Create(nil);
  MySql.database:=dm.Base;
  MySql.Transaction:=dm.trRead;
  MySql.SQL:='la-la-la';

finalization
  if Assigned(MySql) then
    MySql.Free;

Все это реализовано в методе GetQuery.

Для решения задачи по "внедрению" транзакции необходимо написать код:

1. обработки события SetUpdateTransaction
2. внести изменения в GetQuery
3. обработать событие Notification
4. обойти приватность и статичность

Если с первыми тремя пунктами более-менее понятно, то последний пункт требует подмены FQueries и некоторых методов. Ниже приведено решение, которое в разных вариациях используется мною в течении нескольких лет.

Автор - Галимарзанов Фанис
"Центр-Газ", Башкирия
E-Mail: inrus51@poikc.bashnet.ru

---

unit IBUpdateSQLW;

interface

uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBQuery,IBUpdateSQL, IBDatabase;
type

  TIBUpdateSQLW = class(TIBUpdateSQL)
  private
  // Указатель на "пишущую" транзакцию
    FUpdateTransaction:TIBTransaction;
  // здесь подмена вместо "родной" FQueries
    FQueriesW: array[TUpdateKind] of TIBQuery;
    procedure SetUpdateTransaction(Value:TIBTransaction);
  protected
  // здесь подмена вместо "родной" GetQuery
    function  GetQueryW(UpdateKind: TUpdateKind): TIBQuery;
  // здесь подмена вместо "родной" SQLChanged
    procedure SQLChangedW(Sender: TObject);
  // Устанавливает TIBQuery.Transaction
    procedure SetQueryTransaction(UpdateKind: TUpdateKind);
  // Чистит указатели  при удалении fUpdateTransaction
    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Apply(UpdateKind: TUpdateKind); override;
  // здесь подмена вместо "родной" ExecSQL
    procedure ExecSQLW(UpdateKind: TUpdateKind);
  // здесь подмена вместо "родной" SetParams
    procedure SetParamsW(UpdateKind: TUpdateKind);
  // здесь подмена вместо "родной" Query
    property QueryW[UpdateKind: TUpdateKind]: TIBQuery read GetQueryW;
  published
    property UpdateTransaction:TIBTransaction read fUpdateTransaction
                                              write SetUpdateTransaction;
  end;
procedure Register;

implementation

{ TIBUpdateSQLW }
procedure Register;
begin
RegisterComponents('Interbase',[TIBUpdateSQLW]);
end;

constructor TIBUpdateSQLW.Create(AOwner: TComponent);
var
  UpdateKind: TUpdateKind;
begin
  inherited Create(AOwner);
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
  begin
  // Изменим обработчики OnChange для уже созданных
  // TStringList
    TStringList(SQL[UpdateKind]).OnChange := SQLChangedW;
  end;
end;

destructor TIBUpdateSQLW.Destroy;
var
  UpdateKind: TUpdateKind;
begin
// очистим массив FQueriesW
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
  if Assigned(FQueriesW[UpdateKind]) then
  begin
    FQueriesW[UpdateKind].Free;
    FQueriesW[UpdateKind]:=nil;
  end;
  inherited Destroy;
end;


// Функция возвращает указатель на объект TIBQuery из нашего
// массива FWQueries
function TIBUpdateSQLW.GetQueryW(UpdateKind: TUpdateKind): TIBQuery;
begin
  if not Assigned(FQueriesW[UpdateKind]) then
  begin
    FQueriesW[UpdateKind] := TIBQuery.Create(Self);
    FQueriesW[UpdateKind].SQL.Assign(SQL[UpdateKind]);
    SetQueryTransaction(UpdateKind);
  end;
  Result := FQueriesW[UpdateKind];
end;

procedure TIBUpdateSQLW.SQLChangedW(Sender: TObject);
var
  UpdateKind: TUpdateKind;
begin
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
    if Sender = SQL[UpdateKind] then
    begin
      if Assigned(FQueriesW[UpdateKind]) then
      begin
      // Установить текст SQL
        FQueriesW[UpdateKind].Params.Clear;
        FQueriesW[UpdateKind].SQL.Assign(SQL[UpdateKind]);
      end;
      Break;
    end;
end;

procedure TIBUpdateSQLW.SetParamsW(UpdateKind: TUpdateKind);
var
  I: Integer;
  Old: Boolean;
  Param: TParam;
  PName: string;
  Field: TField;
  Value: Variant;
begin
  if not Assigned(DataSet) then Exit;
  with QueryW[UpdateKind] do
  begin
    for I := 0 to Params.Count - 1 do
    begin
      Param := Params[I];
      PName := Param.Name;
      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
      if Old then
        System.Delete(PName, 1, 4);
      Field := DataSet.FindField(PName);
      if not Assigned(Field) then
        Continue;
      if Old then
        Param.AssignFieldValue(Field, Field.OldValue) else
      begin
        Value := Field.NewValue;
        if VarIsEmpty(Value) then
          Value := Field.OldValue;
        Param.AssignFieldValue(Field, Value);
      end;
    end;
  end;
end;

procedure TIBUpdateSQLW.Apply(UpdateKind: TUpdateKind);
begin
// вызываем "наши" процедуры
  SetParamsW(UpdateKind);
  ExecSQLW(UpdateKind);
end;

procedure TIBUpdateSQLW.ExecSQLW(UpdateKind: TUpdateKind);
begin
  with QueryW[UpdateKind] do
  begin
  // если определен fUpdateTransaction
    if Assigned(fUpdateTransaction) and
    not fUpdateTransaction.InTransaction then
    fUpdateTransaction.StartTransaction;
    try
    Prepare;
    ExecSQL;
    if RowsAffected <> 1 then
      IBError(ibxeUpdateFailed, [nil]);
    finally
    // добавлено
      if Assigned(fUpdateTransaction) then
      begin
    // в любом сдучае лучше Commit
      fUpdateTransaction.Commit;
      end;
    end;
  end;
end;

procedure TIBUpdateSQLW.SetQueryTransaction(UpdateKind: TUpdateKind);
begin
  if Assigned(FQueriesW[UpdateKind]) then
  begin
    if Assigned(fUpdateTransaction) then
    begin
      FQueriesW[UpdateKind].Database :=fUpdateTransaction.FindDefaultDatabase;
      FQueriesW[UpdateKind].Transaction :=fUpdateTransaction;
    end else
    // inherited
    if (DataSet is TIBCustomDataSet) then
    begin
      FQueriesW[UpdateKind].Database := TIBCustomDataSet(DataSet).DataBase;
      FQueriesW[UpdateKind].Transaction := TIBCustomDataSet(DataSet).Transaction;
    end;
  end;
end;

procedure TIBUpdateSQLW.Notification( AComponent: TComponent;
                                        Operation: TOperation);
var
  UpdateKind: TUpdateKind;
begin
  inherited Notification( AComponent, Operation);
    if (Operation = opRemove) then
    begin
      if AComponent = FUpdateTransaction then
      begin
       FUpdateTransaction := nil;
        for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
        SetQueryTransaction(UpdateKind);
      end;
    end;
end;

// процедура устанавливает значение FUpdateTransaction и
// определяет IBDatabase и IBTransaction для всех
// IBQuery(Queries)
procedure TIBUpdateSQLW.SetUpdateTransaction(Value:TIBTransaction);
var
  UpdateKind: TUpdateKind;
begin
  FUpdateTransaction := Value;
  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
  SetQueryTransaction(UpdateKind);
end;

end.