Browse Source

* Implement macro support, by Zdravko Gabrovski (Bug ID 36057)

git-svn-id: trunk@43001 -
michael 5 years ago
parent
commit
15f999bcce

+ 5 - 0
packages/fcl-db/src/base/db.pas

@@ -1297,6 +1297,8 @@ type
   end;
 
 { TParams }
+  TSQLParseOption = (spoCreate,spoEscapeSlash,spoEscapeRepeat,spoUseMacro);
+  TSQLParseOptions = Set of TSQLParseOption;
 
   TParams = class(TCollection)
   private
@@ -1306,6 +1308,8 @@ type
     Procedure SetItem(Index: Integer; Value: TParam);
     Procedure SetParamValue(const ParamName: string; const Value: Variant);
   protected
+    Function CreateParseOpts(DoCreate, EscapeSlash, EscapeRepeat : Boolean) : TSQLParseOptions;
+    function DoParseSQL(SQL: String; Options : TSQLParseOptions; ParameterStyle: TParamStyle; out  ParamBinding: TParambinding; MacroChar: Char; out ReplaceString: string): String; virtual;
     Procedure AssignTo(Dest: TPersistent); override;
     Function  GetDataSet: TDataSet;
     Function  GetOwner: TPersistent; override;
@@ -1326,6 +1330,7 @@ type
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding): String; overload;
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding; out ReplaceString : string): String; overload;
+    function  ParseSQL(SQL: String; Options : TSQLParseOptions; ParameterStyle: TParamStyle; out ParamBinding: TParambinding; MacroChar: Char; out ReplaceString: string): String;
     Procedure RemoveParam(Value: TParam);
     Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
     Property Dataset : TDataset Read GetDataset;

+ 90 - 45
packages/fcl-db/src/base/dsparams.inc

@@ -44,27 +44,42 @@ end;
 
 { TParams }
 
-Function TParams.GetItem(Index: Integer): TParam;
+function TParams.GetItem(Index: Integer): TParam;
 begin
   Result:=(Inherited GetItem(Index)) as TParam;
 end;
 
-Function TParams.GetParamValue(const ParamName: string): Variant;
+function TParams.GetParamValue(const ParamName: string): Variant;
 begin
   Result:=ParamByName(ParamName).Value;
 end;
 
-Procedure TParams.SetItem(Index: Integer; Value: TParam);
+procedure TParams.SetItem(Index: Integer; Value: TParam);
 begin
   Inherited SetItem(Index,Value);
 end;
 
-Procedure TParams.SetParamValue(const ParamName: string; const Value: Variant);
+procedure TParams.SetParamValue(const ParamName: string; const Value: Variant);
 begin
   ParamByName(ParamName).Value:=Value;
 end;
 
-Procedure TParams.AssignTo(Dest: TPersistent);
+function TParams.CreateParseOpts(DoCreate, EscapeSlash, EscapeRepeat: Boolean): TSQLParseOptions;
+
+  Procedure SetO(B : Boolean; O : TSQLParseOption);
+
+  begin
+    if B then Include(Result,O);
+  end;
+
+begin
+  Result:=[];
+  SetO(DoCreate,spoCreate);
+  SetO(EscapeSlash,spoEscapeSlash);
+  SetO(EscapeRepeat,spoEscapeRepeat);
+end;
+
+procedure TParams.AssignTo(Dest: TPersistent);
 begin
  if (Dest is TParams) then
    TParams(Dest).Assign(Self)
@@ -72,7 +87,7 @@ begin
    inherited AssignTo(Dest);
 end;
 
-Function TParams.GetDataSet: TDataSet;
+function TParams.GetDataSet: TDataSet;
 begin
   If (FOwner is TDataset) Then
     Result:=TDataset(FOwner)
@@ -80,17 +95,17 @@ begin
     Result:=Nil;
 end;
 
-Function TParams.GetOwner: TPersistent;
+function TParams.GetOwner: TPersistent;
 begin
   Result:=FOwner;
 end;
 
-Class Function TParams.ParamClass: TParamClass;
+class function TParams.ParamClass: TParamClass;
 begin
   Result:=TParam;
 end;
 
-Constructor TParams.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass
+constructor TParams.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass
   );
 begin
   Inherited Create(AItemClass);
@@ -98,22 +113,22 @@ begin
 end;
 
 
