Эмуляция LINQ for SQL на Delphi

Постановка задачи.
Имеется большой Клиент-Сервер проект. Клиент программно строит динамические SQL запросы для выполнения на SQL сервере. Запросов много, логика построения размазана по всему клиентскому коду. Проект развивается во времени, необходимо модифицировать структуру базы данных. Как заставить компилятор показать все места, где в коде используются уже не существующие поля? Как заставить компилятор проверить, что целочисленному полю не присваивается строковый параметр? При этом паскалевский код должен быть приближен к SQL синтаксису.

Пример.
Допустим имеем базу данных в которой присутствуют две таблицы:

CREATE TABLE PERSON (     ID          INTEGER NOT NULL,     SURNAME VARCHAR(100) NOT NULL,     EMPLOYMENT  INTEGER,     MOTHER      INTEGER,     FATHER      INTEGER );  CREATE TABLE EMPLOYMENT (     ID           INTEGER NOT NULL,     DESCRIPTION  VARCHAR(100) NOT NULL ); 

Очень хочем сгенерировать SQL запрос на паскале (не стоит в нём искать логику):

select  P.ID,P.SURNAME  from Person P,Person F,Employment E  where P.FATHER=F.ID    and P.EMPLOYMENT=E.ID    and (F.SURNAME<>P.SURNAME or E.Description='U.S. President')    and P.MOTHER<>20 

Решение.
Тестировалось на Delphi 2007. Предлагаю использовать такой синтаксис для построения SQL запроса:

function GetTestSql: String; var   aBulder: TSuperBaseSqlBulder;   P: TPersonTable;   F: TPersonTable;   E: TEmploymentTable; begin   aBulder := TSuperBaseSqlBulder.Create;   try     P := aBulder.AddPersonTable('P');     F := aBulder.AddPersonTable('F');     E := aBulder.AddEmploymentTable('E');     Result :=       (         (P.Father = F.ID)         and (P.Employment = E.ID)         and ( (F.Surname <> P.Surname) or (E.Description = 'U.S. President') )         and (P.Mother <> 20)       ).Select([P.ID, P.Surname]);   finally     aBulder.Free;   end; end; 

Как видно синтаксис поле «Result :=» очень похож на LINQ. Как уговорить компилятор переварить это? Для начала вам надо объяснить компилятору структуру вашей базы. В будущем вы напишете програмку, которая просматривая структуру БД сгенерирует в нашем случае такое:

uses   UKSqlBulder;  type   TPersonTable = class(TSqlTable)     property ID: TCondField_Integer          index 0 read GetCondFields_Integer;     property Surname: TCondField_String      index 1 read GetCondFields_String;     property Employment: TCondField_Integer  index 2 read GetCondFields_Integer;     property Mother: TCondField_Integer      index 3 read GetCondFields_Integer;     property Father: TCondField_Integer      index 4 read GetCondFields_Integer;   end;    TEmploymentTable = class(TSqlTable)     property ID: TCondField_Integer          index 0 read GetCondFields_Integer;     property Description: TCondField_String  index 1 read GetCondFields_String;   end;    TSuperBaseSqlBulder = class(TSqlBulder)     function AddPersonTable(const aAlias: String = ''): TPersonTable;     function AddEmploymentTable(const aAlias: String = ''): TEmploymentTable;   end;  implementation  { TSuperBaseSqlBulder }  function TSuperBaseSqlBulder.AddPersonTable(const aAlias: String = ''): TPersonTable; begin   Result := TPersonTable.Create;   Result.Name := 'Person';   Result.Alias := aAlias;   Result.Add(TSqlField_Integer.Create('ID'));   Result.Add(TSqlField_String.Create('SURNAME'));   Result.Add(TSqlField_Integer.Create('EMPLOYMENT'));   Result.Add(TSqlField_Integer.Create('MOTHER'));   Result.Add(TSqlField_Integer.Create('FATHER'));   Add(Result); end;  function TSuperBaseSqlBulder.AddEmploymentTable(const aAlias: String = ''): TEmploymentTable; begin   Result := TEmploymentTable.Create;   Result.Name := 'Employment';   Result.Alias := aAlias;   Result.Add(TSqlField_Integer.Create('ID'));   Result.Add(TSqlField_String.Create('Description'));   Add(Result); end; 

И наконец исходный код UKSqlBulder:

