Foros Club Delphi - Crear consultas SQL en tiempo de ejecución

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:

Código Delphi [-]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:

Código:

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

Código Delphi [-]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.