View Issue Details

IDProjectCategoryView StatusLast Update
0036057FPCPackagespublic2019-09-19 08:25
ReporterZdravko GabrovskiAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
PlatformallOSallOS Versionall
Product Version3.3.1Product BuildTrunc 
Target VersionFixed in Version4.0.0 
Summary0036057: Create "Macro" functionality for TSQLQuery
DescriptionDuring the port of my existing D5/D7 project to Lazarus/fpc, I found, that will be good to implement "Macros" inside TSQLQuery component.

Macroses exists inside old good TRxQuery components, and gives the ability to manipulate very easy SQL by a params-similar Collection, called "Macros".

To preserve backward compatibility, macroses are disabled by default. You must enable via "MactoCheck" = true.

You can set macro prefix char via "MacroChar" property, which is defaulted to "true".
Steps To ReproduceNew functionality
Additional InformationMacroimpl.diff cintains svn diff file.
allfilestmacroimpl.7z contains full source code.
TagsNo tags attached.
Fixed in Revision43003
FPCOldBugId
FPCTarget-
Attached Files
  • allfilesmacroimpl.7z (41,618 bytes)
  • macroimpl.diff (23,007 bytes)
    Index: fpcsrc/packages/fcl-db/src/base/db.pas
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/base/db.pas	(revision 42942)
    +++ fpcsrc/packages/fcl-db/src/base/db.pas	(working copy)
    @@ -1300,6 +1300,7 @@
       TParams = class(TCollection)
       private
         FOwner: TPersistent;
    +    FMacroChar : Char;
         Function  GetItem(Index: Integer): TParam;
         Function  GetParamValue(const ParamName: string): Variant;
         Procedure SetItem(Index: Integer; Value: TParam);
    @@ -1323,6 +1324,7 @@
         Function  ParamByName(const Value: string): TParam;
         Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
         Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
    +    Function  ParseMacroSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle;MacroChar:Char): 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;
         Procedure RemoveParam(Value: TParam);
    Index: fpcsrc/packages/fcl-db/src/base/dsparams.inc
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/base/dsparams.inc	(revision 42942)
    +++ fpcsrc/packages/fcl-db/src/base/dsparams.inc	(working copy)
    @@ -44,27 +44,27 @@
     
     { 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);
    +procedure TParams.AssignTo(Dest: TPersistent);
     begin
      if (Dest is TParams) then
        TParams(Dest).Assign(Self)
    @@ -72,7 +72,7 @@
        inherited AssignTo(Dest);
     end;
     
    -Function TParams.GetDataSet: TDataSet;
    +function TParams.GetDataSet: TDataSet;
     begin
       If (FOwner is TDataset) Then
         Result:=TDataset(FOwner)
    @@ -80,40 +80,41 @@
         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);
       FOwner:=AOwner;
    +  FMacroChar := ' ';
     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 +130,7 @@
         end;
     end;
     
    -Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
    +function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
       ParamType: TParamType): TParam;
     
     begin
    @@ -139,7 +140,7 @@
       Result.ParamType:=ParamType;
     end;
     
    -Function TParams.FindParam(const Value: string): TParam;
    +function TParams.FindParam(const Value: string): TParam;
     
     Var
       I : Integer;
    @@ -154,7 +155,7 @@
           Dec(i);
     end;
     
    -Procedure TParams.GetParamList(List: TList; const ParamNames: string);
    +procedure TParams.GetParamList(List: TList; const ParamNames: string);
     
     Var
       P: TParam;
    @@ -172,7 +173,7 @@
       until StrPos > Length(ParamNames);
     end;
     
    -Function TParams.IsEqual(Value: TParams): Boolean;
    +function TParams.IsEqual(Value: TParams): Boolean;
     
     Var
       I : Integer;
    @@ -187,12 +188,12 @@
         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
    @@ -199,16 +200,17 @@
         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;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,True,True,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;
    @@ -215,10 +217,20 @@
         rs : string;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
     end;
     
    -Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
    +function TParams.ParseMacroSQL(SQL: String; DoCreate, EscapeSlash,
    +  EscapeRepeat: Boolean; ParameterStyle: TParamStyle; MacroChar: Char): String;
    +var pb : TParamBinding;
    +    rs : string;
    +begin
    +  FMacroChar := MacroChar;
    +  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
    +end;
    +
    +function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
       EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
       ParamBinding: TParambinding): String;
     
    @@ -225,6 +237,7 @@
     var rs : string;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
     end;
     
    @@ -274,7 +287,7 @@
       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;
     
    @@ -288,7 +301,7 @@
       ParamAllocStepSize = 8;
     
     var
    -  IgnorePart:boolean;
    +  IgnorePart, UseMacroChar:boolean;
       p,ParamNameStart,BufStart:PChar;
       ParamName:string;
       QuestionMarkParamCount,ParameterIndex,NewLength:integer;
    @@ -301,10 +314,10 @@
       NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
       b:integer;
       tmpParam:TParam;
    -
     begin
       if DoCreate then Clear;
       // Parse the SQL and build ParamBinding
    +  UseMacroChar := (FMacroChar <> ' ');
       ParamCount:=0;
       NewQueryLength:=Length(SQL);
       SetLength(ParamPart,ParamAllocStepSize);
    @@ -319,11 +332,10 @@
       BufStart:=p; // used to calculate ParamPart.Start values
       repeat
         while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
    -    case p^ of
    -      ':','?': // parameter
    +    if (not UseMacroChar and (( p^ = ':') or ( p^ = '?' ))) or ( UseMacroChar and ( p^ = FMacroChar ) ) then // parameter
             begin
               IgnorePart := False;
    -          if p^=':' then
    +          if ( p^=':' ) or ( UseMacroChar and ( p^ = FMacroChar ) ) then
               begin // find parameter name
                 Inc(p);
                 if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
    @@ -405,11 +417,12 @@
                 // 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);
    @@ -460,10 +473,11 @@
         NewQuery:=SQL;
     
       Result := NewQuery;
    +  FMacroChar := ' ';
     end;
     
     
    -Procedure TParams.RemoveParam(Value: TParam);
    +procedure TParams.RemoveParam(Value: TParam);
     begin
        Value.Collection:=Nil;
     end;
    @@ -1199,7 +1213,7 @@
     end;
     
     
    -Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
    +procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
       CopyBound: Boolean);
     
     Var
    Index: fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(revision 42942)
    +++ fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(working copy)
    @@ -78,7 +78,7 @@
       detRollBack    = sqltypes.detRollBack; 
       detParamValue  = sqltypes.detParamValue; 
       detActualSQL   = sqltypes.detActualSQL;
    -
    +  DefaultMacroChar     = '%';
     Type
       TRowsCount = LargeInt;
     
    @@ -361,6 +361,9 @@
         FDatabase: TSQLConnection;
         FParamCheck: Boolean;
         FParams: TParams;
    +    FMacroCheck: Boolean;
    +    FMacroChar: Char;
    +    FMacros: TParams;
         FSQL: TStrings;
         FOrigSQL : String;
         FServerSQL : String;
    @@ -368,10 +371,15 @@
         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 @@
         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 @@
         Property DataSource;
         Property ParamCheck;
         Property Params;
    +    Property MacroCheck;
    +    Property Macros;
         Property ParseSQL;
         Property SQL;
         Property Transaction;
    @@ -484,8 +497,11 @@
         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 @@
         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 @@
         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 @@
         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 @@
         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 @@
         Property Options;
         property Params;
         Property ParamCheck;
    +    property Macros;
    +    Property MacroCheck;
    +    Property MacroChar;
         property ParseSQL;
         property UpdateMode;
         property UsePrimaryKeyAsKey;
    @@ -891,6 +917,7 @@
     
     begin
       UnPrepare;
    +  RecreateMacros;
       if not ParamCheck then
         exit;
       if assigned(DataBase) then
    @@ -927,6 +954,20 @@
         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,27 @@
         end;
     end;
     
    +procedure TCustomSQLStatement.RecreateMacros;
    +var
    +  NewParams: TSQLDBParams;
    +  ConnOptions: TConnOptions;
    +begin
    +  if MacroCheck then begin
    +    if assigned(DataBase) then
    +      ConnOptions:=DataBase.ConnOptions
    +    else
    +      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
    +    NewParams := CreateParams;
    +    try
    +      NewParams.ParseMacroSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase, MacroChar);
    +      NewParams.AssignValues(FMacros);
    +      FMacros.Assign(NewParams);
    +    finally
    +      NewParams.Free;
    +    end;
    +  end;
    +end;
    +
     procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
     
     begin
    @@ -951,7 +1013,7 @@
       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,6 +1025,12 @@
       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;
    @@ -969,7 +1037,7 @@
       FSQL.Assign(AValue);
     end;
     
    -Procedure TCustomSQLStatement.DoExecute;
    +procedure TCustomSQLStatement.DoExecute;
     begin
       FRowsAffected:=-1;
       If (FParams.Count>0) and Assigned(DataSource) then
    @@ -979,27 +1047,27 @@
       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 +1103,9 @@
       TStringList(FSQL).OnChange:=@OnChangeSQL;
       FParams:=CreateParams;
       FParamCheck:=True;
    +  FMacros:=CreateParams;
    +  FMacroChar:=DefaultMacroChar;
    +  FMacroCheck:=False;
       FParseSQL:=True;
       FRowsAffected:=-1;
     end;
    @@ -1047,27 +1118,28 @@
       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 +1164,49 @@
         DataBase.DeAllocateCursorHandle(FCursor);
     end;
     
    +function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
    +var
    +  Param: TParam;
    +  I: Integer;
    +  Ch : Char;
    +  TermArr : Set of Char;
    +  TempStr, TempMacroName : String;
    +  MacroFlag : Boolean;
    +begin
    +Result := OrigSQL;
    +if not MacroCheck then Exit;
    +
    +TermArr := SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'] +[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 Ch In TermArr then begin
    +       Param := Macros.FindParam( TempMacroName );
    +       if Assigned( Param ) then begin
    +         Result := Result + Param.AsString;
    +         end
    +       else
    +         Result := Result + MacroChar + TempMacroName;
    +       if Ch <> MacroChar then
    +         MacroFlag := False;
    +       TempMacroName := '';
    +       end
    +      else
    +        TempMacroName := TempMacroName + Ch;
    +      end;
    +  if not MacroFlag then
    +    Result := Result + Ch;
    +
    +  end;
    +Result := Result + ifthen (TempMacroName<>'',MacroChar+TempMacroName, '' );
    +end;
    +
     procedure TCustomSQLStatement.DoPrepare;
     
     var
    @@ -1103,7 +1218,7 @@
         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 +1229,7 @@
       Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
     end;
     
    -Procedure TCustomSQLStatement.Prepare;
    +procedure TCustomSQLStatement.Prepare;
     
     begin
       if Prepared then exit;
    @@ -1133,7 +1248,7 @@
       end;
     end;
     
    -Procedure TCustomSQLStatement.Execute;
    +procedure TCustomSQLStatement.Execute;
     begin
       Prepare;
       DoExecute;
    @@ -1160,7 +1275,7 @@
         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 +1284,7 @@
         DoUnprepare;
     end;
     
    -function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
    +function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
     begin
       Result:=FParams.ParamByName(AParamName);
     end;
    @@ -2485,7 +2600,8 @@
     
     { TCustomSQLQuery }
     
    -Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
    +function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
    +  ): TCustomSQLStatement;
     
     begin
       Result:=TQuerySQLStatement.Create(Self);
    @@ -2542,6 +2658,11 @@
       Result:=Params.ParamByName(AParamName);
     end;
     
    +function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
    +begin
    +  Result:=Macros.ParamByName(AParamName);
    +end;
    +
     procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
     
     begin
    @@ -2699,10 +2820,13 @@
     procedure TCustomSQLQuery.ApplyFilter;
     
     begin
    +  FreeFldBuffers;
       FStatement.Unprepare;
    +  FIsEOF := False;
    +  inherited InternalClose;
       FStatement.DoPrepare;
       FStatement.DoExecute;
    -  InternalRefresh;
    +  inherited InternalOpen;
       First;
     end;
     
    @@ -2761,6 +2885,11 @@
          SQLConnection.FreeFldBuffers(Cursor);
     end;
     
    +function TCustomSQLQuery.GetMacroChar: Char;
    +begin
    +  Result := FStatement.MacroChar;
    +end;
    +
     function TCustomSQLQuery.GetParamCheck: Boolean;
     begin
       Result:=FStatement.ParamCheck;
    @@ -2771,6 +2900,16 @@
       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;
    @@ -3059,6 +3198,11 @@
         end
     end;
     
    +procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
    +begin
    +  FStatement.MacroChar:=AValue;
    +end;
    +
     function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
     
     begin
    @@ -3185,6 +3329,11 @@
       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;
    @@ -3230,6 +3379,11 @@
       FStatement.Params.Assign(AValue);
     end;
     
    +procedure TCustomSQLQuery.SetMacros(AValue: TParams);
    +begin
    +  FStatement.Macros.Assign(AValue);
    +end;
    +
     procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
     
     Var
    
    macroimpl.diff (23,007 bytes)
  • macroimpl-2.diff (23,162 bytes)
    Index: fpcsrc/packages/fcl-db/src/base/db.pas
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/base/db.pas	(revision 42945)
    +++ fpcsrc/packages/fcl-db/src/base/db.pas	(working copy)
    @@ -1300,6 +1300,7 @@
       TParams = class(TCollection)
       private
         FOwner: TPersistent;
    +    FMacroChar : Char;
         Function  GetItem(Index: Integer): TParam;
         Function  GetParamValue(const ParamName: string): Variant;
         Procedure SetItem(Index: Integer; Value: TParam);
    @@ -1323,6 +1324,7 @@
         Function  ParamByName(const Value: string): TParam;
         Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
         Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
    +    Function  ParseMacroSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle;MacroChar:Char): 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;
         Procedure RemoveParam(Value: TParam);
    Index: fpcsrc/packages/fcl-db/src/base/dsparams.inc
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/base/dsparams.inc	(revision 42945)
    +++ fpcsrc/packages/fcl-db/src/base/dsparams.inc	(working copy)
    @@ -44,27 +44,27 @@
     
     { 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);
    +procedure TParams.AssignTo(Dest: TPersistent);
     begin
      if (Dest is TParams) then
        TParams(Dest).Assign(Self)
    @@ -72,7 +72,7 @@
        inherited AssignTo(Dest);
     end;
     
    -Function TParams.GetDataSet: TDataSet;
    +function TParams.GetDataSet: TDataSet;
     begin
       If (FOwner is TDataset) Then
         Result:=TDataset(FOwner)
    @@ -80,40 +80,41 @@
         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);
       FOwner:=AOwner;
    +  FMacroChar := ' ';
     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 +130,7 @@
         end;
     end;
     
    -Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
    +function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
       ParamType: TParamType): TParam;
     
     begin
    @@ -139,7 +140,7 @@
       Result.ParamType:=ParamType;
     end;
     
    -Function TParams.FindParam(const Value: string): TParam;
    +function TParams.FindParam(const Value: string): TParam;
     
     Var
       I : Integer;
    @@ -154,7 +155,7 @@
           Dec(i);
     end;
     
    -Procedure TParams.GetParamList(List: TList; const ParamNames: string);
    +procedure TParams.GetParamList(List: TList; const ParamNames: string);
     
     Var
       P: TParam;
    @@ -172,7 +173,7 @@
       until StrPos > Length(ParamNames);
     end;
     
    -Function TParams.IsEqual(Value: TParams): Boolean;
    +function TParams.IsEqual(Value: TParams): Boolean;
     
     Var
       I : Integer;
    @@ -187,12 +188,12 @@
         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
    @@ -199,16 +200,17 @@
         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;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,True,True,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;
    @@ -215,10 +217,20 @@
         rs : string;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
     end;
     
    -Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
    +function TParams.ParseMacroSQL(SQL: String; DoCreate, EscapeSlash,
    +  EscapeRepeat: Boolean; ParameterStyle: TParamStyle; MacroChar: Char): String;
    +var pb : TParamBinding;
    +    rs : string;
    +begin
    +  FMacroChar := MacroChar;
    +  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
    +end;
    +
    +function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
       EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
       ParamBinding: TParambinding): String;
     
    @@ -225,6 +237,7 @@
     var rs : string;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
     end;
     
    @@ -274,7 +287,7 @@
       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;
     
    @@ -288,7 +301,7 @@
       ParamAllocStepSize = 8;
     
     var
    -  IgnorePart:boolean;
    +  IgnorePart, UseMacroChar:boolean;
       p,ParamNameStart,BufStart:PChar;
       ParamName:string;
       QuestionMarkParamCount,ParameterIndex,NewLength:integer;
    @@ -301,10 +314,10 @@
       NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
       b:integer;
       tmpParam:TParam;
    -
     begin
       if DoCreate then Clear;
       // Parse the SQL and build ParamBinding
    +  UseMacroChar := (FMacroChar <> ' ');
       ParamCount:=0;
       NewQueryLength:=Length(SQL);
       SetLength(ParamPart,ParamAllocStepSize);
    @@ -319,11 +332,10 @@
       BufStart:=p; // used to calculate ParamPart.Start values
       repeat
         while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
    -    case p^ of
    -      ':','?': // parameter
    +    if (not UseMacroChar and (( p^ = ':') or ( p^ = '?' ))) or ( UseMacroChar and ( p^ = FMacroChar ) ) then // parameter
             begin
               IgnorePart := False;
    -          if p^=':' then
    +          if ( p^=':' ) or ( UseMacroChar and ( p^ = FMacroChar ) ) then
               begin // find parameter name
                 Inc(p);
                 if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
    @@ -405,11 +417,12 @@
                 // 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);
    @@ -460,10 +473,11 @@
         NewQuery:=SQL;
     
       Result := NewQuery;
    +  FMacroChar := ' ';
     end;
     
     
    -Procedure TParams.RemoveParam(Value: TParam);
    +procedure TParams.RemoveParam(Value: TParam);
     begin
        Value.Collection:=Nil;
     end;
    @@ -1199,7 +1213,7 @@
     end;
     
     
    -Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
    +procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
       CopyBound: Boolean);
     
     Var
    Index: fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(revision 42945)
    +++ fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(working copy)
    @@ -78,7 +78,7 @@
       detRollBack    = sqltypes.detRollBack; 
       detParamValue  = sqltypes.detParamValue; 
       detActualSQL   = sqltypes.detActualSQL;
    -
    +  DefaultMacroChar     = '%';
     Type
       TRowsCount = LargeInt;
     
    @@ -361,6 +361,9 @@
         FDatabase: TSQLConnection;
         FParamCheck: Boolean;
         FParams: TParams;
    +    FMacroCheck: Boolean;
    +    FMacroChar: Char;
    +    FMacros: TParams;
         FSQL: TStrings;
         FOrigSQL : String;
         FServerSQL : String;
    @@ -368,10 +371,15 @@
         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 @@
         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 @@
         Property DataSource;
         Property ParamCheck;
         Property Params;
    +    Property MacroCheck;
    +    Property Macros;
         Property ParseSQL;
         Property SQL;
         Property Transaction;
    @@ -484,8 +497,11 @@
         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 @@
         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 @@
         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 @@
         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 @@
         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 @@
         Property Options;
         property Params;
         Property ParamCheck;
    +    property Macros;
    +    Property MacroCheck;
    +    Property MacroChar;
         property ParseSQL;
         property UpdateMode;
         property UsePrimaryKeyAsKey;
    @@ -891,6 +917,7 @@
     
     begin
       UnPrepare;
    +  RecreateMacros;
       if not ParamCheck then
         exit;
       if assigned(DataBase) then
    @@ -927,6 +954,20 @@
         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,27 @@
         end;
     end;
     
    +procedure TCustomSQLStatement.RecreateMacros;
    +var
    +  NewParams: TSQLDBParams;
    +  ConnOptions: TConnOptions;
    +begin
    +  if MacroCheck then begin
    +    if assigned(DataBase) then
    +      ConnOptions:=DataBase.ConnOptions
    +    else
    +      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
    +    NewParams := CreateParams;
    +    try
    +      NewParams.ParseMacroSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase, MacroChar);
    +      NewParams.AssignValues(FMacros);
    +      FMacros.Assign(NewParams);
    +    finally
    +      NewParams.Free;
    +    end;
    +  end;
    +end;
    +
     procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
     
     begin
    @@ -951,7 +1013,7 @@
       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 +1025,20 @@
       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 +1048,27 @@
       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 +1104,9 @@
       TStringList(FSQL).OnChange:=@OnChangeSQL;
       FParams:=CreateParams;
       FParamCheck:=True;
    +  FMacros:=CreateParams;
    +  FMacroChar:=DefaultMacroChar;
    +  FMacroCheck:=False;
       FParseSQL:=True;
       FRowsAffected:=-1;
     end;
    @@ -1047,27 +1119,28 @@
       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 +1165,57 @@
         DataBase.DeAllocateCursorHandle(FCursor);
     end;
     
    +function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
    +var
    +  Param: TParam;
    +  I: Integer;
    +  Ch : Char;
    +  TermArr : Set of Char;
    +  TempStr, TempMacroName : String;
    +  MacroFlag : Boolean;
    +begin
    +Result := OrigSQL;
    +if not MacroCheck then Exit;
    +
    +TermArr := SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'] +[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 Ch In TermArr then begin
    +       Param := Macros.FindParam( TempMacroName );
    +       if Assigned( Param ) then begin
    +         Result := Result + Param.AsString;
    +         end
    +       else
    +         Result := Result + MacroChar + TempMacroName;
    +       if Ch <> MacroChar then
    +         MacroFlag := False;
    +       TempMacroName := '';
    +       end
    +      else
    +        TempMacroName := TempMacroName + Ch;
    +      end;
    +  if not MacroFlag then
    +    Result := Result + Ch;
    +
    +  end;
    +
    +if TempMacroName<>'' then begin
    +  Param := Macros.FindParam( TempMacroName );
    +  if Assigned( Param ) then begin
    +    Result := Result + Param.AsString;
    +    end
    +  else
    +    Result := Result + MacroChar + TempMacroName;
    +  end;
    +end;
    +
     procedure TCustomSQLStatement.DoPrepare;
     
     var
    @@ -1103,7 +1227,7 @@
         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 +1238,7 @@
       Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
     end;
     
    -Procedure TCustomSQLStatement.Prepare;
    +procedure TCustomSQLStatement.Prepare;
     
     begin
       if Prepared then exit;
    @@ -1133,7 +1257,7 @@
       end;
     end;
     
    -Procedure TCustomSQLStatement.Execute;
    +procedure TCustomSQLStatement.Execute;
     begin
       Prepare;
       DoExecute;
    @@ -1160,7 +1284,7 @@
         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 +1293,7 @@
         DoUnprepare;
     end;
     
    -function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
    +function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
     begin
       Result:=FParams.ParamByName(AParamName);
     end;
    @@ -2487,7 +2611,8 @@
     
     { TCustomSQLQuery }
     
    -Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
    +function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
    +  ): TCustomSQLStatement;
     
     begin
       Result:=TQuerySQLStatement.Create(Self);
    @@ -2544,6 +2669,11 @@
       Result:=Params.ParamByName(AParamName);
     end;
     
    +function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
    +begin
    +  Result:=Macros.ParamByName(AParamName);
    +end;
    +
     procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
     
     begin
    @@ -2701,10 +2831,13 @@
     procedure TCustomSQLQuery.ApplyFilter;
     
     begin
    +  FreeFldBuffers;
       FStatement.Unprepare;
    +  FIsEOF := False;
    +  inherited InternalClose;
       FStatement.DoPrepare;
       FStatement.DoExecute;
    -  InternalRefresh;
    +  inherited InternalOpen;
       First;
     end;
     
    @@ -2763,6 +2896,11 @@
          SQLConnection.FreeFldBuffers(Cursor);
     end;
     
    +function TCustomSQLQuery.GetMacroChar: Char;
    +begin
    +  Result := FStatement.MacroChar;
    +end;
    +
     function TCustomSQLQuery.GetParamCheck: Boolean;
     begin
       Result:=FStatement.ParamCheck;
    @@ -2773,6 +2911,16 @@
       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;
    @@ -3061,6 +3209,11 @@
         end
     end;
     
    +procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
    +begin
    +  FStatement.MacroChar:=AValue;
    +end;
    +
     function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
     
     begin
    @@ -3187,6 +3340,11 @@
       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;
    @@ -3232,6 +3390,11 @@
       FStatement.Params.Assign(AValue);
     end;
     
    +procedure TCustomSQLQuery.SetMacros(AValue: TParams);
    +begin
    +  FStatement.Macros.Assign(AValue);
    +end;
    +
     procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
     
     Var
    
    macroimpl-2.diff (23,162 bytes)
  • allfilesmacroimpl-2.7z (41,651 bytes)
  • MacroImplementationProject.zip (2,551 bytes)
  • ConsoleTestApp.zip (2,877 bytes)
  • macroimpl-3.diff (23,162 bytes)
    Index: fpcsrc/packages/fcl-db/src/base/db.pas
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/base/db.pas	(revision 42976)
    +++ fpcsrc/packages/fcl-db/src/base/db.pas	(working copy)
    @@ -1301,6 +1301,7 @@
       TParams = class(TCollection)
       private
         FOwner: TPersistent;
    +    FMacroChar : Char;
         Function  GetItem(Index: Integer): TParam;
         Function  GetParamValue(const ParamName: string): Variant;
         Procedure SetItem(Index: Integer; Value: TParam);
    @@ -1324,6 +1325,7 @@
         Function  ParamByName(const Value: string): TParam;
         Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
         Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
    +    Function  ParseMacroSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle;MacroChar:Char): 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;
         Procedure RemoveParam(Value: TParam);
    Index: fpcsrc/packages/fcl-db/src/base/dsparams.inc
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/base/dsparams.inc	(revision 42976)
    +++ fpcsrc/packages/fcl-db/src/base/dsparams.inc	(working copy)
    @@ -44,27 +44,27 @@
     
     { 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);
    +procedure TParams.AssignTo(Dest: TPersistent);
     begin
      if (Dest is TParams) then
        TParams(Dest).Assign(Self)
    @@ -72,7 +72,7 @@
        inherited AssignTo(Dest);
     end;
     
    -Function TParams.GetDataSet: TDataSet;
    +function TParams.GetDataSet: TDataSet;
     begin
       If (FOwner is TDataset) Then
         Result:=TDataset(FOwner)
    @@ -80,40 +80,41 @@
         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);
       FOwner:=AOwner;
    +  FMacroChar := ' ';
     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 +130,7 @@
         end;
     end;
     
    -Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
    +function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
       ParamType: TParamType): TParam;
     
     begin
    @@ -139,7 +140,7 @@
       Result.ParamType:=ParamType;
     end;
     
    -Function TParams.FindParam(const Value: string): TParam;
    +function TParams.FindParam(const Value: string): TParam;
     
     Var
       I : Integer;
    @@ -154,7 +155,7 @@
           Dec(i);
     end;
     
    -Procedure TParams.GetParamList(List: TList; const ParamNames: string);
    +procedure TParams.GetParamList(List: TList; const ParamNames: string);
     
     Var
       P: TParam;
    @@ -172,7 +173,7 @@
       until StrPos > Length(ParamNames);
     end;
     
    -Function TParams.IsEqual(Value: TParams): Boolean;
    +function TParams.IsEqual(Value: TParams): Boolean;
     
     Var
       I : Integer;
    @@ -187,12 +188,12 @@
         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
    @@ -199,16 +200,17 @@
         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;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,True,True,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;
    @@ -215,10 +217,20 @@
         rs : string;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
     end;
     
    -Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
    +function TParams.ParseMacroSQL(SQL: String; DoCreate, EscapeSlash,
    +  EscapeRepeat: Boolean; ParameterStyle: TParamStyle; MacroChar: Char): String;
    +var pb : TParamBinding;
    +    rs : string;
    +begin
    +  FMacroChar := MacroChar;
    +  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
    +end;
    +
    +function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
       EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
       ParamBinding: TParambinding): String;
     
    @@ -225,6 +237,7 @@
     var rs : string;
     
     begin
    +  FMacroChar := ' ';
       Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
     end;
     
    @@ -274,7 +287,7 @@
       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;
     
    @@ -288,7 +301,7 @@
       ParamAllocStepSize = 8;
     
     var
    -  IgnorePart:boolean;
    +  IgnorePart, UseMacroChar:boolean;
       p,ParamNameStart,BufStart:PChar;
       ParamName:string;
       QuestionMarkParamCount,ParameterIndex,NewLength:integer;
    @@ -301,10 +314,10 @@
       NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
       b:integer;
       tmpParam:TParam;
    -
     begin
       if DoCreate then Clear;
       // Parse the SQL and build ParamBinding
    +  UseMacroChar := (FMacroChar <> ' ');
       ParamCount:=0;
       NewQueryLength:=Length(SQL);
       SetLength(ParamPart,ParamAllocStepSize);
    @@ -319,11 +332,10 @@
       BufStart:=p; // used to calculate ParamPart.Start values
       repeat
         while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
    -    case p^ of
    -      ':','?': // parameter
    +    if (not UseMacroChar and (( p^ = ':') or ( p^ = '?' ))) or ( UseMacroChar and ( p^ = FMacroChar ) ) then // parameter
             begin
               IgnorePart := False;
    -          if p^=':' then
    +          if ( p^=':' ) or ( UseMacroChar and ( p^ = FMacroChar ) ) then
               begin // find parameter name
                 Inc(p);
                 if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
    @@ -405,11 +417,12 @@
                 // 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);
    @@ -460,10 +473,11 @@
         NewQuery:=SQL;
     
       Result := NewQuery;
    +  FMacroChar := ' ';
     end;
     
     
    -Procedure TParams.RemoveParam(Value: TParam);
    +procedure TParams.RemoveParam(Value: TParam);
     begin
        Value.Collection:=Nil;
     end;
    @@ -1199,7 +1213,7 @@
     end;
     
     
    -Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
    +procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
       CopyBound: Boolean);
     
     Var
    Index: fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp
    ===================================================================
    --- fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(revision 42976)
    +++ fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(working copy)
    @@ -78,7 +78,7 @@
       detRollBack    = sqltypes.detRollBack; 
       detParamValue  = sqltypes.detParamValue; 
       detActualSQL   = sqltypes.detActualSQL;
    -
    +  DefaultMacroChar     = '%';
     Type
       TRowsCount = LargeInt;
     
    @@ -361,6 +361,9 @@
         FDatabase: TSQLConnection;
         FParamCheck: Boolean;
         FParams: TParams;
    +    FMacroCheck: Boolean;
    +    FMacroChar: Char;
    +    FMacros: TParams;
         FSQL: TStrings;
         FOrigSQL : String;
         FServerSQL : String;
    @@ -368,10 +371,15 @@
         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 @@
         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 @@
         Property DataSource;
         Property ParamCheck;
         Property Params;
    +    Property MacroCheck;
    +    Property Macros;
         Property ParseSQL;
         Property SQL;
         Property Transaction;
    @@ -484,8 +497,11 @@
         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 @@
         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 @@
         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 @@
         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 @@
         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 @@
         Property Options;
         property Params;
         Property ParamCheck;
    +    property Macros;
    +    Property MacroCheck;
    +    Property MacroChar;
         property ParseSQL;
         property UpdateMode;
         property UsePrimaryKeyAsKey;
    @@ -891,6 +917,7 @@
     
     begin
       UnPrepare;
    +  RecreateMacros;
       if not ParamCheck then
         exit;
       if assigned(DataBase) then
    @@ -927,6 +954,20 @@
         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,27 @@
         end;
     end;
     
    +procedure TCustomSQLStatement.RecreateMacros;
    +var
    +  NewParams: TSQLDBParams;
    +  ConnOptions: TConnOptions;
    +begin
    +  if MacroCheck then begin
    +    if assigned(DataBase) then
    +      ConnOptions:=DataBase.ConnOptions
    +    else
    +      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
    +    NewParams := CreateParams;
    +    try
    +      NewParams.ParseMacroSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase, MacroChar);
    +      NewParams.AssignValues(FMacros);
    +      FMacros.Assign(NewParams);
    +    finally
    +      NewParams.Free;
    +    end;
    +  end;
    +end;
    +
     procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
     
     begin
    @@ -951,7 +1013,7 @@
       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 +1025,20 @@
       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 +1048,27 @@
       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 +1104,9 @@
       TStringList(FSQL).OnChange:=@OnChangeSQL;
       FParams:=CreateParams;
       FParamCheck:=True;
    +  FMacros:=CreateParams;
    +  FMacroChar:=DefaultMacroChar;
    +  FMacroCheck:=False;
       FParseSQL:=True;
       FRowsAffected:=-1;
     end;
    @@ -1047,27 +1119,28 @@
       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 +1165,57 @@
         DataBase.DeAllocateCursorHandle(FCursor);
     end;
     
    +function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
    +var
    +  Param: TParam;
    +  I: Integer;
    +  Ch : Char;
    +  TermArr : Set of Char;
    +  TempStr, TempMacroName : String;
    +  MacroFlag : Boolean;
    +begin
    +Result := OrigSQL;
    +if not MacroCheck then Exit;
    +
    +TermArr := SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'] +[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 Ch In TermArr then begin
    +       Param := Macros.FindParam( TempMacroName );
    +       if Assigned( Param ) then begin
    +         Result := Result + Param.AsString;
    +         end
    +       else
    +         Result := Result + MacroChar + TempMacroName;
    +       if Ch <> MacroChar then
    +         MacroFlag := False;
    +       TempMacroName := '';
    +       end
    +      else
    +        TempMacroName := TempMacroName + Ch;
    +      end;
    +  if not MacroFlag then
    +    Result := Result + Ch;
    +
    +  end;
    +
    +if TempMacroName<>'' then begin
    +  Param := Macros.FindParam( TempMacroName );
    +  if Assigned( Param ) then begin
    +    Result := Result + Param.AsString;
    +    end
    +  else
    +    Result := Result + MacroChar + TempMacroName;
    +  end;
    +end;
    +
     procedure TCustomSQLStatement.DoPrepare;
     
     var
    @@ -1103,7 +1227,7 @@
         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 +1238,7 @@
       Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
     end;
     
    -Procedure TCustomSQLStatement.Prepare;
    +procedure TCustomSQLStatement.Prepare;
     
     begin
       if Prepared then exit;
    @@ -1133,7 +1257,7 @@
       end;
     end;
     
    -Procedure TCustomSQLStatement.Execute;
    +procedure TCustomSQLStatement.Execute;
     begin
       Prepare;
       DoExecute;
    @@ -1160,7 +1284,7 @@
         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 +1293,7 @@
         DoUnprepare;
     end;
     
    -function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
    +function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
     begin
       Result:=FParams.ParamByName(AParamName);
     end;
    @@ -2494,7 +2618,8 @@
     
     { TCustomSQLQuery }
     
    -Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
    +function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
    +  ): TCustomSQLStatement;
     
     begin
       Result:=TQuerySQLStatement.Create(Self);
    @@ -2551,6 +2676,11 @@
       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 +2838,13 @@
     procedure TCustomSQLQuery.ApplyFilter;
     
     begin
    +  FreeFldBuffers;
       FStatement.Unprepare;
    +  FIsEOF := False;
    +  inherited InternalClose;
       FStatement.DoPrepare;
       FStatement.DoExecute;
    -  InternalRefresh;
    +  inherited InternalOpen;
       First;
     end;
     
    @@ -2770,6 +2903,11 @@
          SQLConnection.FreeFldBuffers(Cursor);
     end;
     
    +function TCustomSQLQuery.GetMacroChar: Char;
    +begin
    +  Result := FStatement.MacroChar;
    +end;
    +
     function TCustomSQLQuery.GetParamCheck: Boolean;
     begin
       Result:=FStatement.ParamCheck;
    @@ -2780,6 +2918,16 @@
       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 +3216,11 @@
         end
     end;
     
    +procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
    +begin
    +  FStatement.MacroChar:=AValue;
    +end;
    +
     function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
     
     begin
    @@ -3194,6 +3347,11 @@
       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 +3397,11 @@
       FStatement.Params.Assign(AValue);
     end;
     
    +procedure TCustomSQLQuery.SetMacros(AValue: TParams);
    +begin
    +  FStatement.Macros.Assign(AValue);
    +end;
    +
     procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
     
     Var
    
    macroimpl-3.diff (23,162 bytes)
  • allfilesmacroimpl-3.7z (41,684 bytes)

