unit1.pas

罗小平<<delphi精要>>一书源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TArrayResult = Array[0..1] of Integer;
  TSQL = record
    SQL,
    Fields,
    TableName,
    Condition,
    OrderBy,
    GroupBy: String;
  end;     

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses FundAndProc;

{$R *.dfm}

//分析SQL语句。传入Query.SQL
function GetSubSQL(SQL: TStrings): TSQL;
var
  I,J: Integer;
  KeyList: TStrings;
  S,S1: String;
  R: TSQL;
  function GetByPos(Text: String; Mode: Word): TArrayResult;
  var
    I,J,K: Integer;
    Key1,Key2,S: String;
  begin
    case Mode of
      1: Key1 := ' GROUP ';
      2: Key1 := ' ORDER ';
    else Exit;
    end;
    Key2 := ' BY ';

    I := Pos(Key1,UpperCase(Text));
    K := 0;
    if I > 0 then
    begin
      J := I + Length(Key1)-1;
      S := Copy(Text,J,Length(Text)-J+1);
      Key2 := ' BY ';
      K := Pos(Key2,UpperCase(S));
      if K = 0 then I := 0
      else Inc(K,Length(Text)-Length(S)+Length(Key2));
    end;
    Result[0] := I;
    Result[1] := K;
  end;
begin
  S := Trim(StringsToString(Chr($20),SQL));

  KeyList := TStringList.Create;
  KeyList.Add('SELECT ');
  KeyList.Add(' FROM ');
  KeyList.Add(' WHERE ');

  //字段
  I := Length(KeyList[0]) + 1;
  J := Pos(KeyList[1],UpperCase(S));
  R.Fields := Trim(Copy(S,I,J-I));
  //表名
  I := Pos(KeyList[1],UpperCase(S)) + Length(KeyList[1]);
  S1 := TrimLeft(Copy(S,I,Length(S)));
  J := Pos(' ',S1);
  if J > 0 then S1 := Trim(Copy(S1,1,J-1))
  else S1 := Trim(S1);
  R.TableName := S1;
  //条件
  I := Pos(KeyList[2],UpperCase(S));
  if I > 0 then
  begin
    Inc(I,Length(KeyList[2]));
    J := GetByPos(S,1)[0];
    if J = 0 then J := GetByPos(S,2)[0];
    if J > 0 then S1 := Trim(Copy(S,I,J-I))
    else S1 := Trim(Copy(S,I,Length(S)));
  end else S1 := '';
  R.Condition := S1;
  //分组字段
  I := GetByPos(S,1)[1];
  if I > 0 then
  begin
    J := GetByPos(S,2)[0];
    if J > 0 then S1 := Trim(Copy(S,I,J-I))
    else S1 := Trim(Copy(S,I,Length(S)));
  end else S1 := '';
  R.GroupBy := S1;
  //排序字段
  I := GetByPos(S,2)[1];
  if I > 0 then S1 := Trim(Copy(S,I,Length(S)))
  else S1 := '';
  R.OrderBy := S1;
  //全部
  R.SQL := 'SELECT ' + R.Fields + ' FROM ' + R.TableName;
  if R.Condition <> '' then R.SQL := R.SQL + ' WHERE ' + R.Condition;
  if R.GroupBy <> '' then R.SQL := R.SQL + ' GROUP BY ' + R.GroupBy;
  if R.OrderBy <> '' then R.SQL := R.SQL + ' ORDER BY ' + R.OrderBy;

  FreeAndNil(KeyList);
  Result := R;
end;

function SetSQL(SQL: TSQL): String;
begin
  with SQL do
  begin
    Result := 'SELECT ' + Fields + ' FROM ' + TableName;
    if Trim(Condition) <> '' then Result := Result + ' WHERE ' + Trim(Condition);
    if Trim(GroupBy) <> '' then Result := Result + ' GROUP BY ' + Trim(GroupBy);
    if Trim(OrderBy) <> '' then Result := Result + ' ORDER BY ' + Trim(OrderBy);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SQL: TStrings;
  R: TSQL;
  S: String;
begin
  SQL := TStringList.Create;
  SQL.Add(' SELECT name,sex FROM BlueSky WHERE age>100 GROUP BY sex ORDER BY age');
  R := GetSubSQL(SQL);
  with R do
    S := 'ALL：' + R.SQL + #13 +
         'SELECT：' + Fields + #13 +
         'FROM：' + TableName + #13 +
         'WHERE：' + Condition + #13 +
         'GROUP BY：' + GroupBy + #13 +
         'ORDER BY：' + OrderBy;
  ShowMessage(S);
  FreeAndNil(SQL);
end;

end.