-Constructor TParams.Create(AOwner: TPersistent);
+constructor TParams.Create(AOwner: TPersistent);
 begin
   Create(AOwner,ParamClass);
 end;
 
-Constructor TParams.Create;
+constructor TParams.Create;
 begin
   Create(TPersistent(Nil));
 end;
 
-Procedure TParams.AddParam(Value: TParam);
+procedure TParams.AddParam(Value: TParam);
 begin
   Value.Collection:=Self;
 end;
 
-Procedure TParams.AssignValues(Value: TParams);
+procedure TParams.AssignValues(Value: TParams);
 
 Var
   I : Integer;
@@ -129,7 +144,7 @@ begin
     end;
 end;
 
-Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
+function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
   ParamType: TParamType): TParam;
 
 begin
@@ -139,7 +154,7 @@ begin
   Result.ParamType:=ParamType;
 end;
 
-Function TParams.FindParam(const Value: string): TParam;
+function TParams.FindParam(const Value: string): TParam;
 
 Var
   I : Integer;
@@ -154,7 +169,7 @@ begin
       Dec(i);
 end;
 
-Procedure TParams.GetParamList(List: TList; const ParamNames: string);
+procedure TParams.GetParamList(List: TList; const ParamNames: string);
 
 Var
   P: TParam;
@@ -172,7 +187,7 @@ begin
   until StrPos > Length(ParamNames);
 end;
 
-Function TParams.IsEqual(Value: TParams): Boolean;
+function TParams.IsEqual(Value: TParams): Boolean;
 
 Var
   I : Integer;
@@ -187,45 +202,53 @@ begin
     end;
 end;
 
-Function TParams.GetEnumerator: TParamsEnumerator;
+function TParams.GetEnumerator: TParamsEnumerator;
 begin
   Result:=TParamsEnumerator.Create(Self);
 end;
 
-Function TParams.ParamByName(const Value: string): TParam;
+function TParams.ParamByName(const Value: string): TParam;
 begin
   Result:=FindParam(Value);
   If (Result=Nil) then
     DatabaseErrorFmt(SParameterNotFound,[Value],Dataset);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
+function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
 
-var pb : TParamBinding;
-    rs : string;
+var
+  pb : TParamBinding;
+  rs : string;
+  PO : TSQLParseOptions;
 
 begin
-  Result := ParseSQL(SQL,DoCreate,True,True,psInterbase, pb, rs);
+  PO:=CreateParseOpts(DoCreate,True,True);
+  Result := DoParseSQL(SQL,PO,psInterbase, pb, ' ',rs);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
+function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
   EscapeRepeat: Boolean; ParameterStyle: TParamStyle): String;
 
 var pb : TParamBinding;
     rs : string;
+    PO : TSQLParseOptions;
 
 begin
-  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
+  PO:=CreateParseOpts(DoCreate,EscapeSlash,EscapeRepeat);
+  Result := DoParseSQL(SQL,PO,ParameterStyle,pb,' ',rs);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
+function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
   EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
   ParamBinding: TParambinding): String;
 
-var rs : string;
+var
+  rs : string;
+  PO : TSQLParseOptions;
 
 begin
-  Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
+  PO:=CreateParseOpts(DoCreate,EscapeSlash, EscapeRepeat);
+  Result := DoParseSQL(SQL,PO, ParameterStyle,ParamBinding,' ',rs);
 end;
 
 function SkipComments(var p: PChar; EscapeSlash, EscapeRepeat : Boolean) : Boolean;
@@ -274,10 +297,28 @@ begin
   end; {case}
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
+
+function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
   EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
   ParamBinding: TParambinding; out ReplaceString: string): String;
 
+var
+  PO : TSQLParseOptions;
+
+begin
+  PO:=CreateParseOpts(DoCreate,EscapeSlash, EscapeRepeat);
+  Result:=DoParseSQL(SQL,PO,ParameterStyle,ParamBinding,' ',ReplaceString);
+end;
+
+function TParams.ParseSQL(SQL: String; Options: TSQLParseOptions; ParameterStyle: TParamStyle; out ParamBinding: TParambinding;
+  MacroChar: Char; out ReplaceString: string): String;
+begin
+  Result:=DoParseSQL(SQL,Options,ParameterStyle,ParamBinding,MacroChar,ReplaceString);
+end;
+
+function TParams.DoParseSQL(SQL: String; Options : TSQLParseOptions; ParameterStyle: TParamStyle; out
+  ParamBinding: TParambinding; MacroChar : Char; out ReplaceString: string): String;
+
 type
   // used for ParamPart
   TStringPart = record