Activities

Zdravko Gabrovski

2019-09-08 11:57

reporter  

allfilesmacroimpl.7z (41,618 bytes)
macroimpl.diff (23,007 bytes)
Index: fpcsrc/packages/fcl-db/src/base/db.pas
===================================================================
--- fpcsrc/packages/fcl-db/src/base/db.pas	(revision 42942)
+++ fpcsrc/packages/fcl-db/src/base/db.pas	(working copy)
@@ -1300,6 +1300,7 @@
   TParams = class(TCollection)
   private
     FOwner: TPersistent;
+    FMacroChar : Char;
     Function  GetItem(Index: Integer): TParam;
     Function  GetParamValue(const ParamName: string): Variant;
     Procedure SetItem(Index: Integer; Value: TParam);
@@ -1323,6 +1324,7 @@
     Function  ParamByName(const Value: string): TParam;
     Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
+    Function  ParseMacroSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle;MacroChar:Char): 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;
     Procedure RemoveParam(Value: TParam);
Index: fpcsrc/packages/fcl-db/src/base/dsparams.inc
===================================================================
--- fpcsrc/packages/fcl-db/src/base/dsparams.inc	(revision 42942)
+++ fpcsrc/packages/fcl-db/src/base/dsparams.inc	(working copy)
@@ -44,27 +44,27 @@
 
 { 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);