unit UKSqlBulder;  interface  uses   Contnrs;  type   TSqlBulder = class;   TSqlTable = class;   TSqlField = class;   TSqlField_Integer = class;   TSqlField_String = class;    TRCondition = record   private     AsSql: String;   public     class operator LogicalAnd(const A, B: TRCondition): TRCondition;     class operator LogicalOr(const A, B: TRCondition): TRCondition;     function Select(const aFields: array of TSqlField): String;   end;   TCondField_Integer = record     Field: TSqlField_Integer;     class operator Equal(const A, B: TCondField_Integer): TRCondition;     class operator NotEqual(const A, B: TCondField_Integer): TRCondition;     class operator Equal(const A: TCondField_Integer; const aArg: Integer): TRCondition;     class operator NotEqual(const A: TCondField_Integer; const aArg: Integer): TRCondition;      class operator Implicit(A: TCondField_Integer): TSqlField;   end;    TCondField_String = record     Field: TSqlField_String;     class operator Equal(const A, B: TCondField_String): TRCondition;     class operator NotEqual(const A, B: TCondField_String): TRCondition;     class operator Equal(const A: TCondField_String; const aArg: String): TRCondition;     class operator NotEqual(const A: TCondField_String; const aArg: String): TRCondition;      class operator Implicit(A: TCondField_String): TSqlField;   end;   PRField_Integer = ^TCondField_Integer;   PRField_String = ^TCondField_String;    TSqlBulder = class(TObjectList)   private     function GetTables(aIndex: Integer): TSqlTable;   protected     procedure Add(aTable: TSqlTable);   public     property Tables[aIndex: Integer]: TSqlTable read GetTables; default;   end;    TSqlField = class     Table: TSqlTable;     Name: String;     function FullName: String;     constructor Create(const aName: String);   end;    TSqlField_Integer = class(TSqlField)   end;   TSqlField_String = class(TSqlField)     Length: String;   end;    TSqlTable = class(TObjectList)   private     Bulder: TSqlBulder;     function GetFields(aIndex: Integer): TSqlField;   protected     Alias: String;     Name: String;     function GetCondFields_Integer(aIndex: Integer): TCondField_Integer;     function GetCondFields_String(aIndex: Integer): TCondField_String;     procedure Add(aField: TSqlField);   public     property Fields[aIndex: Integer]: TSqlField read GetFields; default;   end;  implementation  uses   SysUtils;  { TSqlTable }  procedure TSqlTable.Add(aField: TSqlField); begin   inherited Add(aField);   aField.Table := self; end;  function TSqlTable.GetFields(aIndex: Integer): TSqlField; begin   Result := TSqlField(inherited Items[aIndex]); end;  function TSqlTable.GetCondFields_Integer(aIndex: Integer): TCondField_Integer; begin   Result.Field := Fields[aIndex] as TSqlField_Integer; end;  function TSqlTable.GetCondFields_String(aIndex: Integer): TCondField_String; begin   Result.Field := Fields[aIndex] as TSqlField_String; end;  { TSqlField }  constructor TSqlField.Create(const aName: String); begin   inherited Create;   Name := aName; end;  function TSqlField.FullName: String; begin   Result := Table.Alias + '.' + Name; end;  { TCondField_Integer }  class operator TCondField_Integer.Implicit(A: TCondField_Integer): TSqlField; begin   Result := A.Field; end;  class operator TCondField_Integer.Equal(const A, B: TCondField_Integer): TRCondition; begin   Result.AsSql := A.Field.FullName + '=' + B.Field.FullName; end;  class operator TCondField_Integer.NotEqual(const A, B: TCondField_Integer): TRCondition; begin   Result.AsSql := A.Field.FullName + '<>' + B.Field.FullName; end;  class operator TCondField_Integer.Equal(const A: TCondField_Integer; const aArg: Integer): TRCondition; begin   Result.AsSql := A.Field.FullName + '=' + IntToStr(aArg); end;  class operator TCondField_Integer.NotEqual(const A: TCondField_Integer; const aArg: Integer): TRCondition; begin   Result.AsSql := A.Field.FullName + '<>' + IntToStr(aArg); end;  { TCondField_String }  class operator TCondField_String.Implicit(A: TCondField_String): TSqlField; begin   Result := A.Field; end;  class operator TCondField_String.Equal(const A, B: TCondField_String): TRCondition; begin   Result.AsSql := A.Field.FullName + '=' + B.Field.FullName; end;  class operator TCondField_String.NotEqual(const A, B: TCondField_String): TRCondition; begin   Result.AsSql := A.Field.FullName + '<>' + B.Field.FullName; end;  class operator TCondField_String.Equal(const A: TCondField_String; const aArg: String): TRCondition; begin   Result.AsSql := A.Field.FullName + '=''' + aArg + ''''; end;  class operator TCondField_String.NotEqual(const A: TCondField_String; const aArg: String): TRCondition; begin   Result.AsSql := A.Field.FullName + '<>''' + aArg + ''''; end;  { TRCondition }  function TRCondition.Select(const aFields: array of TSqlField): String; var   i: Integer;   aSelect, aFrom: String;   aBulder: TSqlBulder;   aTable: TSqlTable; begin   if Length(aFields) <= 0 then     raise Exception.Create('Invalid argument');    aBulder := aFields[0].Table.Bulder;   aFrom := '';   for i := 0 to aBulder.Count - 1 do   begin     aTable := aBulder[i];     aFrom := aFrom + aTable.Name + ' ' + aTable.Alias + ',';   end;   aFrom[Length(aFrom)] := ' ';    aSelect := '';   for i := 0 to Length(aFields) - 1 do   begin     aSelect := aSelect + aFields[i].FullName + ',';   end;   aSelect[Length(aSelect)] := ' ';    Result := Format('select %sfrom %swhere %s', [aSelect, aFrom, AsSql]); end;  class operator TRCondition.LogicalAnd(const A, B: TRCondition): TRCondition; begin   Result.AsSql := A.AsSql + ' and ' + B.AsSql; end;  class operator TRCondition.LogicalOr(const A, B: TRCondition): TRCondition; begin   Result.AsSql := '(' + A.AsSql + ' or ' + B.AsSql + ')'; end;  { TSqlBulder }  procedure TSqlBulder.Add(aTable: TSqlTable); var   aPrefix: String; begin   if aTable.Alias = '' then   begin     if Count > 0 then       aPrefix := 'T' + IntToStr(Count + 1) + '_'     else       aPrefix := 'T_';     aTable.Alias := aPrefix + aTable.Name;   end;   aTable.Bulder := self;   inherited Add(aTable); end;  function TSqlBulder.GetTables(aIndex: Integer): TSqlTable; begin   Result := TSqlTable(inherited Items[aIndex]); end;  end.