@@ -299,11 +340,12 @@ var
   NewQueryLength:integer;
   NewQuery:string;
   NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
+  ParamDelim : Set of char;
   b:integer;
   tmpParam:TParam;
 
 begin
-  if DoCreate then Clear;
+  if spoCreate in Options then Clear;
   // Parse the SQL and build ParamBinding
   ParamCount:=0;
   NewQueryLength:=Length(SQL);
@@ -317,16 +359,19 @@ begin
 
   p:=PChar(SQL);
   BufStart:=p; // used to calculate ParamPart.Start values
+  if spoUseMacro in options then
+    ParamDelim:=[MacroChar]
+  else
+    ParamDelim:=[':','?'];
   repeat
-    while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
-    case p^ of
-      ':','?': // parameter
+    while SkipComments(p,spoEscapeSlash in Options ,spoEscapeRepeat in options) do ;
+    if p^ in ParamDelim then // parameter
         begin
           IgnorePart := False;
-          if p^=':' then
+          if (P^<>'?') then
           begin // find parameter name
             Inc(p);
-            if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
+            if p^ in [':','=',' '] then  // ignore ::, since some databases (postgres) uses this as a cast (wb 4813)
             begin
               IgnorePart := True;
               Inc(p);
@@ -336,7 +381,7 @@ begin
               if p^='"' then // Check if the parameter-name is between quotes
                 begin
                 ParamNameStart:=p;
-                SkipQuotesString(p,'"',EscapeSlash,EscapeRepeat);
+                SkipQuotesString(p,'"',spoEscapeSlash in Options,spoEscapeRepeat in Options);
                 // Do not include the quotes in ParamName, but they must be included
                 // when the parameter is replaced by some place-holder.
                 ParamName:=Copy(ParamNameStart+1,1,p-ParamNameStart-2);
@@ -367,7 +412,7 @@ begin
               SetLength(ParamBinding,NewLength);
             end;
 
-            if DoCreate then
+            if spoCreate in Options then
               begin
               // Check if this is the first occurance of the parameter
               tmpParam := FindParam(ParamName);
@@ -405,11 +450,12 @@ begin
             // update NewQueryLength
             Dec(NewQueryLength,p-ParamNameStart);
           end;
-        end;
-      #0:Break; // end of SQL
-    else
-      Inc(p);
-    end;
+        end
+      else
+        if P^ = #0 then
+          Break// end of SQL
+        else
+          Inc(p);
   until false;
 
   SetLength(ParamPart,ParamCount);
@@ -458,12 +504,11 @@ begin
   end
   else
     NewQuery:=SQL;
-
   Result := NewQuery;
 end;
 
 
-Procedure TParams.RemoveParam(Value: TParam);
+procedure TParams.RemoveParam(Value: TParam);
 begin
    Value.Collection:=Nil;
 end;
@@ -1199,7 +1244,7 @@ begin
 end;
 
 
-Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
+procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
   CopyBound: Boolean);
 
 Var

+ 199 - 19
packages/fcl-db/src/sqldb/sqldb.pp

@@ -78,7 +78,7 @@ const
   detRollBack    = sqltypes.detRollBack; 
   detParamValue  = sqltypes.detParamValue; 
   detActualSQL   = sqltypes.detActualSQL;
-
+  DefaultMacroChar     = '%';
 Type
   TRowsCount = LargeInt;
 
@@ -361,6 +361,9 @@ type
     FDatabase: TSQLConnection;
     FParamCheck: Boolean;
     FParams: TParams;
+    FMacroCheck: Boolean;
+    FMacroChar: Char;
+    FMacros: TParams;
     FSQL: TStrings;
     FOrigSQL : String;
     FServerSQL : String;
@@ -368,10 +371,15 @@ type
     FParseSQL: Boolean;
     FDataLink : TDataLink;
     FRowsAffected : TRowsCount;
+    function ExpandMacros( OrigSQL: String): String;
     procedure SetDatabase(AValue: TSQLConnection);
+    procedure SetMacroChar(AValue: Char);
+    procedure SetMacroCheck(AValue: Boolean);
     procedure SetParams(AValue: TParams);