+procedure TParams.AssignTo(Dest: TPersistent);
 begin
  if (Dest is TParams) then
    TParams(Dest).Assign(Self)
@@ -72,7 +72,7 @@
    inherited AssignTo(Dest);
 end;
 
-Function TParams.GetDataSet: TDataSet;
+function TParams.GetDataSet: TDataSet;
 begin
   If (FOwner is TDataset) Then
     Result:=TDataset(FOwner)
@@ -80,40 +80,41 @@
     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);
   FOwner:=AOwner;
+  FMacroChar := ' ';
 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 +130,7 @@
     end;
 end;
 
-Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
+function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
   ParamType: TParamType): TParam;
 
 begin
@@ -139,7 +140,7 @@
   Result.ParamType:=ParamType;
 end;
 
-Function TParams.FindParam(const Value: string): TParam;
+function TParams.FindParam(const Value: string): TParam;
 
 Var
   I : Integer;
@@ -154,7 +155,7 @@
       Dec(i);
 end;
 
-Procedure TParams.GetParamList(List: TList; const ParamNames: string);
+procedure TParams.GetParamList(List: TList; const ParamNames: string);
 
 Var
   P: TParam;
@@ -172,7 +173,7 @@
   until StrPos > Length(ParamNames);
 end;
 
-Function TParams.IsEqual(Value: TParams): Boolean;
+function TParams.IsEqual(Value: TParams): Boolean;
 
 Var
   I : Integer;
