Аналог .Net Entity Framework в Delphi посредством RTTI. Часть первая, вступительная

После того, как в Embarcadero оживили Delhi, я вернулся с разработки на C# к более привычному инструменту. Серьезно порадовало, что большинство синтаксических возможностей, классов и различных «рюшечек» волшебным образом переехало из шарпа. К сожалению, такая приятная возможность, как отображение выборки из базы данных на коллекции классов осталась за скобками.

В своих проектах мы часто сталкиваемся с необходимостью алгоритмической обработки различных выборок, реализация которых невозможна средствами SQL. Для каждой выборки создавался класс и каждый раз, когда нужно создать новую выборку, приходилось проводить абсолютно одинаковые движения, с той разницей, что заполнять поля классов приходилось ручками.

Раскинув мозгом и оценив возможности RTTI, трудозатраты и наличный запас бубнов, у нас получился список «хотелок» для работы с БД, которых не хватает в нашей скучной жизни:

1. Автоматическая генерация классов по структуре таблиц разрабатываемой БД.
2. Заполнение списков классов данными из таблиц.
3. Для реализации создания классов будет не лишним считывать структуру таблиц БД.
4. Имея на руках структуру БД можно автоматизировать:

• Сравнение структуры существующей БД с эталонной для предупреждения ошибок при обновлении разрабатываемого ПО у конечного пользователя;
• Формирование «контракта БД», содержащего в себе константы названий таблиц, полей, хранимых процедур и функций;
• Создание классов из пп. 1. с учетом связей между таблицами.
• Создание «оберток» для вызова хранимых процедур и функций.

И при правильной реализации и аккуратной работе вдалеке начинает маячить возможность кроссплатформенной работы между различными типами SQL серверов.

Начнем с простого

Проверим саму возможность отображения данных из DataSet-ов на классы. Обновленный RTTI позволяет перечислять имена свойств класса, а также, получать и устанавливать значения свойств.

Создадим пример выборки из простой таблицы и заполнения списка классов, содержащих публичные свойства, совпадающие по названию с полями таблицы. Работать будем MS SQL сервером.

Создадим БД, в ней таблицу с физ. лицами и парой записей:

USE [master]
GO

CREATE DATABASE [TestRtti]
GO

USE [TestRtti]
GO

CREATE TABLE [dbo].[Users_Persons](
	[Guid] [uniqueidentifier] ROWGUIDCOL  NOT NULL CONSTRAINT [DF_Users_Persons_Guid]  DEFAULT (newid()),
	[Created] [datetime2](7) NOT NULL CONSTRAINT [DF_Users_Persons_Created]  DEFAULT (getutcdate()),
	[Written] [datetime2](7) NOT NULL CONSTRAINT [DF_Users_Persons_Written]  DEFAULT (getutcdate()),
	[First_Name] [nvarchar](30) NOT NULL,
	[Middle_Name] [nvarchar](30) NOT NULL,
	[Last_Name] [nvarchar](30) NOT NULL,
	[Sex] [bit] NOT NULL,
	[Born] [date] NULL
) ON [PRIMARY]
GO
ALTER TABLE [dbo].[Users_Persons] ADD  CONSTRAINT [PK_Users_Persons] PRIMARY KEY NONCLUSTERED 
(
	[Guid] ASC
)WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, SORT_IN_TEMPDB = OFF, IGNORE_DUP_KEY = OFF, ONLINE = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
GO

INSERT [dbo].[Users_Persons] ([Guid], [Created], [Written], [First_Name], [Middle_Name], [Last_Name], [Sex], [Born]) 
VALUES (N'291fefb5-2d4e-4ccf-8ca0-25e97fabefff', CAST(N'2016-07-21 10:56:16.6630000' AS DateTime2), CAST(N'2016-12-09 16:22:01.8670000' AS DateTime2), 
N'Петр', N'Николаевич', N'Иванов', 1, CAST(N'1970-01-01' AS Date))
GO
INSERT [dbo].[Users_Persons] ([Guid], [Created], [Written], [First_Name], [Middle_Name], [Last_Name], [Sex], [Born]) 
VALUES (N'11ad8670-158c-4777-a099-172acd61cbd3', CAST(N'2016-07-21 10:59:02.2030000' AS DateTime2), CAST(N'2016-12-09 16:22:10.4730000' AS DateTime2), 
N'Андрей', N'Юрьевич', N'Смирнов', 1, CAST(N'1970-01-01' AS Date))
GO