+    procedure SetMacros(AValue: TParams);
     procedure SetSQL(AValue: TStrings);
     procedure SetTransaction(AValue: TSQLTransaction);
+    procedure RecreateMacros;
     Function GetPrepared : Boolean;
   Protected
     Function CreateDataLink : TDataLink; virtual;
@@ -398,9 +406,12 @@ type
     Property Transaction : TSQLTransaction Read FTransaction Write SetTransaction;
     Property SQL : TStrings Read FSQL Write SetSQL;
     Property Params : TParams Read FParams Write SetParams;
+    Property Macros : TParams Read FMacros Write SetMacros;
+    property MacroChar: Char read FMacroChar write SetMacroChar default DefaultMacroChar;
     Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
     Property ParseSQL : Boolean Read FParseSQL Write FParseSQL;
     Property ParamCheck : Boolean Read FParamCheck Write FParamCheck default true;
+    Property MacroCheck : Boolean Read FMacroCheck Write SetMacroCheck default false;
   Public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
@@ -418,6 +429,8 @@ type
     Property DataSource;
     Property ParamCheck;
     Property Params;
+    Property MacroCheck;
+    Property Macros;
     Property ParseSQL;
     Property SQL;
     Property Transaction;
@@ -484,8 +497,11 @@ type
     FDeleteQry           : TCustomSQLQuery;
     FSequence            : TSQLSequence;
     procedure FreeFldBuffers;
+    function GetMacroChar: Char;
     function GetParamCheck: Boolean;
     function GetParams: TParams;
+    function GetMacroCheck: Boolean;
+    function GetMacros: TParams;
     function GetParseSQL: Boolean;
     function GetServerIndexDefs: TServerIndexDefs;
     function GetSQL: TStringList;
@@ -493,8 +509,10 @@ type
     function GetSQLTransaction: TSQLTransaction;
     function GetStatementType : TStatementType;
     Function NeedLastInsertID: TField;
+    procedure SetMacroChar(AValue: Char);
     procedure SetOptions(AValue: TSQLQueryOptions);
     procedure SetParamCheck(AValue: Boolean);
+    procedure SetMacroCheck(AValue: Boolean);
     procedure SetSQLConnection(AValue: TSQLConnection);
     procedure SetSQLTransaction(AValue: TSQLTransaction);
     procedure SetInsertSQL(const AValue: TStringList);
@@ -502,6 +520,7 @@ type
     procedure SetDeleteSQL(const AValue: TStringList);
     procedure SetRefreshSQL(const AValue: TStringList);
     procedure SetParams(AValue: TParams);
+    procedure SetMacros(AValue: TParams);
     procedure SetParseSQL(AValue : Boolean);
     procedure SetSQL(const AValue: TStringList);
     procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
@@ -561,6 +580,7 @@ type
     procedure SetSchemaInfo( ASchemaType : TSchemaType; ASchemaObjectName, ASchemaPattern : string); virtual;
     function RowsAffected: TRowsCount; virtual;
     function ParamByName(Const AParamName : String) : TParam;
+    function MacroByName(Const AParamName : String) : TParam;
     Property Prepared : boolean read IsPrepared;
     Property SQLConnection : TSQLConnection Read GetSQLConnection Write SetSQLConnection;
     Property SQLTransaction: TSQLTransaction Read GetSQLTransaction Write SetSQLTransaction;
@@ -611,6 +631,9 @@ type
     Property Options : TSQLQueryOptions Read FOptions Write SetOptions default [];
     property Params : TParams read GetParams Write SetParams;
     Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
+    property Macros : TParams read GetMacros Write SetMacros;
+    Property MacroCheck : Boolean Read GetMacroCheck Write SetMacroCheck default false;
+    Property MacroChar : Char Read GetMacroChar Write SetMacroChar default DefaultMacroChar;
     property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode default upWhereKeyOnly;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
@@ -673,6 +696,9 @@ type
     Property Options;
     property Params;
     Property ParamCheck;
+    property Macros;
+    Property MacroCheck;
+    Property MacroChar;
     property ParseSQL;
     property UpdateMode;
     property UsePrimaryKeyAsKey;
@@ -891,6 +917,7 @@ var
 
 begin
   UnPrepare;
+  RecreateMacros;
   if not ParamCheck then
     exit;
   if assigned(DataBase) then
@@ -927,6 +954,20 @@ begin
     end;
 end;
 
