dbcommon.pas

这是不可多得的源代码

      end;
      '.':
      begin
        if Assigned(TokenStart) then
        begin
          SetString(Token, TokenStart, p - TokenStart);
          Result := stTableName;
          Exit;
        end else
        begin
          DotStart := True;
          Inc(p);
        end;
      end;
      '=','<','>':
      begin
        if not Assigned(TokenStart) then
        begin
          TokenStart := p;
          while p^ in ['=','<','>'] do Inc(p);
          SetString(Token, TokenStart, p - TokenStart);
          Result := stPredicate;
          Exit;
        end;
        Inc(p);
      end;
      '0'..'9':
      begin
        if not Assigned(TokenStart) then
        begin
          TokenStart := p;
          while p^ in ['0'..'9','.'] do Inc(p);
          SetString(Token, TokenStart, p - TokenStart);
          Result := stNumber;
          Exit;
        end else
          Inc(p);
      end;
      #0:
      begin
        if Assigned(TokenStart) then
        begin
          SetString(Token, TokenStart, p - TokenStart);
          Result := GetSQLToken(Token);
          Exit;
        end else
        begin
          Result := stEnd;
          Token := '';
          Exit;
        end;
      end;
    else
      StartToken;
      Inc(p);
    end;
  end;
end;

function AddParamSQLForDetail(Params: TParams; SQL: string; Native: Boolean; QuoteChar: string = ''): string;
const
  SWhere = ' where ';     { do not localize }
  SAnd = ' and ';         { do not localize }

  function GenerateParamSQL: string;  
  var
    I: Integer;
    ParamName: string;
  begin
    for I := 0 to Params.Count -1 do
    begin
      if QuoteChar = '"' then
        ParamName := '"' + StringReplace(Params[I].Name, '"', '""', [rfReplaceAll] ) + '"'
      else
        ParamName := QuoteChar + Params[I].Name +QuoteChar;
      if I > 0 then Result := Result + SAnd;
      if Native then
        Result := Result + format('%s = ?', [ParamName])
      else
        Result := Result + format('%s = :%s', [ParamName, ParamName]);
    end;
    if pos(SWhere, LowerCase(Result)) > 0 then
      Result := SAnd + Result
    else
      Result := SWhere + Result;
  end;

  function AddWhereClause: string;
  var
    Start: PChar;
    Rest, FName: string;
    SQLToken, CurSection: TSQLToken;
  begin
    Start := PChar(SQL);
    CurSection := stUnknown;
    repeat
      SQLToken := NextSQLToken(Start, FName, CurSection);
    until SQLToken in [stFrom, stEnd];
    if SQLToken = stFrom then
      NextSQLToken(Start, FName, CurSection);
    Rest := string(Start);
    if Rest = '' then
      Result := SQL + ' ' + GenerateParamSQL
    else
      Result := Copy(SQL, 1, pos(Rest, SQL)) + ' ' + GenerateParamSQL + Rest;
  end;

begin
  Result := SQL;
  if (Params.Count > 0) then
    Result := AddWhereClause;
end;

// SQL might be a direct tablename;
function GetTableNameFromQuery(const SQL: string): string;
begin
  if pos( 'select', lowercase(SQL) ) < 1 then
    Result := SQL
  else
    Result := GetTableNameFromSQL(SQL);
end;

function GetTableNameFromSQL(const SQL: string): string;
var
  Start: PChar;
  Token: string;
  SQLToken, CurSection: TSQLToken;
