LINQ for SQL emulation on Delphi

Formulation of the problem.
There is a large Client-Server project. The client programmatically builds dynamic SQL queries for execution on the SQL server. It is a lot of requests, the logic of creation is spread on all client code. The project develops in time, it is necessary to modify the structure of the database. How to make the compiler show all the places where fields that no longer exist are used in the code? How to make the compiler check that an integer field is not assigned a string parameter? At the same time, Pascal code should be close to SQL syntax.

Example.
Suppose we have a database in which there are two tables:

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 ); 

We really want to generate a SQL query on pascal (you should not look for logic in it):

 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='US President') and P.MOTHER<>20 

Decision.
It was tested on Delphi 2007. I suggest using this syntax for building an SQL query:

 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 = 'US President') ) and (P.Mother <> 20) ).Select([P.ID, P.Surname]); finally aBulder.Free; end; end; 

As you can see, the syntax after “Result: =” is very similar to LINQ. The compiler checks for the presence of columns, catches type incompatibility errors. Those. won't miss anything from:

 E.UnknownFiled = 1 //   E.Description = E.ID //    P.Mother = 'Miss World' //    

What was it all for? Now let's persuade the compiler to digest GetTestSql. First we need to explain to the compiler the structure of our database. In the future, you will write a program that, looking at the database structure, will generate in our case the following:

 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; 

And finally, the UKSqlBulder source code:

 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; 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) // MaxLength: Integer; not used 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.