+procedure TCustomSQLStatement.SetMacroChar(AValue: Char);
+begin
+  if FMacroChar=AValue then Exit;
+  FMacroChar:=AValue;
+  RecreateMacros;
+end;
+
+procedure TCustomSQLStatement.SetMacroCheck(AValue: Boolean);
+begin
+  if FMacroCheck=AValue then Exit;
+  FMacroCheck:=AValue;
+  RecreateMacros;
+end;
+
 procedure TCustomSQLStatement.SetTransaction(AValue: TSQLTransaction);
 begin
   if FTransaction=AValue then Exit;
@@ -942,6 +983,36 @@ begin
     end;
 end;
 
+procedure TCustomSQLStatement.RecreateMacros;
+var
+  NewParams: TSQLDBParams;
+  ConnOptions: TConnOptions;
+  PO : TSQLParseOptions;
+  PB : TParamBinding;
+  RS : String;
+
+begin
+  if MacroCheck then begin
+    if assigned(DataBase) then
+      ConnOptions:=DataBase.ConnOptions
+    else
+      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
+    NewParams := CreateParams;
+    try
+      PO:=[spoCreate,spoUseMacro];
+      if sqEscapeSlash in ConnOptions then
+        Include(PO,spoEscapeSlash);
+      if sqEscapeRepeat in ConnOptions then
+        Include(PO,spoEscapeRepeat);
+      NewParams.ParseSQL(FSQL.Text, PO, psInterbase, PB, MacroChar,RS);
+      NewParams.AssignValues(FMacros);
+      FMacros.Assign(NewParams);
+    finally
+      NewParams.Free;
+    end;
+  end;
+end;
+
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 begin
@@ -951,7 +1022,7 @@ begin
   FDataLink.DataSource:=AValue;
 end;
 
-Procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound: Boolean);
+procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound: Boolean);
 begin
   if Assigned(DataSource) and Assigned(DataSource.Dataset) then
     FParams.CopyParamValuesFromDataset(DataSource.Dataset,CopyBound);
@@ -963,13 +1034,20 @@ begin
   FParams.Assign(AValue);
 end;
 
+procedure TCustomSQLStatement.SetMacros(AValue: TParams);
+begin
+  if FMacros=AValue then Exit;
+  FMacros.Assign(AValue);
+end;
+
 procedure TCustomSQLStatement.SetSQL(AValue: TStrings);
 begin
   if FSQL=AValue then Exit;
   FSQL.Assign(AValue);
+  RecreateMacros;
 end;
 
-Procedure TCustomSQLStatement.DoExecute;
+procedure TCustomSQLStatement.DoExecute;
 begin
   FRowsAffected:=-1;
   If (FParams.Count>0) and Assigned(DataSource) then
@@ -979,27 +1057,27 @@ begin
   Database.Execute(FCursor,Transaction, FParams);
 end;
 
-Function TCustomSQLStatement.GetPrepared: Boolean;
+function TCustomSQLStatement.GetPrepared: Boolean;
 begin
   Result := Assigned(FCursor) and FCursor.FPrepared;
 end;
 
-Function TCustomSQLStatement.CreateDataLink: TDataLink;
+function TCustomSQLStatement.CreateDataLink: TDataLink;
 begin
   Result:=TDataLink.Create;
 end;
 
-Function TCustomSQLStatement.CreateParams: TSQLDBParams;
+function TCustomSQLStatement.CreateParams: TSQLDBParams;
 begin
   Result:=TSQLDBParams.Create(Nil);
 end;
 
-Function TCustomSQLStatement.LogEvent(EventType: TDBEventType): Boolean;
+function TCustomSQLStatement.LogEvent(EventType: TDBEventType): Boolean;
 begin
   Result:=Assigned(Database) and Database.LogEvent(EventType);
 end;
 
-Procedure TCustomSQLStatement.Log(EventType: TDBEventType; Const Msg: String);
+procedure TCustomSQLStatement.Log(EventType: TDBEventType; const Msg: String);
 Var
   M : String;
 
@@ -1035,6 +1113,9 @@ begin
   TStringList(FSQL).OnChange:=@OnChangeSQL;
   FParams:=CreateParams;
   FParamCheck:=True;
+  FMacros:=CreateParams;
+  FMacroChar:=DefaultMacroChar;
+  FMacroCheck:=False;
   FParseSQL:=True;
   FRowsAffected:=-1;
 end;