@@ -187,12 +188,12 @@
     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
@@ -199,16 +200,17 @@
     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;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,True,True,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;
@@ -215,10 +217,20 @@
     rs : string;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
+function TParams.ParseMacroSQL(SQL: String; DoCreate, EscapeSlash,
+  EscapeRepeat: Boolean; ParameterStyle: TParamStyle; MacroChar: Char): String;
+var pb : TParamBinding;
+    rs : string;
+begin
+  FMacroChar := MacroChar;
+  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
+end;
+
+function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
   EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
   ParamBinding: TParambinding): String;
 
@@ -225,6 +237,7 @@
 var rs : string;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
 end;
 
@@ -274,7 +287,7 @@
   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;
 
@@ -288,7 +301,7 @@
   ParamAllocStepSize = 8;
 
 var
-  IgnorePart:boolean;
+  IgnorePart, UseMacroChar:boolean;
   p,ParamNameStart,BufStart:PChar;
   ParamName:string;
   QuestionMarkParamCount,ParameterIndex,NewLength:integer;
@@ -301,10 +314,10 @@
   NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
   b:integer;
   tmpParam:TParam;
-
 begin
   if DoCreate then Clear;
   // Parse the SQL and build ParamBinding
+  UseMacroChar := (FMacroChar <> ' ');
   ParamCount:=0;
   NewQueryLength:=Length(SQL);
   SetLength(ParamPart,ParamAllocStepSize);
