TInvokeableVariantType

К написанию этого поста меня подтолкнула статья на хабре про написание ORM для Delphi. Велосипед с квадратными колесами, конечно, но идея интересная. Хочу попробовать подойти к этому вопросу с другой стороны. Очень кратко.

В Delphi, начиная с версии 6 2007 (поправьте меня, если я ошибаюсь), в модуле Variants есть малоизвестный, но весьма занимательный класс TInvokeableVariantType.

Чтобы сэкономить время, я опишу совершенно абстрактный пример. Этого будет достаточно, чтобы продемонстрировать, что применить этот подход в работе над ORM или где-то еще достаточно просто. Здесь именно тот случай, когда придумать достойное применение намного сложнее, чем применить :)

В классе наследующем TInvokeableVariantType можно обрабатывать обращения к свойствам и методам динамически. То есть нет необходимости предварительно описывать интерфейс класса. В каких-то случаях это может помочь сэкономить немалое количество строк кода. Но любые плюсы тянут за собой и минусы — как минимум, IDE не будет иметь никакой информации о таком классе и подсказки в коде не будут работать.

Ниже простой класс-счетчик. Пусть он имеет поле Counter, с помощью которого можно получать или изменять значение счетчика, и два метода — процедуру Reset, которая сбрасывает счетчик в ноль, и функцию Pow2, возвращающую квадрат значения счетчика и не изменяющую сам счетчик.

  TVariantCounter = class(TInvokeableVariantType)
  private
    FCounter: Integer;
  public
    procedure Clear(var V: TVarData); override;

    function GetProperty(var Dest: TVarData; const V: TVarData;
      const Name: string): Boolean; override;
    function SetProperty(const V: TVarData; const Name: string;
      const Value: TVarData): Boolean; override;
    function DoFunction(var Dest: TVarData; const V: TVarData;
      const Name: string; const Arguments: TVarDataArray): Boolean; override;
    function DoProcedure(const V: TVarData; const Name: string;
      const Arguments: TVarDataArray): Boolean; override;
  end;

При взгляде на объявление класса многое становится ясно. В нем нет ни поля Counter, ни методов Reset и Pow2, но зато есть методы GetProperty, SetProperty, DoFunction и DoProcedure, в которые передаются все нужные имена и значения для динамической обработки.

Рассматриваемый пример очень прост, поэтому меньше слов — больше кода :)

function TVariantCounter.DoFunction(var Dest: TVarData; const V: TVarData;
  const Name: string; const Arguments: TVarDataArray): Boolean;
begin
  Result := False;

  if SameText(Name, 'Pow2') and (Length(Arguments) = 0) then
  begin
    Variant(Dest) := FCounter * FCounter;
    Result := True;
  end;
end;

function TVariantCounter.DoProcedure(const V: TVarData; const Name: string;
  const Arguments: TVarDataArray): Boolean;
begin
  Result := False;

  if SameText(Name, 'Reset') and (Length(Arguments) = 0) then
  begin
    FCounter := 0;
    Result := True;
  end;
end;

function TVariantCounter.GetProperty(var Dest: TVarData; const V: TVarData;
  const Name: string): Boolean;
begin
  if SameText(Name, 'Counter') then
  begin
    Variant(Dest) := FCounter;
    Result := True;
  end else
    Result := False;
end;

function TVariantCounter.SetProperty(const V: TVarData; const Name: string;
  const Value: TVarData): Boolean;
begin
  if SameText(Name, 'Counter') then
  begin
    FCounter := Variant(Value);
    Result := True;
  end else
    Result := False;
end;

Использовать TVariantCounter можно практически как обычный класс.

var
  Cntr: Variant;
begin
  Cntr := NewVariantCounter;
  Cntr.Reset;

  Memo1.Lines.Add(Cntr.Counter);
  Cntr.Counter := 25;
  Memo1.Lines.Add(Cntr.Counter);
  Memo1.Lines.Add(Cntr.Pow2);
  Cntr.Reset;
  Memo1.Lines.Add(Cntr.Counter);
end;

В результате в Memo появляется следующий текст:

0
25
625
0

Пока все радужно, но я ничего не сказал про функцию NewVariantCounter. В разговоре об инициализации придется упомянуть некоторые нюансы. Неприятность в том, что данный класс — синглтон. Со всеми вытекающими.

var
  VariantCounter: TVariantCounter;

function NewVariantCounter: Variant;
begin
  VarClear(Result);
  TVarData(Result).VType := VariantCounter.VarType;
end;

initialization
  VariantCounter := TVariantCounter.Create;

finalization
  VariantCounter.Free;

То есть в этом коде счетчик для всех экземпляров общий. А в этом мало смысла.

Если подходить серьезно, то TVariantCounter не должен быть счетчиком, он должен управлять счетчиками, а значения счетчика для каждого экземпляра можно хранить в структуре TVarData (ссылка на конкретный экземпляр TVarData в свою очередь передается в каждый из методов класса).

Определим свою собственную TVarData вот так:

TCounterVarData = packed record
  VType: TVarType;
  Reserved1, Reserved2, Reserved3: Word;
  CounterValue: PInteger;
  Reserved4: LongWord;
end;

PInteger вместо Integer здесь используется в связи с тем, что саму запись во время работы изменять нельзя. Поэтому пусть сам указатель остается постоянным, а изменяемую память мы выделим где-то еще.

Функцию NewVariantCounter придется изменить соответствующим образом:

function NewVariantCounter: Variant;
begin
  VarClear(Result);
  TCounterVarData(Result).VType := VariantCounter.VarType;

  New(TCounterVarData(Result).CounterValue);
  TCounterVarData(Result).CounterValue^ := 0;
end;

Изменения также коснутся и остального кода. Вот так:

function TVariantCounter.DoFunction(var Dest: TVarData; const V: TVarData;
  const Name: string; const Arguments: TVarDataArray): Boolean;
begin
  Result := False;

  if SameText(Name, 'Pow2') and (Length(Arguments) = 0) then
  begin
    Variant(Dest) := TCounterVarData(V).CounterValue^ * TCounterVarData(V).CounterValue^;
    Result := True;
  end;
end;

Остальные методы я опущу, так как здесь все в общем-то очевидно.

И вот тут становится ясно для чего классу метод Clear. Этот метод позволяет корректно финализировать структуру. В данном конкретном случае — освободить память выделенную для CounterValue.

procedure TVariantCounter.Clear(var V: TVarData);
begin
  Dispose(TCounterVarData(V).CounterValue);
  inherited;
end;

Пример очень простой, но сам механизм очень мощный. Если вернуться к тому с чего начался этот пост, то при разработке ORM, вместо CounterValue структура TVarData могла бы хранить ссылку на TDataSet и работать с полями этого датасета как со свойствами класса.

Полный код примера можно скачать тут.