begin
  Result := '';
  Start := PChar(SQL);
  CurSection := stUnknown;
  repeat
    SQLToken := NextSQLToken(Start, Token, CurSection);
    if SQLToken in SQLSections then CurSection := SQLToken;
  until SQLToken in [stEnd, stFrom];
  if SQLToken = stFrom then
  begin
    repeat
      SQLToken := NextSQLToken(Start, Token, CurSection);
      if SQLToken in SQLSections then
        CurSection := SQLToken else
      // stValue is returned if TableNames contain quote chars.
      if (SQLToken = stTableName) or (SQLToken = stValue) then
      begin
        Result := Token;
        while (Start[0] = '.') and not (SQLToken in [stEnd]) do
        begin
          SQLToken := NextSqlToken(Start, Token, CurSection);
          Result := Result + '.' + Token;
        end;
        Exit;
      end;
    until (CurSection <> stFrom) or (SQLToken in [stEnd, stTableName]);
  end;
end;

function IsMultiTableQuery(const SQL: string): Boolean;
const
  SInnerJoin = 'inner join ';       { do not localize }
  SOuterJoin = 'outer join ';       { do not localize }
var
  Start: PChar;
  SResult, Token: string;
  SQLToken, CurSection: TSQLToken;
begin
  SResult := '';
  Start := PChar(SQL);
  CurSection := stUnknown;
  Result := True;
  repeat
    SQLToken := NextSQLToken(Start, Token, CurSection);
    if SQLToken in SQLSections then CurSection := SQLToken;
  until SQLToken in [stEnd, stFrom];
  if SQLToken = stFrom then
  begin
    repeat
      SQLToken := NextSQLToken(Start, Token, CurSection);
      if SQLToken in SQLSections then
        CurSection := SQLToken else
      // stValue is returned if TableNames contain quote chars.
      if (SQLToken = stTableName) or (SQLToken = stValue) then
      begin
        SResult := Token;
        while (Start[0] = '.') and not (SQLToken in [stEnd]) do
        begin
          SQLToken := NextSqlToken(Start, Token, CurSection);
          SResult := SResult + '.' + Token;
        end;
        if (Start[0] = ',') or (Start[1] = ',') then
          exit;
        NextSqlToken(Start, Token, CurSection);
        if Assigned(AnsiStrPos(Start, PChar(SInnerJoin))) or
           Assigned(AnsiStrPos(Start, PChar(SOuterJoin))) then
          Exit;
        SQLToken := NextSqlToken(Start, Token, CurSection);
        if SQLToken = stTableName then
          Exit;
        Result := False;
        Exit;
      end;
    until (CurSection <> stFrom) or (SQLToken in [stEnd, stTableName]);
  end;
end;

function GetIndexForOrderBy(const SQL: string; DataSet: TDataSet): TIndexDef;

  function AddField(const Fields, NewField: string): string;
  begin
    Result := Fields;
    if Fields <> '' then
      Result := Fields + ';' + NewField else
      Result := NewField;
  end;

var
  Start: PChar;
  Token, LastField, SaveField: string;
  SQLToken, CurSection: TSQLToken;
  FieldIndex: Integer;
begin
  Result := nil;
  Start := PChar(SQL);
  CurSection := stUnknown;
  repeat
    SQLToken := NextSQLToken(Start, Token, CurSection);
    if SQLToken in SQLSections then CurSection := SQLToken;
  until SQLToken in [stEnd, stOrderBy];
  if SQLToken = stOrderBy then
  begin
    Result := TIndexDef.Create(nil);
    try
      LastField := '';
      repeat
        SQLToken := NextSQLToken(Start, Token, CurSection);
        if SQLToken in SQLSections then
          CurSection := SQLToken else
          case SQLToken of
            stTableName: ;
            stFieldName:
            begin
              LastField := Token;
              { Verify that we parsed a valid field name, not something like "UPPER(Foo)" }
              if not Assigned(Dataset.FindField(LastField)) then continue;
              Result.Fields := AddField(Result.Fields, LastField);
              SaveField := LastField;
            end;
            stAscending: ;
            stDescending:
              Result.DescFields := AddField(Result.DescFields, SaveField);
            stNumber:
            begin
              FieldIndex := StrToInt(Token);
              if DataSet.FieldCount >= FieldIndex then
                LastField := DataSet.Fields[FieldIndex - 1].FieldName else
              if DataSet.FieldDefs.Count >= FieldIndex then
                LastField := DataSet.FieldDefs[FieldIndex - 1].Name
              else
                { DB2 specific syntax "FETCH FIRST n ROWS ONLY" is blocked here,
                  so commenting out the following line }
                //SysUtils.Abort;
                continue;
              Result.Fields := AddField(Result.Fields, LastField);
            end;
          end;
      until (CurSection <> stOrderBy) or (SQLToken = stEnd);
    finally
      if Result.Fields = '' then
      begin
        Result.Free;
        Result := nil;
      end;  
    end;
  end;