@@ -319,11 +332,10 @@
   BufStart:=p; // used to calculate ParamPart.Start values
   repeat
     while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
-    case p^ of
-      ':','?': // parameter
+    if (not UseMacroChar and (( p^ = ':') or ( p^ = '?' ))) or ( UseMacroChar and ( p^ = FMacroChar ) ) then // parameter
         begin
           IgnorePart := False;
-          if p^=':' then
+          if ( p^=':' ) or ( UseMacroChar and ( p^ = FMacroChar ) ) then
           begin // find parameter name
             Inc(p);
             if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
@@ -405,11 +417,12 @@
             // 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);
@@ -460,10 +473,11 @@
     NewQuery:=SQL;
 
   Result := NewQuery;
+  FMacroChar := ' ';
 end;
 
 
-Procedure TParams.RemoveParam(Value: TParam);
+procedure TParams.RemoveParam(Value: TParam);
 begin
    Value.Collection:=Nil;
 end;
@@ -1199,7 +1213,7 @@
 end;
 
 
-Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
+procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
   CopyBound: Boolean);
 
 Var
Index: fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp
===================================================================
--- fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(revision 42942)
+++ fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(working copy)
@@ -78,7 +78,7 @@
   detRollBack    = sqltypes.detRollBack; 
   detParamValue  = sqltypes.detParamValue; 
   detActualSQL   = sqltypes.detActualSQL;
-
+  DefaultMacroChar     = '%';
 Type
   TRowsCount = LargeInt;
 
@@ -361,6 +361,9 @@
     FDatabase: TSQLConnection;
     FParamCheck: Boolean;
     FParams: TParams;
+    FMacroCheck: Boolean;
+    FMacroChar: Char;
+    FMacros: TParams;
     FSQL: TStrings;
     FOrigSQL : String;
     FServerSQL : String;
@@ -368,10 +371,15 @@
     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 @@
     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 @@
     Property DataSource;
     Property ParamCheck;
     Property Params;
+    Property MacroCheck;
+    Property Macros;
     Property ParseSQL;
     Property SQL;
     Property Transaction;
@@ -484,8 +497,11 @@
     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 @@
     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 @@
     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 @@
     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 @@
     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 @@
     Property Options;
     property Params;
     Property ParamCheck;
+    property Macros;
+    Property MacroCheck;
+    Property MacroChar;
     property ParseSQL;
     property UpdateMode;
     property UsePrimaryKeyAsKey;
@@ -891,6 +917,7 @@
 
 begin
   UnPrepare;
+  RecreateMacros;
   if not ParamCheck then
     exit;
   if assigned(DataBase) then
@@ -927,6 +954,20 @@
     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,27 @@
     end;
 end;
 
+procedure TCustomSQLStatement.RecreateMacros;
+var
+  NewParams: TSQLDBParams;
+  ConnOptions: TConnOptions;
+begin
+  if MacroCheck then begin
+    if assigned(DataBase) then
+      ConnOptions:=DataBase.ConnOptions
+    else
+      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
+    NewParams := CreateParams;
+    try
+      NewParams.ParseMacroSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase, MacroChar);
+      NewParams.AssignValues(FMacros);
+      FMacros.Assign(NewParams);
+    finally
+      NewParams.Free;
+    end;
+  end;
+end;
+
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 begin
@@ -951,7 +1013,7 @@
   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,6 +1025,12 @@
   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;
@@ -969,7 +1037,7 @@
   FSQL.Assign(AValue);
 end;
 
-Procedure TCustomSQLStatement.DoExecute;
+procedure TCustomSQLStatement.DoExecute;
 begin
   FRowsAffected:=-1;
   If (FParams.Count>0) and Assigned(DataSource) then
@@ -979,27 +1047,27 @@
   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 +1103,9 @@
   TStringList(FSQL).OnChange:=@OnChangeSQL;
   FParams:=CreateParams;
   FParamCheck:=True;
+  FMacros:=CreateParams;
+  FMacroChar:=DefaultMacroChar;
+  FMacroCheck:=False;
   FParseSQL:=True;
   FRowsAffected:=-1;
 end;
@@ -1047,27 +1118,28 @@
   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 +1164,49 @@
     DataBase.DeAllocateCursorHandle(FCursor);
 end;
 
+function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
+var
+  Param: TParam;
+  I: Integer;
+  Ch : Char;
+  TermArr : Set of Char;
+  TempStr, TempMacroName : String;
+  MacroFlag : Boolean;
+begin
+Result := OrigSQL;
+if not MacroCheck then Exit;
+
+TermArr := SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'] +[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 Ch In TermArr then begin
+       Param := Macros.FindParam( TempMacroName );
+       if Assigned( Param ) then begin
+         Result := Result + Param.AsString;
+         end
+       else
+         Result := Result + MacroChar + TempMacroName;
+       if Ch <> MacroChar then
+         MacroFlag := False;
+       TempMacroName := '';
+       end
+      else
+        TempMacroName := TempMacroName + Ch;
+      end;
+  if not MacroFlag then
+    Result := Result + Ch;
+
+  end;
+Result := Result + ifthen (TempMacroName<>'',MacroChar+TempMacroName, '' );
+end;
+
 procedure TCustomSQLStatement.DoPrepare;
 
 var
@@ -1103,7 +1218,7 @@
     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 +1229,7 @@
   Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
 end;
 
-Procedure TCustomSQLStatement.Prepare;
+procedure TCustomSQLStatement.Prepare;
 
 begin
   if Prepared then exit;
@@ -1133,7 +1248,7 @@
   end;
 end;
 
-Procedure TCustomSQLStatement.Execute;
+procedure TCustomSQLStatement.Execute;
 begin
   Prepare;
   DoExecute;
@@ -1160,7 +1275,7 @@
     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 +1284,7 @@
     DoUnprepare;
 end;
 
-function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
+function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
 begin
   Result:=FParams.ParamByName(AParamName);
 end;
@@ -2485,7 +2600,8 @@
 
 { TCustomSQLQuery }
 
-Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
+function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
+  ): TCustomSQLStatement;
 
 begin
   Result:=TQuerySQLStatement.Create(Self);
@@ -2542,6 +2658,11 @@
   Result:=Params.ParamByName(AParamName);
 end;
 
+function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
+begin
+  Result:=Macros.ParamByName(AParamName);
+end;
+
 procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
 
 begin
@@ -2699,10 +2820,13 @@
 procedure TCustomSQLQuery.ApplyFilter;
 
 begin
+  FreeFldBuffers;
   FStatement.Unprepare;
+  FIsEOF := False;
+  inherited InternalClose;
   FStatement.DoPrepare;
   FStatement.DoExecute;
-  InternalRefresh;
+  inherited InternalOpen;
   First;
 end;
 
@@ -2761,6 +2885,11 @@
      SQLConnection.FreeFldBuffers(Cursor);
 end;
 
