Постановка задачи.
Имеется большой Клиент-Сервер проект. Клиент программно строит динамические 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.
Автор: SuvAlexander