Lepe
26-05-2007, 12:24:03
Esto no es una consulta, es más bien un aporte y quizás solicitar algo de ayuda para ir completando la clase.
Quizás haya algo mejor en la web, seguro, pero no he encontrado nada; en el poco tiempo que tenía construí esto, a ver que os parece.
Se trata de construir sqls en tiempo de ejecución (típico de toda pantalla de búsquedas) intentando que el código fuente sea más claro y por supuesto que sea más fácil.
Imaginad un código como este:
var s : TSelectStrings;
begin
s := TSelectStrings.Create;
s.AddToSection(pSelect, 'campo1, campo2');
s.AddToSection(pSelect, ', campo3');
s.AddToSection(pfrom, ' tabla1');
s.AddtoWhere(oAnd, 'campo1 > 3');
s.AddToWhere(oOr, 'Campo3 > 5');
query1.Sql.text := s.Text;
s.free;
El resultado de ese rollo sería tener en query1.sql.text el siguiente texto:
SELECT campo1, Campo2, campo3
FROM tabla1
WHERE campo1 > 3
or Campo3 > 5
En la parte Select y From no añade las comas automáticamente (es una mejor a que no he tenido tiempo de añadir).
Para consultas construidas en tiempo de ejecución, creo que sirve.
No está muy pulido el código, pero es usable. Quizás no implemente alguna que otra funcionalidad, pero se puede ampliar fácilmente... o eso espero ;).
uses dbtables, db,classes,sysutils;
type
// operadores para unir cada restricción del where
// oNull si se trata de la primera restricción que no lleva operador.
TOperator = (oAnd, oOr, oXor, oNull);
Tparts = (pSelect=0, pFrom, pWhere, pGroupBy, pHaving, pOrderBy);
TSections = set of Tparts;
{-------------------------------------------------------------------------------
Crear SQLs al vuelo con comodidad y formateo del codigo sql.
- Se añaden las palabras reservadas SELECT, FROM, WHERE, etc si no las tiene.
- Formateo del SQL al estilo:
SELECT campo1, Campo2, count(*)
FROM tabla1 innerjoin tabla 2 on tabla1.campo = tabla2.campo2 inner join [...]
WHERE campo1 = 3
and CAmpo2 = 3
or Campo3 = 32
GROUP BY Campo1
HAVING count(*)> 5
ORDER BY campo1
-------------------------------------------------------------------------------}
TSelectStrings = Class(TObject)
private
Fsql:TStringList;
FWhere:TStringList;
FSections:TSections;
FFormatted: Boolean;
function GetText: string;
procedure SetText(const Value: string);
function GetWhereValues(): string;
protected
function InternalGetText():string;virtual;
public
constructor Create;
destructor Destroy; override;
procedure AddSection(Which:TParts; const str:string);
procedure AddToWhere(TheOperator :TOperator; const Restriction:string);
procedure DeleteSection (Which:TParts);
procedure AddToSection (Which:TParts; const str:string);
function GetSection (Which:TParts):string;
property Sections: TSections read FSections write FSections;// section in the actual Fsql
published
property Text :string read GetText write SetText;
property FormattedSQL:Boolean read FFormatted write FFormatted default true;
end;
implementation
uses strUtils;
const saltolinea = #13#10;
const const_Forbiden = 'Forbidden use of AddToSection: Use AddToWhere instead';
var
tkSELECT : array [TParts] of string = ('SELECT ', 'FROM ', 'WHERE ', 'GROUP BY ','HAVING ', 'ORDER BY ');
// (1 , 30 , 35 , 0 , 0 , 50 );
OperatorString : array [Toperator] of string = (' and ', ' or ', ' xor ', ' WHERE ');
{ TSelectStrings }
constructor TSelectStrings.Create;
begin
Fsql := TStringList.Create;
FWhere := TStringList.Create;
FWhere.CaseSensitive:= False;
FSections := [];
FFormatted := True;
inherited;
end;
procedure TSelectStrings.DeleteSection(Which: TParts);
begin
if Which in FSections then
begin
if Which = pWhere then
FWhere.Clear
else
Fsql[Integer(Which)] := EmptyStr;
exclude(FSections, Which);
end;
end;
destructor TSelectStrings.Destroy;
begin
Fsql.Free;
FWhere.Free;
inherited;
end;
function TSelectStrings.GetSection(Which: TParts): string;
begin
if Which in Sections then
begin
if Which = pWhere then
Result := GetWhereValues()
else
Result := Fsql[Integer(Which)];
end
else
Result := EmptyStr;
end;
function TSelectStrings.GetWhereValues():string;
var i:Integer;
begin
Result:= EmptyStr;
for i := 0 to FWhere.count - 1 do
begin
Result := Result + FWhere[i];
if FFormatted then
Result := Result + saltolinea;
end;
if FFormatted then
Result := AnsiReplaceText(Result,tkselect[pwhere],tkselect[pwhere]);
end;
function TSelectStrings.GetText: string;
begin
Result:= InternalGetText();
end;
procedure TSelectStrings.AddSection(Which:TParts; const str:string);
var part:string;
begin
if Which = pWhere then
raise Exception.Create(const_Forbiden);
part := trimleft(str);
// Si no lleva la palabra reservada (SELECT, FROM, HAVING, ORDER BY...) se añade.
if CompareText(tkselect[which], Copy(part,1,length(tkselect[which]))) <> 0 then
Fsql[Integer(Which)] := tkselect[which] + str
else
Fsql[Integer(Which)] := str;
include(FSections, Which);
end;
procedure TSelectStrings.AddToSection(Which:TParts; const str:string);
begin
if Which = pWhere then
raise Exception.Create(const_Forbiden);
if Which in FSections then
Fsql[Integer(Which)] := Fsql[Integer(Which)]+ espacio + str
else
AddSection(Which, str); // no error.
end;
procedure TSelectStrings.AddToWhere(TheOperator: TOperator;
const Restriction: string);
begin
if pWhere in FSections then
Fwhere.Add(stringofchar(' ',6)+ Operatorstring[Theoperator] + Restriction)
else
begin
if uppercase(Copy(trimLeft(Restriction),1,5))= 'WHERE ' then
FWhere.Add(Restriction)
else
FWhere.Add(OperatorString[oNull] + Restriction );
end;
include(Fsections, pWhere);
end;
function TSelectStrings.InternalGetText(): string;
var i:Integer;
begin
Result:= EmptyStr;
for i := 0 to Fsql.Count - 1 do
begin
if Fsql[i] <> EmptyStr then
begin
if FFormatted then
begin
Result:= Result + AnsiReplaceText(Fsql[i],tkSelect[tparts(i)], tkSelect[tparts(i)]);
Result := Result + SALTOLINEA;
end
else
Result:= Result + Fsql[i];
end;
if (i = integer(pwhere)) and ( pWhere in FSections) then
Result:= Result + GetWhereValues();
end;
end;
procedure TSelectStrings.SetText(const Value: string);
var
PriorPos: Integer;
strUpper:string;
idxs:array [Tparts] of Integer; // Pos de cada Parte del SQL
i: Tparts;
begin
Fsql.BeginUpdate;
Fsql.Clear;
FWhere.Clear;
FSections := [];
try
PriorPos := 1;
strUpper := uppercase(Value);
for I := low(TParts) to High(Tparts) do
begin
idxs[i] :=PosEx(tkselect[i],strUpper,PriorPos);
if idxs[i] <> 0 then
PriorPos := idxs[i];
end;
PriorPos := Length(Value);
if (pos(saltolinea,Value)= PriorPos -2) then // LAST $D$A
Dec(PriorPos,2);
for i := high(Tparts) downto low(TParts) do
if idxs[i] <> 0 then
begin
Fsql.Insert(0,Copy(Value,idxs[i], PriorPos-idxs[i]+1));
include(FSections, i);
PriorPos := idxs[i]-1;
end
else
Fsql.Insert(0,''); // we include always all sections in Fsql
if pWhere in FSections then
begin
AddToWhere(oNull, Fsql[Integer(pWhere)]);
Fsql[Integer(pWhere)]:= EmptyStr;
end;
finally
Fsql.EndUpdate;
end;
end;
end.
PD: Se admiten críticas de todo tipo ;)
Saludos.
Quizás haya algo mejor en la web, seguro, pero no he encontrado nada; en el poco tiempo que tenía construí esto, a ver que os parece.
Se trata de construir sqls en tiempo de ejecución (típico de toda pantalla de búsquedas) intentando que el código fuente sea más claro y por supuesto que sea más fácil.
Imaginad un código como este:
var s : TSelectStrings;
begin
s := TSelectStrings.Create;
s.AddToSection(pSelect, 'campo1, campo2');
s.AddToSection(pSelect, ', campo3');
s.AddToSection(pfrom, ' tabla1');
s.AddtoWhere(oAnd, 'campo1 > 3');
s.AddToWhere(oOr, 'Campo3 > 5');
query1.Sql.text := s.Text;
s.free;
El resultado de ese rollo sería tener en query1.sql.text el siguiente texto:
SELECT campo1, Campo2, campo3
FROM tabla1
WHERE campo1 > 3
or Campo3 > 5
En la parte Select y From no añade las comas automáticamente (es una mejor a que no he tenido tiempo de añadir).
Para consultas construidas en tiempo de ejecución, creo que sirve.
No está muy pulido el código, pero es usable. Quizás no implemente alguna que otra funcionalidad, pero se puede ampliar fácilmente... o eso espero ;).
uses dbtables, db,classes,sysutils;
type
// operadores para unir cada restricción del where
// oNull si se trata de la primera restricción que no lleva operador.
TOperator = (oAnd, oOr, oXor, oNull);
Tparts = (pSelect=0, pFrom, pWhere, pGroupBy, pHaving, pOrderBy);
TSections = set of Tparts;
{-------------------------------------------------------------------------------
Crear SQLs al vuelo con comodidad y formateo del codigo sql.
- Se añaden las palabras reservadas SELECT, FROM, WHERE, etc si no las tiene.
- Formateo del SQL al estilo:
SELECT campo1, Campo2, count(*)
FROM tabla1 innerjoin tabla 2 on tabla1.campo = tabla2.campo2 inner join [...]
WHERE campo1 = 3
and CAmpo2 = 3
or Campo3 = 32
GROUP BY Campo1
HAVING count(*)> 5
ORDER BY campo1
-------------------------------------------------------------------------------}
TSelectStrings = Class(TObject)
private
Fsql:TStringList;
FWhere:TStringList;
FSections:TSections;
FFormatted: Boolean;
function GetText: string;
procedure SetText(const Value: string);
function GetWhereValues(): string;
protected
function InternalGetText():string;virtual;
public
constructor Create;
destructor Destroy; override;
procedure AddSection(Which:TParts; const str:string);
procedure AddToWhere(TheOperator :TOperator; const Restriction:string);
procedure DeleteSection (Which:TParts);
procedure AddToSection (Which:TParts; const str:string);
function GetSection (Which:TParts):string;
property Sections: TSections read FSections write FSections;// section in the actual Fsql
published
property Text :string read GetText write SetText;
property FormattedSQL:Boolean read FFormatted write FFormatted default true;
end;
implementation
uses strUtils;
const saltolinea = #13#10;
const const_Forbiden = 'Forbidden use of AddToSection: Use AddToWhere instead';
var
tkSELECT : array [TParts] of string = ('SELECT ', 'FROM ', 'WHERE ', 'GROUP BY ','HAVING ', 'ORDER BY ');
// (1 , 30 , 35 , 0 , 0 , 50 );
OperatorString : array [Toperator] of string = (' and ', ' or ', ' xor ', ' WHERE ');
{ TSelectStrings }
constructor TSelectStrings.Create;
begin
Fsql := TStringList.Create;
FWhere := TStringList.Create;
FWhere.CaseSensitive:= False;
FSections := [];
FFormatted := True;
inherited;
end;
procedure TSelectStrings.DeleteSection(Which: TParts);
begin
if Which in FSections then
begin
if Which = pWhere then
FWhere.Clear
else
Fsql[Integer(Which)] := EmptyStr;
exclude(FSections, Which);
end;
end;
destructor TSelectStrings.Destroy;
begin
Fsql.Free;
FWhere.Free;
inherited;
end;
function TSelectStrings.GetSection(Which: TParts): string;
begin
if Which in Sections then
begin
if Which = pWhere then
Result := GetWhereValues()
else
Result := Fsql[Integer(Which)];
end
else
Result := EmptyStr;
end;
function TSelectStrings.GetWhereValues():string;
var i:Integer;
begin
Result:= EmptyStr;
for i := 0 to FWhere.count - 1 do
begin
Result := Result + FWhere[i];
if FFormatted then
Result := Result + saltolinea;
end;
if FFormatted then
Result := AnsiReplaceText(Result,tkselect[pwhere],tkselect[pwhere]);
end;
function TSelectStrings.GetText: string;
begin
Result:= InternalGetText();
end;
procedure TSelectStrings.AddSection(Which:TParts; const str:string);
var part:string;
begin
if Which = pWhere then
raise Exception.Create(const_Forbiden);
part := trimleft(str);
// Si no lleva la palabra reservada (SELECT, FROM, HAVING, ORDER BY...) se añade.
if CompareText(tkselect[which], Copy(part,1,length(tkselect[which]))) <> 0 then
Fsql[Integer(Which)] := tkselect[which] + str
else
Fsql[Integer(Which)] := str;
include(FSections, Which);
end;
procedure TSelectStrings.AddToSection(Which:TParts; const str:string);
begin
if Which = pWhere then
raise Exception.Create(const_Forbiden);
if Which in FSections then
Fsql[Integer(Which)] := Fsql[Integer(Which)]+ espacio + str
else
AddSection(Which, str); // no error.
end;
procedure TSelectStrings.AddToWhere(TheOperator: TOperator;
const Restriction: string);
begin
if pWhere in FSections then
Fwhere.Add(stringofchar(' ',6)+ Operatorstring[Theoperator] + Restriction)
else
begin
if uppercase(Copy(trimLeft(Restriction),1,5))= 'WHERE ' then
FWhere.Add(Restriction)
else
FWhere.Add(OperatorString[oNull] + Restriction );
end;
include(Fsections, pWhere);
end;
function TSelectStrings.InternalGetText(): string;
var i:Integer;
begin
Result:= EmptyStr;
for i := 0 to Fsql.Count - 1 do
begin
if Fsql[i] <> EmptyStr then
begin
if FFormatted then
begin
Result:= Result + AnsiReplaceText(Fsql[i],tkSelect[tparts(i)], tkSelect[tparts(i)]);
Result := Result + SALTOLINEA;
end
else
Result:= Result + Fsql[i];
end;
if (i = integer(pwhere)) and ( pWhere in FSections) then
Result:= Result + GetWhereValues();
end;
end;
procedure TSelectStrings.SetText(const Value: string);
var
PriorPos: Integer;
strUpper:string;
idxs:array [Tparts] of Integer; // Pos de cada Parte del SQL
i: Tparts;
begin
Fsql.BeginUpdate;
Fsql.Clear;
FWhere.Clear;
FSections := [];
try
PriorPos := 1;
strUpper := uppercase(Value);
for I := low(TParts) to High(Tparts) do
begin
idxs[i] :=PosEx(tkselect[i],strUpper,PriorPos);
if idxs[i] <> 0 then
PriorPos := idxs[i];
end;
PriorPos := Length(Value);
if (pos(saltolinea,Value)= PriorPos -2) then // LAST $D$A
Dec(PriorPos,2);
for i := high(Tparts) downto low(TParts) do
if idxs[i] <> 0 then
begin
Fsql.Insert(0,Copy(Value,idxs[i], PriorPos-idxs[i]+1));
include(FSections, i);
PriorPos := idxs[i]-1;
end
else
Fsql.Insert(0,''); // we include always all sections in Fsql
if pWhere in FSections then
begin
AddToWhere(oNull, Fsql[Integer(pWhere)]);
Fsql[Integer(pWhere)]:= EmptyStr;
end;
finally
Fsql.EndUpdate;
end;
end;
end.
PD: Se admiten críticas de todo tipo ;)
Saludos.