+function TCustomSQLQuery.GetMacroChar: Char;
+begin
+  Result := FStatement.MacroChar;
+end;
+
 function TCustomSQLQuery.GetParamCheck: Boolean;
 begin
   Result:=FStatement.ParamCheck;
@@ -2771,6 +2900,16 @@
   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;
@@ -3059,6 +3198,11 @@
     end
 end;
 
+procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
+begin
+  FStatement.MacroChar:=AValue;
+end;
+
 function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
 
 begin
@@ -3185,6 +3329,11 @@
   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;
@@ -3230,6 +3379,11 @@
   FStatement.Params.Assign(AValue);
 end;
 
+procedure TCustomSQLQuery.SetMacros(AValue: TParams);
+begin
+  FStatement.Macros.Assign(AValue);
+end;
+
 procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var
macroimpl.diff (23,007 bytes)

Zdravko Gabrovski

2019-09-08 12:55

reporter   ~0117991

New fixes, fix some final bugs and apply right patch with svn update

macroimpl-2.diff (23,162 bytes)
Index: fpcsrc/packages/fcl-db/src/base/db.pas
===================================================================
--- fpcsrc/packages/fcl-db/src/base/db.pas	(revision 42945)
+++ fpcsrc/packages/fcl-db/src/base/db.pas	(working copy)
@@ -1300,6 +1300,7 @@
   TParams = class(TCollection)
   private
     FOwner: TPersistent;
+    FMacroChar : Char;
     Function  GetItem(Index: Integer): TParam;
     Function  GetParamValue(const ParamName: string): Variant;
     Procedure SetItem(Index: Integer; Value: TParam);
@@ -1323,6 +1324,7 @@
     Function  ParamByName(const Value: string): TParam;
     Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
+    Function  ParseMacroSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle;MacroChar:Char): 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;
     Procedure RemoveParam(Value: TParam);
Index: fpcsrc/packages/fcl-db/src/base/dsparams.inc
===================================================================
--- fpcsrc/packages/fcl-db/src/base/dsparams.inc	(revision 42945)
+++ fpcsrc/packages/fcl-db/src/base/dsparams.inc	(working copy)
@@ -44,27 +44,27 @@
 
 { 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);
+procedure TParams.AssignTo(Dest: TPersistent);
 begin
  if (Dest is TParams) then
    TParams(Dest).Assign(Self)
@@ -72,7 +72,7 @@
    inherited AssignTo(Dest);
 end;
 
-Function TParams.GetDataSet: TDataSet;
+function TParams.GetDataSet: TDataSet;
 begin
   If (FOwner is TDataset) Then
     Result:=TDataset(FOwner)
@@ -80,40 +80,41 @@
     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);
   FOwner:=AOwner;
+  FMacroChar := ' ';
 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 +130,7 @@
     end;
 end;
 
-Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
+function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
   ParamType: TParamType): TParam;
 
 begin
@@ -139,7 +140,7 @@
   Result.ParamType:=ParamType;
 end;
 
-Function TParams.FindParam(const Value: string): TParam;
+function TParams.FindParam(const Value: string): TParam;
 
 Var
   I : Integer;
@@ -154,7 +155,7 @@
       Dec(i);
 end;
 
-Procedure TParams.GetParamList(List: TList; const ParamNames: string);
+procedure TParams.GetParamList(List: TList; const ParamNames: string);
 
 Var
   P: TParam;
@@ -172,7 +173,7 @@
   until StrPos > Length(ParamNames);
 end;
 
-Function TParams.IsEqual(Value: TParams): Boolean;
+function TParams.IsEqual(Value: TParams): Boolean;
 
 Var
   I : Integer;
@@ -187,12 +188,12 @@
     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
@@ -199,16 +200,17 @@
     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;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,True,True,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;
@@ -215,10 +217,20 @@
     rs : string;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
+function TParams.ParseMacroSQL(SQL: String; DoCreate, EscapeSlash,
+  EscapeRepeat: Boolean; ParameterStyle: TParamStyle; MacroChar: Char): String;
+var pb : TParamBinding;
+    rs : string;
+begin
+  FMacroChar := MacroChar;
+  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
+end;
+
+function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
   EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
   ParamBinding: TParambinding): String;
 
@@ -225,6 +237,7 @@
 var rs : string;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
 end;
 
@@ -274,7 +287,7 @@
   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;
 
@@ -288,7 +301,7 @@
   ParamAllocStepSize = 8;
 
 var
-  IgnorePart:boolean;
+  IgnorePart, UseMacroChar:boolean;
   p,ParamNameStart,BufStart:PChar;
   ParamName:string;
   QuestionMarkParamCount,ParameterIndex,NewLength:integer;
@@ -301,10 +314,10 @@
   NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
   b:integer;
   tmpParam:TParam;
-
 begin
   if DoCreate then Clear;
   // Parse the SQL and build ParamBinding
+  UseMacroChar := (FMacroChar <> ' ');
   ParamCount:=0;
   NewQueryLength:=Length(SQL);
   SetLength(ParamPart,ParamAllocStepSize);
@@ -319,11 +332,10 @@
   BufStart:=p; // used to calculate ParamPart.Start values
   repeat
     while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
-    case p^ of
-      ':','?': // parameter
+    if (not UseMacroChar and (( p^ = ':') or ( p^ = '?' ))) or ( UseMacroChar and ( p^ = FMacroChar ) ) then // parameter
         begin
           IgnorePart := False;
-          if p^=':' then
+          if ( p^=':' ) or ( UseMacroChar and ( p^ = FMacroChar ) ) then
           begin // find parameter name
             Inc(p);
             if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
@@ -405,11 +417,12 @@
             // 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);
@@ -460,10 +473,11 @@
     NewQuery:=SQL;
 
   Result := NewQuery;
+  FMacroChar := ' ';
 end;
 
 
-Procedure TParams.RemoveParam(Value: TParam);
+procedure TParams.RemoveParam(Value: TParam);
 begin
    Value.Collection:=Nil;
 end;
@@ -1199,7 +1213,7 @@
 end;
 
 
-Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
+procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
   CopyBound: Boolean);
 
 Var
Index: fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp
===================================================================
--- fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(revision 42945)
+++ fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(working copy)
@@ -78,7 +78,7 @@
   detRollBack    = sqltypes.detRollBack; 
   detParamValue  = sqltypes.detParamValue; 
   detActualSQL   = sqltypes.detActualSQL;
-
+  DefaultMacroChar     = '%';
 Type
   TRowsCount = LargeInt;
 
@@ -361,6 +361,9 @@
     FDatabase: TSQLConnection;
     FParamCheck: Boolean;
     FParams: TParams;
+    FMacroCheck: Boolean;
+    FMacroChar: Char;
+    FMacros: TParams;
     FSQL: TStrings;
     FOrigSQL : String;
     FServerSQL : String;
@@ -368,10 +371,15 @@
     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 @@
     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 @@
     Property DataSource;
     Property ParamCheck;
     Property Params;
+    Property MacroCheck;
+    Property Macros;
     Property ParseSQL;
     Property SQL;
     Property Transaction;
@@ -484,8 +497,11 @@
     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 @@
     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 @@
     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 @@
     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 @@
     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 @@
     Property Options;
     property Params;
     Property ParamCheck;
+    property Macros;
+    Property MacroCheck;
+    Property MacroChar;
     property ParseSQL;
     property UpdateMode;
     property UsePrimaryKeyAsKey;
@@ -891,6 +917,7 @@
 
 begin
   UnPrepare;
+  RecreateMacros;
   if not ParamCheck then
     exit;
   if assigned(DataBase) then
@@ -927,6 +954,20 @@
     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,27 @@
     end;
 end;
 
+procedure TCustomSQLStatement.RecreateMacros;
+var
+  NewParams: TSQLDBParams;
+  ConnOptions: TConnOptions;
+begin
+  if MacroCheck then begin
+    if assigned(DataBase) then
+      ConnOptions:=DataBase.ConnOptions
+    else
+      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
+    NewParams := CreateParams;
+    try
+      NewParams.ParseMacroSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase, MacroChar);
+      NewParams.AssignValues(FMacros);
+      FMacros.Assign(NewParams);
+    finally
+      NewParams.Free;
+    end;
+  end;
+end;
+
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 begin
@@ -951,7 +1013,7 @@
   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 +1025,20 @@
   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 +1048,27 @@
   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 +1104,9 @@
   TStringList(FSQL).OnChange:=@OnChangeSQL;
   FParams:=CreateParams;
   FParamCheck:=True;
+  FMacros:=CreateParams;
+  FMacroChar:=DefaultMacroChar;
+  FMacroCheck:=False;
   FParseSQL:=True;
   FRowsAffected:=-1;
 end;
@@ -1047,27 +1119,28 @@
   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 +1165,57 @@
     DataBase.DeAllocateCursorHandle(FCursor);
 end;
 
+function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
+var
+  Param: TParam;
+  I: Integer;
+  Ch : Char;
+  TermArr : Set of Char;
+  TempStr, TempMacroName : String;
+  MacroFlag : Boolean;
+begin
+Result := OrigSQL;
+if not MacroCheck then Exit;
+
+TermArr := SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'] +[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 Ch In TermArr then begin
+       Param := Macros.FindParam( TempMacroName );
+       if Assigned( Param ) then begin
+         Result := Result + Param.AsString;
+         end
+       else
+         Result := Result + MacroChar + TempMacroName;
+       if Ch <> MacroChar then
+         MacroFlag := False;
+       TempMacroName := '';
+       end
+      else
+        TempMacroName := TempMacroName + Ch;
+      end;
+  if not MacroFlag then
+    Result := Result + Ch;
+
+  end;
+
+if TempMacroName<>'' then begin
+  Param := Macros.FindParam( TempMacroName );
+  if Assigned( Param ) then begin
+    Result := Result + Param.AsString;
+    end
+  else
+    Result := Result + MacroChar + TempMacroName;
+  end;
+end;
+
 procedure TCustomSQLStatement.DoPrepare;
 
 var