Ручками в модуле UsersPersonsEntity.pas создадим класс TUsersPersonsEntity и, забегая вперед, объявим его список и создадим для него тип класса-читателя:

unit UsersPersonsEntity;

interface

uses
  Generics.Collections, DataSetReader;

type
  TUsersPersonsEntity = class(TBaseDataRecord)
  private
    FGuid: TGUID;
    FCreated: TDateTime;
    FWritten: TDateTime;
    FFirstName: String;
    FMiddleName: String;
    FLastName: String;
    FSex: Boolean;
    FBorn: TDate;
  public
    property Guid: TGUID read FGuid write FGuid;
    property Created: TDateTime read FCreated write FCreated;
    property Written: TDateTime read FWritten write FWritten;
    property First_Name: String read FFirstName write FFirstName;
    property Middle_Name: String read FMiddleName write FMiddleName;
    property Last_Name: String read FLastName write FLastName;
    property Sex: Boolean read FSex write FSex;
    property Born: TDate read FBorn write FBorn;
  end;

  TUsersPersonsList = TDataRecordsList<TUsersPersonsEntity>;
  TUsersPersonsReader = TDataReader<TUsersPersonsEntity>;

implementation

end.

В текущей ситуации нам даже не понадобится конструктор класса. Теперь самое веселое — надо отобразить строку из DataSet на экземпляр класса. Весь код чтения вынесен в отдельный модуль и занимает без малого полторы сотни строк.

unit DataSetReader;

interface

uses
  System.TypInfo, System.Rtti, SysUtils, DB, Generics.Collections, Generics.Defaults;

type
  TBaseDataRecord = class
  public
    constructor Create; overload; virtual;
    procedure SetPropertyValueByField(ClassProperty: TRttiProperty;
      Field: TField; FieldValue: Variant);
    procedure SetRowValuesByFieldName(DataSet: TDataSet);
    procedure AfterRead; virtual;
  end;

  TBaseDataRecordClass = class of TBaseDataRecord;

  TDataRecordsList<T: TBaseDataRecord> = class(TObjectList<T>);

  TDataReader<T: TBaseDataRecord, constructor> = class
  public
    function Read(DataSet: TDataSet; ListInstance: TDataRecordsList<T> = nil;
      EntityClass: TBaseDataRecordClass = nil): TDataRecordsList<T>;
  end;

implementation

var
  Context: TRttiContext;

  { TBaseDataRecord }

constructor TBaseDataRecord.Create;
begin
end;

procedure TBaseDataRecord.AfterRead;
begin
end;

procedure TBaseDataRecord.SetPropertyValueByField(ClassProperty: TRttiProperty; Field: TField;
  FieldValue: Variant);

  function GetValueGuidFromMsSql: TValue;
  var
    Guid: TGUID;
  begin
    if Field.IsNull then
      Guid := TGUID.Empty
    else
      Guid := StringToGUID(Field.AsString);
    Result := TValue.From(Guid);
  end;

var
  Value: TValue;
  GuidTypeInfo: PTypeInfo;
begin
  if Field = nil then
    Exit;
  GuidTypeInfo := TypeInfo(TGUID);
  Value := ClassProperty.GetValue(Self);
  case Field.DataType of
    ftGuid: begin
        if Value.TypeInfo = GuidTypeInfo then
          ClassProperty.SetValue(Self, GetValueGuidFromMsSql)
        else
          ClassProperty.SetValue(Self, TValue.FromVariant(FieldValue));
      end;
  else
    ClassProperty.SetValue(Self, TValue.FromVariant(FieldValue));
  end;

end;

procedure TBaseDataRecord.SetRowValuesByFieldName(DataSet: TDataSet);
var
  Field: TField;
  FieldName: String;
  FieldValue: Variant;
  ClassName: String;
  ClassType: TRttiType;
  ClassProperty: TRttiProperty;
begin
  ClassName := Self.ClassName;
  ClassType := Context.GetType(Self.ClassType.ClassInfo);
  for ClassProperty in ClassType.GetProperties do
  begin
    Field := DataSet.FindField(ClassProperty.Name);
    if Field <> nil then
    begin
      FieldName := Field.FieldName;
      FieldValue := Field.Value;
      SetPropertyValueByField(ClassProperty, Field, FieldValue);
    end;
  end;
end;

{ TDataReader<T> }

function TDataReader<T>.Read(DataSet: TDataSet; ListInstance: TDataRecordsList<T>;
  EntityClass: TBaseDataRecordClass): TDataRecordsList<T>;