@@ -1047,27 +1128,28 @@ begin
   DataSource:=Nil;
   FreeAndNil(FDataLink);
   FreeAndNil(FParams);
+  FreeAndNil(FMacros);
   FreeAndNil(FSQL);
   inherited Destroy;
 end;
 
-Function TCustomSQLStatement.GetSchemaType: TSchemaType;
+function TCustomSQLStatement.GetSchemaType: TSchemaType;
 
 begin
   Result:=stNoSchema
 end;
 
-Function TCustomSQLStatement.GetSchemaObjectName: String;
+function TCustomSQLStatement.GetSchemaObjectName: String;
 begin
   Result:='';
 end;
 
-Function TCustomSQLStatement.GetSchemaPattern: String;
+function TCustomSQLStatement.GetSchemaPattern: String;
 begin
   Result:='';
 end;
 
-Function TCustomSQLStatement.IsSelectable: Boolean;
+function TCustomSQLStatement.IsSelectable: Boolean;
 begin
   Result:=False;
 end;
@@ -1092,6 +1174,65 @@ begin
     DataBase.DeAllocateCursorHandle(FCursor);
 end;
 
+function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
+
+Const
+  Terminators = SQLDelimiterCharacters+
+                [ #0,'=','+','-','*','\','/','[',']','|' ];
+
+var
+  I: Integer;
+  Ch : Char;
+  TermArr : Set of Char;
+  TempStr, TempMacroName : String;
+  MacroFlag : Boolean;
+
+  Procedure SubstituteMacro;
+
+  var
+    Param: TParam;
+  begin
+    Param := Macros.FindParam( TempMacroName );
+    if Assigned( Param ) then
+      Result := Result + Param.AsString
+    else
+      Result := Result + MacroChar + TempMacroName;
+    TempMacroName:='';
+  end;
+
+begin
+  Result := OrigSQL;
+  if not MacroCheck then
+    Exit;
+  TermArr := Terminators +[MacroChar];
+  Result := '';
+  MacroFlag := False;
+  for Ch in OrigSQL do
+    begin
+    if not MacroFlag and (Ch=MacroChar) then
+      begin
+      MacroFlag := True;
+      TempMacroName := '';
+      end
+    else if MacroFlag then
+      begin
+      if not (Ch In TermArr) then
+        TempMacroName := TempMacroName + Ch
+      else
+        begin
+        SubstituteMacro;
+        if Ch <> MacroChar then
+          MacroFlag := False;
+        TempMacroName := '';
+        end
+      end;
+    if not MacroFlag then
+      Result := Result + Ch;
+    end;
+  if (TempMacroName<>'') then
+    SubstituteMacro;
+end;
+
 procedure TCustomSQLStatement.DoPrepare;
 
 var
@@ -1103,7 +1244,7 @@ begin
     FOrigSQL := Database.GetSchemaInfoSQL(GetSchemaType, GetSchemaObjectName, GetSchemaPattern);
   if (FOrigSQL='') then
     DatabaseError(SErrNoStatement);
-  FServerSQL:=FOrigSQL;
+  FServerSQL:=ExpandMacros( FOrigSQL );
   GetStatementInfo(FServerSQL,StmInfo);
   AllocateCursor;
   FCursor.FSelectable:=True; // let PrepareStatement and/or Execute alter it
@@ -1114,7 +1255,7 @@ begin
   Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
 end;
 
-Procedure TCustomSQLStatement.Prepare;
+procedure TCustomSQLStatement.Prepare;
 
 begin
   if Prepared then exit;
@@ -1133,7 +1274,7 @@ begin
   end;
 end;
 
-Procedure TCustomSQLStatement.Execute;
+procedure TCustomSQLStatement.Execute;
 begin
   Prepare;
   DoExecute;
@@ -1160,7 +1301,7 @@ begin
     Result:=Nil;
 end;
 
-Procedure TCustomSQLStatement.Unprepare;
+procedure TCustomSQLStatement.Unprepare;
 begin
   // Some SQLConnections does not support statement [un]preparation, but they have allocated local cursor(s)
   //  so let them do cleanup f.e. cancel pending queries and/or free resultset
@@ -1169,7 +1310,7 @@ begin
     DoUnprepare;
 end;
 
-function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
+function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
 begin
   Result:=FParams.ParamByName(AParamName);
 end;
@@ -2494,7 +2635,8 @@ end;
 
 { TCustomSQLQuery }
 
-Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
+function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
+  ): TCustomSQLStatement;
 
 begin
   Result:=TQuerySQLStatement.Create(Self);