@@ -1103,7 +1227,7 @@
     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 +1238,7 @@
   Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
 end;
 
-Procedure TCustomSQLStatement.Prepare;
+procedure TCustomSQLStatement.Prepare;
 
 begin
   if Prepared then exit;
@@ -1133,7 +1257,7 @@
   end;
 end;
 
-Procedure TCustomSQLStatement.Execute;
+procedure TCustomSQLStatement.Execute;
 begin
   Prepare;
   DoExecute;
@@ -1160,7 +1284,7 @@
     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 +1293,7 @@
     DoUnprepare;
 end;
 
-function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
+function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
 begin
   Result:=FParams.ParamByName(AParamName);
 end;
@@ -2487,7 +2611,8 @@
 
 { TCustomSQLQuery }
 
-Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
+function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
+  ): TCustomSQLStatement;
 
 begin
   Result:=TQuerySQLStatement.Create(Self);
@@ -2544,6 +2669,11 @@
   Result:=Params.ParamByName(AParamName);
 end;
 
+function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
+begin
+  Result:=Macros.ParamByName(AParamName);
+end;
+
 procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
 
 begin
@@ -2701,10 +2831,13 @@
 procedure TCustomSQLQuery.ApplyFilter;
 
 begin
+  FreeFldBuffers;
   FStatement.Unprepare;
+  FIsEOF := False;
+  inherited InternalClose;
   FStatement.DoPrepare;
   FStatement.DoExecute;
-  InternalRefresh;
+  inherited InternalOpen;
   First;
 end;
 
@@ -2763,6 +2896,11 @@
      SQLConnection.FreeFldBuffers(Cursor);
 end;
 
+function TCustomSQLQuery.GetMacroChar: Char;
+begin
+  Result := FStatement.MacroChar;
+end;
+
 function TCustomSQLQuery.GetParamCheck: Boolean;
 begin
   Result:=FStatement.ParamCheck;
@@ -2773,6 +2911,16 @@
   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;
@@ -3061,6 +3209,11 @@
     end
 end;
 
+procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
+begin
+  FStatement.MacroChar:=AValue;
+end;
+
 function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
 
 begin
@@ -3187,6 +3340,11 @@
   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;
@@ -3232,6 +3390,11 @@
   FStatement.Params.Assign(AValue);
 end;
 
+procedure TCustomSQLQuery.SetMacros(AValue: TParams);
+begin
+  FStatement.Macros.Assign(AValue);
+end;
+
 procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var
macroimpl-2.diff (23,162 bytes)
allfilesmacroimpl-2.7z (41,651 bytes)

Thaddy de Koning

2019-09-08 16:38

reporter   ~0117996

Does not work for me on Raspbian armhf *at all*
Had to revert.
Plz incude some tests.

Zdravko Gabrovski

2019-09-08 19:39

reporter   ~0117998

Please, find attached test project.
Create some Firedird BD with a table, called "paytable" and field "payid".
Set firebird connection to point to FB database created.
Run the program and press button1.

MacroImplementationProject.zip (2,551 bytes)

Zdravko Gabrovski

2019-09-08 19:42

reporter   ~0117999

I did a tests under Ubuntu x86_64 and win64, everything seems to be OK.

Michael Van Canneyt

2019-09-09 08:50

administrator   ~0118001

@Thaddy, can you post an example of something that does not work for you ?

Zdravko Gabrovski

2019-09-10 10:26

reporter   ~0118015

Please, find attached a new test example, without gui.
Just point in Datamodule1.IBConnection1.database property to any of your firebird database.

ConsoleTestApp.zip (2,877 bytes)

Zdravko Gabrovski

2019-09-12 14:25

reporter  

macroimpl-3.diff (23,162 bytes)
Index: fpcsrc/packages/fcl-db/src/base/db.pas
===================================================================
--- fpcsrc/packages/fcl-db/src/base/db.pas	(revision 42976)
+++ fpcsrc/packages/fcl-db/src/base/db.pas	(working copy)
@@ -1301,6 +1301,7 @@
   TParams = class(TCollection)
   private
     FOwner: TPersistent;
+    FMacroChar : Char;
     Function  GetItem(Index: Integer): TParam;
     Function  GetParamValue(const ParamName: string): Variant;
     Procedure SetItem(Index: Integer; Value: TParam);
@@ -1324,6 +1325,7 @@
     Function  ParamByName(const Value: string): TParam;
     Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
+    Function  ParseMacroSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle;MacroChar:Char): 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;
     Procedure RemoveParam(Value: TParam);
Index: fpcsrc/packages/fcl-db/src/base/dsparams.inc
===================================================================
--- fpcsrc/packages/fcl-db/src/base/dsparams.inc	(revision 42976)
+++ fpcsrc/packages/fcl-db/src/base/dsparams.inc	(working copy)
@@ -44,27 +44,27 @@
 
 { 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);
+procedure TParams.AssignTo(Dest: TPersistent);
 begin
  if (Dest is TParams) then
    TParams(Dest).Assign(Self)
@@ -72,7 +72,7 @@
    inherited AssignTo(Dest);
 end;
 
-Function TParams.GetDataSet: TDataSet;
+function TParams.GetDataSet: TDataSet;
 begin
   If (FOwner is TDataset) Then
     Result:=TDataset(FOwner)
@@ -80,40 +80,41 @@
     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);
   FOwner:=AOwner;
+  FMacroChar := ' ';
 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 +130,7 @@
     end;
 end;
 
-Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
+function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
   ParamType: TParamType): TParam;
 
 begin
@@ -139,7 +140,7 @@
   Result.ParamType:=ParamType;
 end;
 
-Function TParams.FindParam(const Value: string): TParam;
+function TParams.FindParam(const Value: string): TParam;
 
 Var
   I : Integer;
@@ -154,7 +155,7 @@
       Dec(i);
 end;
 
-Procedure TParams.GetParamList(List: TList; const ParamNames: string);
+procedure TParams.GetParamList(List: TList; const ParamNames: string);
 
 Var
   P: TParam;
@@ -172,7 +173,7 @@
   until StrPos > Length(ParamNames);
 end;
 
-Function TParams.IsEqual(Value: TParams): Boolean;
+function TParams.IsEqual(Value: TParams): Boolean;
 
 Var
   I : Integer;
@@ -187,12 +188,12 @@
     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
@@ -199,16 +200,17 @@
     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;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,True,True,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;
@@ -215,10 +217,20 @@
     rs : string;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
+function TParams.ParseMacroSQL(SQL: String; DoCreate, EscapeSlash,
+  EscapeRepeat: Boolean; ParameterStyle: TParamStyle; MacroChar: Char): String;
+var pb : TParamBinding;
+    rs : string;
+begin
+  FMacroChar := MacroChar;
+  Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
+end;
+
+function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash,
   EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out
   ParamBinding: TParambinding): String;
 
@@ -225,6 +237,7 @@
 var rs : string;
 
 begin
+  FMacroChar := ' ';
   Result := ParseSQL(SQL,DoCreate,EscapeSlash, EscapeRepeat, ParameterStyle,ParamBinding, rs);
 end;
 
@@ -274,7 +287,7 @@
   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;
 
@@ -288,7 +301,7 @@
   ParamAllocStepSize = 8;
 
 var
-  IgnorePart:boolean;
+  IgnorePart, UseMacroChar:boolean;
   p,ParamNameStart,BufStart:PChar;
   ParamName:string;
   QuestionMarkParamCount,ParameterIndex,NewLength:integer;
@@ -301,10 +314,10 @@
   NewQueryIndex,BufIndex,CopyLen,i:integer;    // Parambinding will have length ParamCount in the end
   b:integer;
   tmpParam:TParam;
-
 begin
   if DoCreate then Clear;
   // Parse the SQL and build ParamBinding
+  UseMacroChar := (FMacroChar <> ' ');
   ParamCount:=0;
   NewQueryLength:=Length(SQL);
   SetLength(ParamPart,ParamAllocStepSize);
@@ -319,11 +332,10 @@
   BufStart:=p; // used to calculate ParamPart.Start values
   repeat
     while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
-    case p^ of
-      ':','?': // parameter
+    if (not UseMacroChar and (( p^ = ':') or ( p^ = '?' ))) or ( UseMacroChar and ( p^ = FMacroChar ) ) then // parameter
         begin
           IgnorePart := False;
-          if p^=':' then
+          if ( p^=':' ) or ( UseMacroChar and ( p^ = FMacroChar ) ) then
           begin // find parameter name
             Inc(p);
             if p^ in [':','=',' '] then  // ignore ::, since some databases uses this as a cast (wb 4813)
@@ -405,11 +417,12 @@
             // 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);
@@ -460,10 +473,11 @@
     NewQuery:=SQL;
 
   Result := NewQuery;
+  FMacroChar := ' ';
 end;
 
 
-Procedure TParams.RemoveParam(Value: TParam);
+procedure TParams.RemoveParam(Value: TParam);
 begin
    Value.Collection:=Nil;
 end;
@@ -1199,7 +1213,7 @@
 end;
 
 
-Procedure TParams.CopyParamValuesFromDataset(ADataSet: TDataSet;
+procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset;
   CopyBound: Boolean);
 
 Var