var
  Row: T;
begin
  if ListInstance = nil then
    Result := TDataRecordsList<T>.Create
  else begin
    Result := ListInstance;
    Result.OwnsObjects := True;
    Result.Clear;
  end;

  DataSet.DisableControls;
  Result.Capacity := DataSet.RecordCount;
  while not DataSet.Eof do
  begin
    if EntityClass = nil then
      Row := T.Create()
    else
      Row := EntityClass.Create() as T;

    Row.SetRowValuesByFieldName(DataSet);

    Row.AfterRead;
    Result.Add(Row);
    DataSet.Next;
  end;
end;

initialization

Context := TRttiContext.Create;

end.

Для удобства оперирования generic классами желательно создать базовый класс сущности строки таблицы с виртуальным конструктором TBaseDataRecord и порождать от него реальные сущности строк таблиц (см. объявление TUsersPersonsEntity). Помимо базового класса, в модуле присутствует generic класс «читатель». Его задача пробегаться по DataSet-у, создавать экземпляры строк и подсовывать текущую строку выборки созданному экземпляру наследника TBaseDataRecord и складировать его в результирующий список.

Функционал отображения данных из выборки на класс вынесен в TBaseDataRecord. При переборе свойств класса производится поиск в DataSet полей с таким же именем. Если поле найдено, то после легкого шаманства с вариантными типами и TValue, в свойстве оказывается требуемое значение.

К сожалению, «не всё так однозначно». В методе SetPropertyValueByField приходится проверять, что текущее свойство имеет тип TGUID. MSSQL отдает GUID в виде строки и прямое присвоение даст ошибку. Приходится явно преобразовывать строку к GUID. Более того, дальнейшее применение показало необходимость дополнительных приседаний для:

• MSSQL, OLEDB и DATE, DATETIME
• Обработка BLOB-ов
• Firebird и GUID при хранении в CHAR(16) CHARACTER SET OCTETS
• Firebird и TIMESTAMP

Список постоянно пополняется по мере обнаружения. Но главное — оно работает. И работает следующим образом (собственно текст программы):

program TestRtti;
{$APPTYPE CONSOLE}
{$R *.res}
uses
  DB, ADODB, System.SysUtils, ActiveX,
  DataSetReader in 'DataSetReader.pas',
  UsersPersonsEntity in 'UsersPersonsEntity.pas';
var
  Connection: TADOConnection;
  Query: TADOQuery;
  UsersPersons: TUsersPersonsList;
  UserPerson: TUsersPersonsEntity;
  Reader: TUsersPersonsReader;
  i: Integer;

begin
  ReportMemoryLeaksOnShutdown := True;
  UsersPersons := nil;
  try
    CoInitialize(nil);
    Connection := TADOConnection.Create(nil);
    try
      Connection.ConnectionString :=
        'Provider=SQLNCLI11.1;Integrated Security=SSPI;Persist Security Info=False;User ID="";' +
        'Initial Catalog="TestRtti";Data Source=localhost;Initial File Name="";Server SPN=""';
      Connection.Connected := True;

      Query := TADOQuery.Create(nil);
      Reader := TUsersPersonsReader.Create;
      try
        Query.Connection := Connection;
        Query.SQL.Text := 'SELECT * FROM Users_Persons';
        Query.Open;

        UsersPersons := Reader.Read(Query);

        Writeln('Прочитано записей: ', UsersPersons.Count);
        for i := 0 to UsersPersons.Count - 1 do begin
          UserPerson := UsersPersons[i];
          Writeln(Format('%d. %s %s %s %s', [i + 1, UserPerson.First_Name, UserPerson.Middle_Name,
            UserPerson.Last_Name, FormatDateTime('dd.mm.yyyy', UserPerson.Born)]));
        end;
        Writeln('Нажмите Enter для завершения...');
        Readln;
      finally
        Query.Free;
        Reader.Free;
      end;
    finally
      Connection.Free;
      if UsersPersons <> nil then
        FreeAndNil(UsersPersons);
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Главное в коде это строка UsersPersons := Reader.Read(Query);. И всё. Компактненько, однако. А вот и вывод приложения:

Что дальше

Это только проверка возможностей. Хотя для «плоских» простых запросов приведенный механизм вполне работоспособен.

А дальше -­ автоматическое создание контракта БД и сущностей таблиц, создание эталонной схемы БД, связывание списков сущностей, обновление данных, сериализация списков и кроссплатформенное чтение.

Автор: maxx0

Источник