@@ -2551,6 +2693,11 @@ begin
   Result:=Params.ParamByName(AParamName);
 end;
 
+function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
+begin
+  Result:=Macros.ParamByName(AParamName);
+end;
+
 procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
 
 begin
@@ -2708,10 +2855,13 @@ end;
 procedure TCustomSQLQuery.ApplyFilter;
 
 begin
+  FreeFldBuffers;
   FStatement.Unprepare;
+  FIsEOF := False;
+  inherited InternalClose;
   FStatement.DoPrepare;
   FStatement.DoExecute;
-  InternalRefresh;
+  inherited InternalOpen;
   First;
 end;
 
@@ -2770,6 +2920,11 @@ begin
      SQLConnection.FreeFldBuffers(Cursor);
 end;
 
+function TCustomSQLQuery.GetMacroChar: Char;
+begin
+  Result := FStatement.MacroChar;
+end;
+
 function TCustomSQLQuery.GetParamCheck: Boolean;
 begin
   Result:=FStatement.ParamCheck;
@@ -2780,6 +2935,16 @@ begin
   Result:=FStatement.Params;
 end;
 
+function TCustomSQLQuery.GetMacroCheck: Boolean;
+begin
+  Result:=FStatement.MacroCheck;
+end;
+
+function TCustomSQLQuery.GetMacros: TParams;
+begin
+  Result:=FStatement.Macros;
+end;
+
 function TCustomSQLQuery.GetParseSQL: Boolean;
 begin
   Result:=FStatement.ParseSQL;
@@ -3068,6 +3233,11 @@ begin
     end
 end;
 
+procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
+begin
+  FStatement.MacroChar:=AValue;
+end;
+
 function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
 
 begin
@@ -3194,6 +3364,11 @@ begin
   FStatement.ParamCheck:=AValue;
 end;
 
+procedure TCustomSQLQuery.SetMacroCheck(AValue: Boolean);
+begin
+  FStatement.MacroCheck:=AValue;
+end;
+
 procedure TCustomSQLQuery.SetOptions(AValue: TSQLQueryOptions);
 begin
   if FOptions=AValue then Exit;
@@ -3239,6 +3414,11 @@ begin
   FStatement.Params.Assign(AValue);
 end;
 
+procedure TCustomSQLQuery.SetMacros(AValue: TParams);
+begin
+  FStatement.Macros.Assign(AValue);
+end;
+
 procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var

+ 30 - 0
packages/fcl-db/tests/testsqldb.pas

@@ -56,6 +56,7 @@ type
     procedure TestSequence;
     procedure TestReturningInsert;
     procedure TestReturningUpdate;
+    procedure TestMacros;
   end;
 
   { TTestTSQLConnection }
@@ -722,6 +723,35 @@ begin
   AssertEquals('#2.b updated', 'b2', FMyQ.FieldByName('b').AsString);
 end;
 
+procedure TTestTSQLQuery.TestMacros;
+begin
+  with SQLDBConnector do
+    begin
+    if not (sqSupportReturning in Connection.ConnOptions) then
+      Ignore(STestNotApplicable);
+    ExecuteDirect('create table FPDEV2 (id integer not null, constraint PK_FPDEV2 primary key(id))');
+    CommitDDL;
+    ExecuteDirect('insert into FPDEV2 (id) values (1)');
+    ExecuteDirect('insert into FPDEV2 (id) values (2)');
+    end;
+
+  With SQLDBConnector.Query do
+    begin
+    SQL.Text:='Select ID from FPDEV2 '+
+      '%WHERE_CL' +sLineBreak+
+      '%ORDER_CL' +sLineBreak;
+    MacroCheck:=true;
+    MacroByName('WHERE_CL').AsString:='where 1=1';
+    MacroByName('ORDER_CL').AsString:='order by 1';
+    Open;
+    AssertEquals('Correct SQL executed, macros substituted: ',1,Fields[0].AsInteger);
+    Close;
+    MacroByName('ORDER_CL').AsString := 'Order by 1 DESC';
+    Open;
+    AssertEquals('Correct SQL executed, macro value changed: ',2,Fields[0].AsInteger);
+    end;
+end;
+
 
 { TTestTSQLConnection }