sqltxtrtns.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2007 Devrace Ltd.                       }
{    Written by Serge Buzadzhy ([e-mail])               }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page: http://www.fibplus.com/                 }
{    FIBPlus support  : http://www.devrace.com/support/         }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}

unit SqlTxtRtns;

{$I FIBPlus.inc}

interface
uses
 SysUtils,Classes,StrUtil,
 {$IFDEF WINDOWS}
  Windows {$IFDEF D6+}, Variants{$ENDIF}
  ;

 {$ENDIF}
 {$IFDEF LINUX}
  Types , Variants;
 {$ENDIF}


type
  TSQLKind=(skUnknown,skSelect,skUpdate,skInsert,skDelete,skExecuteProc,skDDL,skExecuteBlock);
  TParserState =(sNormal,sQuote,sComment,sFBComment,sQuoteSingle);
  TOnScanSQLText = procedure(Position:integer;var StopScan:boolean) of object;
  TChars = set of Char;

  TSQLSection = (stUnknown,stSelect, stFields,
    stUpdate,stInsert,stDelete,stExecute, stSet, stComment,
    stFrom, stWhere, stGroupBy, stHaving,
    stUnion,    stPlan, stOrderBy, stForUpdate
  );


  TSQLSections = array of TSQLSection;

  TSQLParser  = class
  private
   FState  :TParserState;
   FCurPos :integer;
   FResultPos:integer;
   FBracketOpened:integer;
   FSQLText:string;
   FLen: integer;
   FReserved : integer;
   FReserved1: integer;
   FScanInBrackets:boolean;
   FFirstPos   :integer;
   FSQLKind    :TSQLKind;
   FCanParamsCheck:boolean;
   FTables     :TStrings;
   FBracketOpenedBeforeScan:integer;
   procedure   SetSQLText(const Value: string);
   function    IsClause(Position:integer;const Clause:string):boolean;
   function    GetSQLKind:TSQLKind;
  protected
    procedure  IsOrderBegin(Position:integer;var Yes:boolean);
    procedure  IsGroupBegin(Position:integer;var Yes:boolean);
    procedure  IsByBegin(Position:integer;var Yes:boolean);
    procedure  IsHaving(Position:integer;var Yes:boolean);
    procedure  IsMainOrderBegin(Position:integer;var Yes:boolean);
    procedure  IsMainGroupBegin(Position:integer;var Yes:boolean);    
    procedure  IsFromBegin(Position:integer;var Yes:boolean);
    procedure  IsWhereBegin(Position:integer;var Yes:boolean);
    procedure  IsWhereEnd(Position:integer;var Yes:boolean);

    procedure  IsMainWhereBegin(Position:integer;var Yes:boolean);
    procedure  IsMainFromBegin(Position:integer;var Yes:boolean);
    procedure  IsFromEnd(Position:integer;var Yes:boolean);
    procedure  IsPlanBegin(Position:integer;var Yes:boolean);
    procedure  IsPlanEnd(Position:integer;var Yes:boolean);
    procedure  IsSetBegin(Position:integer;var Yes:boolean);
    procedure  IsIntoBegin(Position:integer;var Yes:boolean);
    procedure  IsUpdateBegin(Position:integer;var Yes:boolean);

    function   IsSelect(Position:integer):boolean;
    function   IsUpdate(Position:integer):boolean;
    function   IsDelete(Position:integer):boolean;
    function   IsInsert(Position:integer):boolean;
    function   IsExecute(Position:integer):boolean;
    function   IsExecuteProc(Position:integer):boolean;
    function   IsExecuteBlock(Position:integer):boolean;

    function   IsDDL:boolean;
    procedure  FillMainTables(WithSP:boolean=False);
  public
   constructor Create; overload;
   constructor Create(const aSQLText:string); overload;
   destructor  Destroy; override;
   procedure   ScanText(FromPosition:integer;Proc:TOnScanSQLText);

   function    PosInSections(Position:integer):TSQLSections; overload;
   function    PosInSections(ScanFrom,Position:integer; var EndScan:integer):TSQLSections; overload;

   function    DispositionMainFrom:TPoint;
   function    MainFrom:string;
   function    ModifiedTables:string;

   function    OrderText(var StartPos,EndPos:integer):string;
   function    OrderClause:string;
   function    SetOrderClause(const Value:string):string;
   function    GetOrderInfo:Variant;
   function    GroupByText(var StartPos,EndPos:integer):string;
   function    GroupByClause:string;
   function    SetGroupClause(const Value:string):string;

   function    GetFieldsClause:string;
   function    SetFieldsClause(const NewFields:string):string;

   function    WhereClause(N:integer;var  StartPos,EndPos:integer):string;
   function    SetWhereClause(N:Integer;const Value:string):string;
   function    SetMainWhereClause(const Value:string):string;
   function    MainWhereClause(var  StartPos,EndPos:integer):string;
   function    WhereCount:integer;
   function    MainWhereIndex:integer;
   function    AddToMainWhere(const NewClause:string;ForceCLRF:boolean = True):string;

   function    PlanCount:integer;
   function    PlanText(N:integer;var  StartPos,EndPos:integer):string;

   function    MainPlanIndex:integer;
   function    MainPlanText(var  StartPos,EndPos:integer):string;
   function    SetMainPlan(const Text:string):string;
   function    GetMainPlan:string;

   function    RecCountSQLText:string;
   function    GetAllTables(WithSP:boolean=False):TStrings;
  public
   property    SQLText:string read FSQLText write SetSQLText;
   property    Len :integer read FLen write FLen;
   property    FirstPos   :integer read FFirstPos;
   property    MainPlanClause:string   read GetMainPlan ;
   property    SQLKind :TSQLKind read FSQLKind;
   property    CanParamsCheck:boolean read FCanParamsCheck;
  end;

const
   SpaceStr='    ';
   ForceNewStr=#13#10+SpaceStr;
   QuotMarks=#39;

 function  DispositionFrom(const SQLText:string):TPoint;
 procedure AllSQLTables(SQLText:string;aTables:TStrings; WithSP:boolean=False
 ;WithAliases:boolean =False
 );
 procedure AllTables(const SQLText:string;aTables:TStrings; WithSP:boolean =False
  ;WithAliases:boolean =False
 );

 function  TableByAlias(const SQLText,Alias:string):string;
 function  AliasForTable(const SQLText,TableName:string):string;

 function  FullFieldName(const SQLText,aFieldName:string):string;
 function  FieldNameFromSelect(const SQLText, FieldName: String):String;
 function  AddToWhereClause(const SQLText,NewClause:string;
  ForceCLRF:boolean  = True
 ):string;
 function  GetWhereClause(const SQLText:string;N:integer;var
   StartPos,EndPos:integer
 ):string;
 function  WhereCount(SQLText:string):integer;
 function  MainWhereIndex(const SQLText:string):integer;
 function  MainFrom(const SQLText:string):string;
 function  MainWhereClause(const SQLText:string):string;
 function  GetOrderInfo(const SQLText:string):variant;
 function  OrderStringTxt(const SQLText:string;
  var StartPos,EndPos:integer
 ):String;

 function  SetOrderClause(const SQLText,NewClause:string):string;
 procedure SetOrderString(SQLText:TStrings;const OrderTxt:string);
//

 function  PrepareConstraint(Src:Tstrings):string;

{ procedure NormalizeSQLText(const SQL: string;MacroChar:Char;
  var NSQL:string
 );

 }
 function  CountSelect(const SrcSQL:string):string;
 function  FieldsClause(const SrcSQL:string):string;
 function  GetModifyTable(const SQLText:string;WithAlias:boolean=False):string;
 function  GetSQLKind(const SQLText:string):TSQLKind;
//

 function  GetLinkFieldName(const SQLText,ParamName: string): string;
 function  GetFieldByAlias(const SQLText,FieldName:string):string;
 function  IsWhereBeginPos(const SQLText:string;Position:integer):boolean;
 function  IsWhereEndPos(const SQLText:string;Position:integer):boolean;
 function  PosInSections(const SQLText:string;Position:integer):TSQLSections;

 function  InvertOrderClause(const OrderText:string):string;
 function  IsEquelSQLNames(const Name1,Name2:string):boolean;

 function CutTableName(const SQLString:string;AliasPosition:integer=0):string;
 function CutAlias(const SQLString:string;AliasPosition:integer=0):string;
 function PosAlias(const SQLString:string):integer;
 function FieldNameForSQL(const TableAlias,FieldName:string):string;

const
  CharsAfterClause =[' ',#13,#9,#10,#0,';','(','/','-','"'];
//  CharsAfterClause =[' ',#13,#9,#10,#0,';','(','/','-'];
  CharsBeforeClause=[' ',#10,')',#9,#13,'"'];
  endLexem=['+',')','(','*','/','|',',','=','>','<','-','!','^','~',',',';'];
  IBStdCharSetsCount=61;
  IBStdCollationsCount=136;
  UnknownStr='UNKNOWN';

 IBStdCharacterSets:array [0..IBStdCharSetsCount-1] of string =
  ('NONE','OCTETS','ASCII','UNICODE_FSS','UTF8','SJIS_0208',
   'EUCJ_0208',UnknownStr,UnknownStr,
   'DOS737','DOS437','DOS850','DOS865','DOS860',
   'DOS863', 'DOS775','DOS858','DOS862','DOS864','NEXT',UnknownStr,'ISO8859_1',
   'ISO8859_2','ISO8859_3',
    UnknownStr,UnknownStr,UnknownStr,UnknownStr,UnknownStr,UnknownStr,
    UnknownStr,UnknownStr,UnknownStr,UnknownStr,
   'ISO8859_4','ISO8859_5','ISO8859_6',
   'ISO8859_7','ISO8859_8','ISO8859_9','ISO8859_13',
   UnknownStr,UnknownStr,UnknownStr,
   'KSC_5601','DOS852','DOS857','DOS861','DOS866',
   'DOS869','CYRL','WIN1250','WIN1251','WIN1252','WIN1253',
   'WIN1254','BIG_5','GB_2312','WIN1255','WIN1256','WIN1257'
);


function ParseMacroString(const MacroString:string; aMacroChar:Char;var DefValue:string):string ;
function PosClause(const Clause,SQLText:string):integer;

const
  BeginWhere =' WHERE ';

implementation


procedure SkipCommentsAndBlanks(const SQLText:string;Len:integer; var Position:integer);
begin
 while (Position<Len) and
  (SQLText[Position] in CharsAfterClause-['"']) do
 begin
    while (Position<=Len) and(SQLText[Position] in (CharsAfterClause -['/','-','"']) ) do
      Inc(Position);
    if (Position<Len) and (SQLText[Position]='-') and (SQLText[Position+1]='-') then
    begin
     while (Position<=Len) and not(SQLText[Position] in [#13,#10]) do
      Inc(Position);
    end;
    if (Position<Len) and(SQLText[Position]='/') and (SQLText[Position+1]='*') then
    begin
     Inc(Position,2);
     while (Position<Len) and not((SQLText[Position]='*') and (SQLText[Position+1]='/')) do
      Inc(Position);
     Inc(Position,2);
    end;
 end;
end;


function ParseMacroString(const MacroString:string; aMacroChar:Char;var DefValue:string):string ;
var
    PosDef:integer;
begin
// For FIBPlus Macro
   PosDef:=PosCh('%',MacroString);
   if PosDef=0 then
   begin
    if MacroString[1]=aMacroChar then
     Result:=MacroString
    else
     Result:=aMacroChar+MacroString;
   end
   else
   begin
     DoCopy(MacroString,Result,1,PosDef-1);
     DoCopy(MacroString,DefValue,PosDef+1,Length(MacroString)-PosDef);
     if MacroString[1] <> aMacroChar then Result := aMacroChar + Result
   end;
end;

function PosClause(const Clause,SQLText:string):integer;
begin
 Result:=PosExtCI(Clause,SQLText,CharsBeforeClause,CharsAfterClause,False);
end;

function IsEquelSQLNames(const Name1,Name2:string):boolean;
begin
  if (Length(Name1)>0) and (Length(Name2)>0) then
  begin
   case Name1[1] of
       '"':
       if Name2[1]<>'"' then
       begin
        Result:=FastCopy(Name1,2,Length(Name1)-2)=FastUpperCase(Name2)
       end
       else
        Result:=Name1=Name2
   else // else case
       if Name2[1]='"' then
        Result:= ('"'+Name1+'"'=Name2) or
        ('"'+FastUpperCase(Name1)+'"'=Name2)
       else
// 枢恹麇