end;

function GetFieldInfo(const Origin: string; var FieldInfo: TFieldInfo): Boolean;
var
  Current: PChar;
  Values: array[0..4] of string;
  I: Integer;

  function GetPChar(const S: string): PChar;
  begin
    if S <> '' then Result := PChar(Pointer(S)) else Result := '';
  end;

  procedure Split(const S: string);
  begin
    Current := PChar(Pointer(S));
  end;

  function NextItem: string;
  var
    C: PChar;
    I: PChar;
    Terminator: Char;
    Ident: array[0..1023] of Char;
  begin
    Result := '';
    C := Current;
    I := Ident;
    while C^ in ['.',' ',#0] do
      if C^ = #0 then Exit else Inc(C);
    Terminator := '.';
    if C^ = '"' then
    begin
      Terminator := '"';
      Inc(C);
    end;
    while not (C^ in [Terminator, #0]) do
    begin
      if C^ in LeadBytes then
      begin
        I^ := C^;
        Inc(C);
        Inc(I);
      end
      else if C^ = '\' then
      begin
        Inc(C);
        if C^ in LeadBytes then
        begin
          I^ := C^;
          Inc(C);
          Inc(I);
        end;
        if C^ = #0 then Dec(C);
      end;
      I^ := C^;
      Inc(C);
      Inc(I);
    end;
    SetString(Result, Ident, I - Ident);
    if (Terminator = '"') and (C^ <> #0) then Inc(C);
    Current := C;
  end;

  function PopValue: PChar;
  begin
    if I >= 0 then
    begin
      Result := GetPChar(Values[I]);
      Dec(I);
    end else Result := '';
  end;

begin
  Result := False;
  if (Origin = '') then Exit;
  Split(Origin);
  I := -1;
  repeat
    Inc(I);
    Values[I] := NextItem;
  until (Values[I] = '') or (I = High(Values));
  if I = High(Values) then Exit;
  Dec(I);
  FieldInfo.OriginalFieldName := StrPas(PopValue);
  FieldInfo.TableName := StrPas(PopValue);
  FieldInfo.DatabaseName := StrPas(PopValue);
  Result := (FieldInfo.OriginalFieldName <> '') and (FieldInfo.TableName <> '');
end;

const
  StringFieldTypes = [ftString, ftFixedChar, ftWideString, ftGuid];
  BlobFieldTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
    ftTypedBinary, ftOraBlob, ftOraClob];

function IsNumeric(DataType: TFieldType): Boolean;
begin
  Result := DataType in [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
    ftBCD, ftAutoInc, ftLargeint, ftFMTBcd];
end;

function IsTemporal(DataType: TFieldType): Boolean;
begin
  Result := DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp];
end;

{ TFilterExpr }

constructor TFilterExpr.Create(DataSet: TDataSet; Options: TFilterOptions;
  ParseOptions: TParserOptions; const FieldName: string; DepFields: TBits;
  FieldMap: TFieldMap);
begin
  FFieldMap := FieldMap;
  FDataSet := DataSet;
  FOptions := Options;
  FFieldName := FieldName;
  FParserOptions := ParseOptions;
  FDependentFields := DepFields;
end;

destructor TFilterExpr.Destroy;
var
  Node: PExprNode;
begin
  SetLength(FExprBuffer, 0);
  while FNodes <> nil do
  begin
    Node := FNodes;