Index: fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp
===================================================================
--- fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(revision 42976)
+++ fpcsrc/packages/fcl-db/src/sqldb/sqldb.pp	(working copy)
@@ -78,7 +78,7 @@
   detRollBack    = sqltypes.detRollBack; 
   detParamValue  = sqltypes.detParamValue; 
   detActualSQL   = sqltypes.detActualSQL;
-
+  DefaultMacroChar     = '%';
 Type
   TRowsCount = LargeInt;
 
@@ -361,6 +361,9 @@
     FDatabase: TSQLConnection;
     FParamCheck: Boolean;
     FParams: TParams;
+    FMacroCheck: Boolean;
+    FMacroChar: Char;
+    FMacros: TParams;
     FSQL: TStrings;
     FOrigSQL : String;
     FServerSQL : String;
@@ -368,10 +371,15 @@
     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 @@
     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 @@
     Property DataSource;
     Property ParamCheck;
     Property Params;
+    Property MacroCheck;
+    Property Macros;
     Property ParseSQL;
     Property SQL;
     Property Transaction;
@@ -484,8 +497,11 @@
     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 @@
     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 @@
     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 @@
     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 @@
     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 @@
     Property Options;
     property Params;
     Property ParamCheck;
+    property Macros;
+    Property MacroCheck;
+    Property MacroChar;
     property ParseSQL;
     property UpdateMode;
     property UsePrimaryKeyAsKey;
@@ -891,6 +917,7 @@
 
 begin
   UnPrepare;
+  RecreateMacros;
   if not ParamCheck then
     exit;
   if assigned(DataBase) then
@@ -927,6 +954,20 @@
     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,27 @@
     end;
 end;
 
+procedure TCustomSQLStatement.RecreateMacros;
+var
+  NewParams: TSQLDBParams;
+  ConnOptions: TConnOptions;
+begin
+  if MacroCheck then begin
+    if assigned(DataBase) then
+      ConnOptions:=DataBase.ConnOptions
+    else
+      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
+    NewParams := CreateParams;
+    try
+      NewParams.ParseMacroSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase, MacroChar);
+      NewParams.AssignValues(FMacros);
+      FMacros.Assign(NewParams);
+    finally
+      NewParams.Free;
+    end;
+  end;
+end;
+
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 begin
@@ -951,7 +1013,7 @@
   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 +1025,20 @@
   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 +1048,27 @@
   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 +1104,9 @@
   TStringList(FSQL).OnChange:=@OnChangeSQL;
   FParams:=CreateParams;
   FParamCheck:=True;
+  FMacros:=CreateParams;
+  FMacroChar:=DefaultMacroChar;
+  FMacroCheck:=False;
   FParseSQL:=True;
   FRowsAffected:=-1;
 end;
@@ -1047,27 +1119,28 @@
   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 +1165,57 @@
     DataBase.DeAllocateCursorHandle(FCursor);
 end;
 
+function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
+var
+  Param: TParam;
+  I: Integer;
+  Ch : Char;
+  TermArr : Set of Char;
+  TempStr, TempMacroName : String;
+  MacroFlag : Boolean;
+begin
+Result := OrigSQL;
+if not MacroCheck then Exit;
+
+TermArr := SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'] +[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 Ch In TermArr then begin
+       Param := Macros.FindParam( TempMacroName );
+       if Assigned( Param ) then begin
+         Result := Result + Param.AsString;
+         end
+       else
+         Result := Result + MacroChar + TempMacroName;
+       if Ch <> MacroChar then
+         MacroFlag := False;
+       TempMacroName := '';
+       end
+      else
+        TempMacroName := TempMacroName + Ch;
+      end;
+  if not MacroFlag then
+    Result := Result + Ch;
+
+  end;
+
+if TempMacroName<>'' then begin
+  Param := Macros.FindParam( TempMacroName );
+  if Assigned( Param ) then begin
+    Result := Result + Param.AsString;
+    end
+  else
+    Result := Result + MacroChar + TempMacroName;
+  end;
+end;
+
 procedure TCustomSQLStatement.DoPrepare;
 
 var
@@ -1103,7 +1227,7 @@
     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 +1238,7 @@
   Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
 end;
 
-Procedure TCustomSQLStatement.Prepare;
+procedure TCustomSQLStatement.Prepare;
 
 begin
   if Prepared then exit;
@@ -1133,7 +1257,7 @@
   end;
 end;
 
-Procedure TCustomSQLStatement.Execute;
+procedure TCustomSQLStatement.Execute;
 begin
   Prepare;
   DoExecute;
@@ -1160,7 +1284,7 @@
     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 +1293,7 @@
     DoUnprepare;
 end;
 
-function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
+function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
 begin
   Result:=FParams.ParamByName(AParamName);
 end;
@@ -2494,7 +2618,8 @@
 
 { TCustomSQLQuery }
 
-Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
+function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
+  ): TCustomSQLStatement;
 
 begin
   Result:=TQuerySQLStatement.Create(Self);
@@ -2551,6 +2676,11 @@
   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 +2838,13 @@
 procedure TCustomSQLQuery.ApplyFilter;
 
 begin
+  FreeFldBuffers;
   FStatement.Unprepare;
+  FIsEOF := False;
+  inherited InternalClose;
   FStatement.DoPrepare;
   FStatement.DoExecute;
-  InternalRefresh;
+  inherited InternalOpen;
   First;
 end;
 
@@ -2770,6 +2903,11 @@
      SQLConnection.FreeFldBuffers(Cursor);
 end;
 
+function TCustomSQLQuery.GetMacroChar: Char;
+begin
+  Result := FStatement.MacroChar;
+end;
+
 function TCustomSQLQuery.GetParamCheck: Boolean;
 begin
   Result:=FStatement.ParamCheck;
@@ -2780,6 +2918,16 @@
   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 +3216,11 @@
     end
 end;
 
+procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
+begin
+  FStatement.MacroChar:=AValue;
+end;
+
 function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
 
 begin
@@ -3194,6 +3347,11 @@
   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 +3397,11 @@
   FStatement.Params.Assign(AValue);
 end;
 
+procedure TCustomSQLQuery.SetMacros(AValue: TParams);
+begin
+  FStatement.Macros.Assign(AValue);
+end;
+
 procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var
macroimpl-3.diff (23,162 bytes)

Zdravko Gabrovski

2019-09-12 14:25

reporter   ~0118050

Diff file against last trunc (12.09)

allfilesmacroimpl-3.7z (41,684 bytes)

Bart Broersma

2019-09-12 19:13

reporter   ~0118054

There are numerous unrelated changes in the patch (lowercasing "Procedure" and "Function").
This pollutes the bugtracker.

Zdravko Gabrovski

2019-09-15 08:35

reporter   ~0118081

You are right, but how can I fix this? I did not rename any procedure in lowercase. I think that comes because I start to develop this a three weeks ago and in that moment given procedures names are in lowercase.
Before diff, I did it svn update, it shows nothing to merge. Is there any switch in svn to merge it in case sensitive mode?

Michael Van Canneyt

2019-09-15 12:17

administrator   ~0118082

Applied a modified version of the patch:
* The macrochar is no longer a property of the TParams instance, it is passed to the parsesql function.
* Refactored ParseSQL so now it takes a set of options instead of 3 booleans, added Usemacro option.
* Modified your example so it works without lazarus
* Added a test to the testsuite

Thanks for the patch !

Zdravko Gabrovski

2019-09-19 08:25

reporter   ~0118111

Many thanks for great work!

Issue History

Date Modified Username Field Change
2019-09-08 11:57 Zdravko Gabrovski New Issue
2019-09-08 11:57 Zdravko Gabrovski File Added: allfilesmacroimpl.7z
2019-09-08 11:57 Zdravko Gabrovski File Added: macroimpl.diff
2019-09-08 12:16 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-09-08 12:16 Michael Van Canneyt Status new => assigned
2019-09-08 12:55 Zdravko Gabrovski File Added: macroimpl-2.diff
2019-09-08 12:55 Zdravko Gabrovski File Added: allfilesmacroimpl-2.7z
2019-09-08 12:55 Zdravko Gabrovski Note Added: 0117991
2019-09-08 16:38 Thaddy de Koning Note Added: 0117996
2019-09-08 19:39 Zdravko Gabrovski File Added: MacroImplementationProject.zip
2019-09-08 19:39 Zdravko Gabrovski Note Added: 0117998
2019-09-08 19:42 Zdravko Gabrovski Note Added: 0117999
2019-09-09 08:50 Michael Van Canneyt Note Added: 0118001
2019-09-10 10:26 Zdravko Gabrovski File Added: ConsoleTestApp.zip
2019-09-10 10:26 Zdravko Gabrovski Note Added: 0118015
2019-09-12 14:25 Zdravko Gabrovski File Added: macroimpl-3.diff
2019-09-12 14:25 Zdravko Gabrovski File Added: allfilesmacroimpl-3.7z
2019-09-12 14:25 Zdravko Gabrovski Note Added: 0118050
2019-09-12 19:13 Bart Broersma Note Added: 0118054
2019-09-15 08:35 Zdravko Gabrovski Note Added: 0118081
2019-09-15 12:17 Michael Van Canneyt Status assigned => resolved
2019-09-15 12:17 Michael Van Canneyt Resolution open => fixed
2019-09-15 12:17 Michael Van Canneyt Fixed in Version => 4.0.0
2019-09-15 12:17 Michael Van Canneyt Fixed in Revision => 43003
2019-09-15 12:17 Michael Van Canneyt FPCTarget => -
2019-09-15 12:17 Michael Van Canneyt Note Added: 0118082
2019-09-19 08:25 Zdravko Gabrovski Status resolved => closed
2019-09-19 08:25 Zdravko Gabrovski Note Added: 0118111