fcl-db revs 42907,42933,42944,43001,43002,43003,43024,43033,43037,43039,43154,43156,46355,46356,46357

git-svn-id: branches/fixes_3_2@46834 -

.gitattributes

@@ -3073,6 +3073,8 @@ packages/fcl-db/examples/createsql.lpi svneol=native#text/plain
 packages/fcl-db/examples/createsql.pas svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpi svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpr svneol=native#text/plain
+packages/fcl-db/examples/demomacros.lpi svneol=native#text/plain
+packages/fcl-db/examples/demomacros.pp svneol=native#text/plain
 packages/fcl-db/examples/demotypesafeaccess.pp svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
 packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain

packages/dblib/src/dblib.pp

@@ -108,6 +108,7 @@ const
   // settings from here are purely FreeTDS extensions:
   DBSETUTF16   = 1001;
   DBSETNTLMV2  = 1002;
+  DBSETREADONLY= 1003;
 
   TIMEOUT_IGNORE=-1;
   TIMEOUT_INFINITE=0;
@@ -451,7 +452,7 @@ procedure dbwinexit;
 function dbsetlcharset(login:PLOGINREC; charset:PAnsiChar):RETCODE;
 function dbsetlsecure(login:PLOGINREC):RETCODE;
 function dbdatetimeallcrack(dta: PDBDATETIMEALL): TDateTime;
-function dbmoneytocurr(pdbmoney: PQWord): Currency;
+function dbmoneytocurr(pdbmoney: PQWord): Currency; inline;
 
 function InitialiseDBLib(const LibraryName : ansistring): integer;
 procedure ReleaseDBLib;
@@ -530,8 +531,6 @@ begin
    pointer(dbtds) := GetProcedureAddress(DBLibLibraryHandle,'dbtds');
    pointer(dbsetlversion) := GetProcedureAddress(DBLibLibraryHandle,'dbsetlversion');
    pointer(dbservcharset) := GetProcedureAddress(DBLibLibraryHandle,'dbservcharset');
-   //if not assigned(dbiscount) then
-   //  raise EInOutError.Create('Minimum supported version of FreeTDS client library is 0.91!');
    {$ENDIF}
    DBLibInit:=false;
   end;
@@ -641,13 +640,9 @@ begin
   Result := ComposeDateTime(Result, dta^.time/MSecsPerDay/10000 + dta^.offset/MinsPerDay);
 end;
 
-function dbmoneytocurr(pdbmoney: PQWord): Currency;
+function dbmoneytocurr(pdbmoney: PQWord): Currency; inline;
 begin
-{$IFDEF ENDIAN_LITTLE}
-  PQWord(@Result)^ := pdbmoney^ shr 32 or pdbmoney^ shl 32;
-{$ELSE}
-  move(pdbmoney^, Result, sizeof(Currency));
-{$ENDIF}
+  PQWord(@Result)^ := {$IFDEF ENDIAN_LITTLE}Swap(pdbmoney^){$ELSE}pdbmoney^{$ENDIF};
 end;
 
 {

packages/fcl-db/examples/demomacros.lpi

@@ -0,0 +1,58 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="demomacros"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="demomacros.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="macrotest"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="demomacros"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/demomacros.pp

@@ -0,0 +1,131 @@
+program macrotest;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, db, sqldb, ibconnection;
+
+type
+
+  { TTestMacroApp }
+
+  TTestMacroApp = class(TCustomApplication)
+    DB : TIBConnection;
+    TR : TSQLTransaction;
+    Q : TSQLQuery;
+  protected
+    Procedure SetupDatabase;
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp(aMsg : String); virtual;
+  end;
+
+{ TTestMacroApp }
+
+procedure TTestMacroApp.SetupDatabase;
+
+begin
+  DB:=TIBConnection.Create(Self);
+  TR:=TSQLTransaction.Create(Self);
+  With DB do
+    begin
+    Hostname:='localhost';
+    DatabaseName:=GetOptionValue('d','database');
+    if DatabaseName='' then
+      DatabaseName:='employees'; // Alias
+    UserName:=GetOptionValue('u','username');
+    if UserName='' then
+      UserName:='SYSDBA';
+    Password:=GetOptionValue('p','password');
+    if Password='' then
+      Password:='masterkey';
+    Charset:='UTF8';
+    DB.Transaction:=TR;
+    end;
+  Q:=TSQLQuery.Create(Self);
+  Q.Database:=DB;
+  Q.Transaction:=TR;
+  Q.SQL.Text:='Select * from ('+sLineBreak+
+      '  Select 1 as id from rdb$database'+sLineBreak+
+      '  union all'+sLineBreak+
+      '  Select 2 as id from rdb$database'+sLineBreak+
+      '  )'+sLineBreak+
+      '%WHERE_CL' +sLineBreak+
+      '%ORDER_CL' +sLineBreak;
+  Q.MacroCheck:=true;
+  Q.MacroByName('WHERE_CL').AsString:='where 1=1';
+  Q.MacroByName('ORDER_CL').AsString:='order by 1';
+end;
+
+procedure TTestMacroApp.DoRun;
+var
+  ErrorMsg: String;
+
+begin
+  Terminate;
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hd:u:p:', ['help','database:','user:','password:']);
+  if (ErrorMsg<>'') or HasOption('h','help') then
+    begin
+    WriteHelp(ErrorMsg);
+    Exit;
+    end;
+  SetupDatabase;
+  With Q do
+    begin
+    WriteLn( 'Execution of SQL Statement :' + LineEnding+LineEnding+SQl.Text );
+    Writeln('Initial macro values:');
+    WriteLn( '%WHERE_CL = "'+MacroByName('WHERE_CL').AsString+'"');
+    WriteLn( '%ORDER_CL = "'+MacroByName('ORDER_CL').AsString+'"');
+    Writeln;
+    Open;
+    Writeln( 'First field value (expect "1") using default macro order (with default order by clause): '+Fields[0].AsString);
+    Writeln;
+    Close;
+    MacroByName('ORDER_CL').AsString := 'Order by 1 DESC';
+    WriteLn('Set new value to %ORDER_CL = "'+MacroByName('ORDER_CL').AsString+'"');
+    Writeln;
+    Open;
+    WriteLn('First field value (expect "2") using new macro order (after new order by clause): '+Fields[0].AsString);
+    Writeln;
+    Close;
+    end;
+  // stop program loop
+  Terminate;
+end;
+
+constructor TTestMacroApp.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TTestMacroApp.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TTestMacroApp.WriteHelp(aMsg : string);
+begin
+  if AMsg<>'' then
+    Writeln('Error: ',aMsg);
+  { add your help code here }
+  writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help         this text');
+  Writeln('-d --database=DB  Name of firebird database to connect to');
+  Writeln('-u --user=Name    Name of user to connect with');
+  Writeln('-p --password=PW  Password of user to connect with');
+end;
+
+var
+  Application: TTestMacroApp;
+begin
+  Application:=TTestMacroApp.Create(nil);
+  Application.Title:='Macro test application';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-db/src/base/db.pas

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

packages/fcl-db/src/base/dsparams.inc

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

packages/fcl-db/src/base/fields.inc

@@ -177,7 +177,8 @@ end;
 function TFieldDef.GetCharSize: Word;
 begin
   case FDataType of
-   ftGUID: Result:=1;
+   ftGuid:
+     Result := 1;
    ftString, ftFixedChar:
      case FCodePage of
        CP_UTF8: Result := 4;
@@ -3349,11 +3350,6 @@ begin
   SetAsString(GuidToString(AValue));
 end;
 
-function TVariantField.GetDefaultWidth: Integer;
-begin
-  Result := 15;
-end;
-
 { TVariantField }
 
 constructor TVariantField.Create(AOwner: TComponent);
@@ -3367,6 +3363,11 @@ begin
   { empty }
 end;
 
+function TVariantField.GetDefaultWidth: Integer;
+begin
+  Result := 15;
+end;
+
 function TVariantField.GetAsBoolean: Boolean;
 begin
   Result := GetAsVariant;

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -876,6 +876,11 @@ begin
     ftGuid:
       begin
       desttype:=SQLCHAR;
+      dest[ 0]:=Ord('{');
+      dest[37]:=Ord('}');
+      dest[38]:=0; //strings must be null-terminated
+      Inc(dest);
+      destlen:=36;
       end;
     ftMemo,
     ftBlob:
@@ -892,7 +897,7 @@ begin
 
   case FieldDef.DataType of
     ftString, ftFixedChar:
-      PAnsiChar(dest + datalen)^ := #0; //strings must be null-terminated
+      dest[datalen] := 0; //strings must be null-terminated
     ftDate, ftTime, ftDateTime:
       if desttype = SYBMSDATETIME2 then
         PDateTime(buffer)^ := dbdatetimeallcrack(@dbdta)

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -595,6 +595,7 @@ begin
     FPreparedStatement:=Buf;
     if assigned(AParams) and (AParams.count > 0) then
       FPreparedStatement := AParams.ParseSQL(FPreparedStatement,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psSimulated,paramBinding,ParamReplaceString);
+    FPrepared:=True;
     end
 end;
 

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -760,7 +760,11 @@ begin
 
   // Parse the SQL and build FParamIndex
   if assigned(AParams) and (AParams.count > 0) then
+    begin
     buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase,ODBCCursor.FParamIndex);
+    if LogEvent(detActualSQL) then
+      Log(detActualSQL,Buf);
+    end;
 
   // prepare statement
   ODBCCursor.FQuery:=Buf;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -883,6 +883,7 @@ begin
   with (cursor as TPQCursor) do
     begin
     FPrepared := False;
+    FDirect := False;
     // Prior to v8 there is no support for cursors and parameters.
     // So that's not supported.
     if FStatementType in [stInsert,stUpdate,stDelete, stSelect] then
@@ -930,8 +931,6 @@ begin
         buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL);
         end;
       s := s + ' as ' + buf;
-      if LogEvent(detPrepare) then
-        Log(detPrepare,S);
       if LogEvent(detActualSQL) then
         Log(detActualSQL,S);
       res := PQexec(tr.PGConn,pchar(s));
@@ -948,7 +947,13 @@ begin
       FPrepared := True;
       end
     else
-      Statement := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL);
+      begin
+      if Assigned(AParams) then
+        Statement := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psPostgreSQL)
+      else
+        Statement:=Buf;
+      FDirect:=True;
+      end;
     end;
 end;
 
@@ -994,6 +999,7 @@ var ar  : array of PAnsiChar;
 begin
   with cursor as TPQCursor do
     begin
+    CurTuple:=-1;
     PQclear(res);
     if FStatementType in [stInsert,stUpdate,stDelete,stSelect] then
       begin

packages/fcl-db/src/sqldb/sqldb.pp

@@ -78,7 +78,7 @@ const
   detRollBack    = sqltypes.detRollBack; 
   detParamValue  = sqltypes.detParamValue; 
   detActualSQL   = sqltypes.detActualSQL;
-
+  DefaultMacroChar     = '%';
 Type
   TRowsCount = LargeInt;
 
@@ -104,6 +104,7 @@ Type
 
   TSQLCursor = Class(TSQLHandle)
   public
+    FDirect        : Boolean;
     FPrepared      : Boolean;
     FSelectable    : Boolean;
     FInitFieldDef  : Boolean;
@@ -362,18 +363,29 @@ type
     FDatabase: TSQLConnection;
     FParamCheck: Boolean;
     FParams: TParams;
+    FMacroCheck: Boolean;
+    FMacroChar: Char;
+    FMacros: TParams;
     FSQL: TStrings;
     FOrigSQL : String;
     FServerSQL : String;
     FTransaction: TSQLTransaction;
     FParseSQL: Boolean;
+    FDoUnPrepare : 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;
+    Procedure CheckUnprepare;
+    Procedure CheckPrepare;
   Protected
     Function CreateDataLink : TDataLink; virtual;
     procedure OnChangeSQL(Sender : TObject); virtual;
@@ -399,9 +411,12 @@ type
     Property Transaction : TSQLTransaction Read FTransaction Write SetTransaction;
     Property SQL : TStrings Read FSQL Write SetSQL;
     Property Params : TParams Read FParams Write SetParams;
+    Property Macros : TParams Read FMacros Write SetMacros;
+    property MacroChar: Char read FMacroChar write SetMacroChar default DefaultMacroChar;
     Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
     Property ParseSQL : Boolean Read FParseSQL Write FParseSQL;
     Property ParamCheck : Boolean Read FParamCheck Write FParamCheck default true;
+    Property MacroCheck : Boolean Read FMacroCheck Write SetMacroCheck default false;
   Public
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
@@ -419,6 +434,8 @@ type
     Property DataSource;
     Property ParamCheck;
     Property Params;
+    Property MacroCheck;
+    Property Macros;
     Property ParseSQL;
     Property SQL;
     Property Transaction;
@@ -468,12 +485,12 @@ type
     FIsEOF               : boolean;
     FLoadingFieldDefs    : boolean;
     FUpdateMode          : TUpdateMode;
+    FDoUnprepare : Boolean;
     FusePrimaryKeyAsKey  : Boolean;
     FWhereStartPos       : integer;
     FWhereStopPos        : integer;
     FServerFilterText    : string;
     FServerFiltered      : Boolean;
-
     FServerIndexDefs     : TServerIndexDefs;
 
     // Used by SetSchemaType
@@ -484,9 +501,14 @@ type
     FUpdateQry,
     FDeleteQry           : TCustomSQLQuery;
     FSequence            : TSQLSequence;
+    procedure CheckPrepare;
+    procedure CheckUnPrepare;
     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;
@@ -494,8 +516,10 @@ type
     function GetSQLTransaction: TSQLTransaction;
     function GetStatementType : TStatementType;
     Function NeedLastInsertID: TField;
+    procedure SetMacroChar(AValue: Char);
     procedure SetOptions(AValue: TSQLQueryOptions);
     procedure SetParamCheck(AValue: Boolean);
+    procedure SetMacroCheck(AValue: Boolean);
     procedure SetSQLConnection(AValue: TSQLConnection);
     procedure SetSQLTransaction(AValue: TSQLTransaction);
     procedure SetInsertSQL(const AValue: TStringList);
@@ -503,14 +527,17 @@ type
     procedure SetDeleteSQL(const AValue: TStringList);
     procedure SetRefreshSQL(const AValue: TStringList);
     procedure SetParams(AValue: TParams);
+    procedure SetMacros(AValue: TParams);
     procedure SetParseSQL(AValue : Boolean);
     procedure SetSQL(const AValue: TStringList);
     procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
     procedure SetUpdateMode(AValue : TUpdateMode);
     procedure OnChangeModifySQL(Sender : TObject);
     procedure Execute;
+    procedure ApplyFilter;
     Function AddFilter(SQLstr : string) : string;
   protected
+    procedure OpenCursor(InfoQuery: Boolean); override;
     function CreateSQLStatement(aOwner: TComponent): TCustomSQLStatement; virtual;
     Function CreateParams: TSQLDBParams; virtual;
     Function RefreshLastInsertID(Field: TField): Boolean; virtual;
@@ -537,7 +564,6 @@ type
     Procedure InternalRefresh; override;
     function  GetCanModify: Boolean; override;
     Function IsPrepared : Boolean; virtual;
-    Procedure SetActive (Value : Boolean); override;
     procedure SetServerFiltered(Value: Boolean); virtual;
     procedure SetServerFilterText(const Value: string); virtual;
     Function GetDataSource : TDataSource; override;
@@ -561,6 +587,7 @@ type
     procedure SetSchemaInfo( ASchemaType : TSchemaType; ASchemaObjectName, ASchemaPattern : string); virtual;
     function RowsAffected: TRowsCount; virtual;
     function ParamByName(Const AParamName : String) : TParam;
+    function MacroByName(Const AParamName : String) : TParam;
     Property Prepared : boolean read IsPrepared;
     Property SQLConnection : TSQLConnection Read GetSQLConnection Write SetSQLConnection;
     Property SQLTransaction: TSQLTransaction Read GetSQLTransaction Write SetSQLTransaction;
@@ -611,6 +638,9 @@ type
     Property Options : TSQLQueryOptions Read FOptions Write SetOptions default [];
     property Params : TParams read GetParams Write SetParams;
     Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
+    property Macros : TParams read GetMacros Write SetMacros;
+    Property MacroCheck : Boolean Read GetMacroCheck Write SetMacroCheck default false;
+    Property MacroChar : Char Read GetMacroChar Write SetMacroChar default DefaultMacroChar;
     property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode default upWhereKeyOnly;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
@@ -673,6 +703,9 @@ type
     Property Options;
     property Params;
     Property ParamCheck;
+    property Macros;
+    Property MacroCheck;
+    Property MacroChar;
     property ParseSQL;
     property UpdateMode;
     property UsePrimaryKeyAsKey;
@@ -891,6 +924,7 @@ var
 
 begin
   UnPrepare;
+  RecreateMacros;
   if not ParamCheck then
     exit;
   if assigned(DataBase) then
@@ -927,6 +961,20 @@ begin
     end;
 end;
 
+procedure TCustomSQLStatement.SetMacroChar(AValue: Char);
+begin
+  if FMacroChar=AValue then Exit;
+  FMacroChar:=AValue;
+  RecreateMacros;
+end;
+
+procedure TCustomSQLStatement.SetMacroCheck(AValue: Boolean);
+begin
+  if FMacroCheck=AValue then Exit;
+  FMacroCheck:=AValue;
+  RecreateMacros;
+end;
+
 procedure TCustomSQLStatement.SetTransaction(AValue: TSQLTransaction);
 begin
   if FTransaction=AValue then Exit;
@@ -942,6 +990,36 @@ begin
     end;
 end;
 
+procedure TCustomSQLStatement.RecreateMacros;
+var
+  NewParams: TSQLDBParams;
+  ConnOptions: TConnOptions;
+  PO : TSQLParseOptions;
+  PB : TParamBinding;
+  RS : String;
+
+begin
+  if MacroCheck then begin
+    if assigned(DataBase) then
+      ConnOptions:=DataBase.ConnOptions
+    else
+      ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
+    NewParams := CreateParams;
+    try
+      PO:=[spoCreate,spoUseMacro];
+      if sqEscapeSlash in ConnOptions then
+        Include(PO,spoEscapeSlash);
+      if sqEscapeRepeat in ConnOptions then
+        Include(PO,spoEscapeRepeat);
+      NewParams.ParseSQL(FSQL.Text, PO, psInterbase, PB, MacroChar,RS);
+      NewParams.AssignValues(FMacros);
+      FMacros.Assign(NewParams);
+    finally
+      NewParams.Free;
+    end;
+  end;
+end;
+
 procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
 
 begin
@@ -951,7 +1029,7 @@ begin
   FDataLink.DataSource:=AValue;
 end;
 
-Procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound: Boolean);
+procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound: Boolean);
 begin
   if Assigned(DataSource) and Assigned(DataSource.Dataset) then
     FParams.CopyParamValuesFromDataset(DataSource.Dataset,CopyBound);
@@ -963,13 +1041,20 @@ begin
   FParams.Assign(AValue);
 end;
 
+procedure TCustomSQLStatement.SetMacros(AValue: TParams);
+begin
+  if FMacros=AValue then Exit;
+  FMacros.Assign(AValue);
+end;
+
 procedure TCustomSQLStatement.SetSQL(AValue: TStrings);
 begin
   if FSQL=AValue then Exit;
   FSQL.Assign(AValue);
+  RecreateMacros;
 end;
 
-Procedure TCustomSQLStatement.DoExecute;
+procedure TCustomSQLStatement.DoExecute;
 begin
   FRowsAffected:=-1;
   If (FParams.Count>0) and Assigned(DataSource) then
@@ -979,27 +1064,46 @@ begin
   Database.Execute(FCursor,Transaction, FParams);
 end;
 
-Function TCustomSQLStatement.GetPrepared: Boolean;
+function TCustomSQLStatement.GetPrepared: Boolean;
+
+begin
+  Result := Assigned(FCursor) and (FCursor.FPrepared or FCursor.FDirect);
+end;
+
+procedure TCustomSQLStatement.CheckUnprepare;
+begin
+  if FDoUnPrepare then
+    begin
+    UnPrepare;
+    FDoUnPrepare:=False;
+    end;
+end;
+
+procedure TCustomSQLStatement.CheckPrepare;
 begin
-  Result := Assigned(FCursor) and FCursor.FPrepared;
+  if Not Prepared then
+    begin
+    FDoUnprepare:=True;
+    Prepare;
+    end;
 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 +1139,9 @@ begin
   TStringList(FSQL).OnChange:=@OnChangeSQL;
   FParams:=CreateParams;
   FParamCheck:=True;
+  FMacros:=CreateParams;
+  FMacroChar:=DefaultMacroChar;
+  FMacroCheck:=False;
   FParseSQL:=True;
   FRowsAffected:=-1;
 end;
@@ -1047,27 +1154,28 @@ begin
   DataSource:=Nil;
   FreeAndNil(FDataLink);
   FreeAndNil(FParams);
+  FreeAndNil(FMacros);
   FreeAndNil(FSQL);
   inherited Destroy;
 end;
 
-Function TCustomSQLStatement.GetSchemaType: TSchemaType;
+function TCustomSQLStatement.GetSchemaType: TSchemaType;
 
 begin
   Result:=stNoSchema
 end;
 
-Function TCustomSQLStatement.GetSchemaObjectName: String;
+function TCustomSQLStatement.GetSchemaObjectName: String;
 begin
   Result:='';
 end;
 
-Function TCustomSQLStatement.GetSchemaPattern: String;
+function TCustomSQLStatement.GetSchemaPattern: String;
 begin
   Result:='';
 end;
 
-Function TCustomSQLStatement.IsSelectable: Boolean;
+function TCustomSQLStatement.IsSelectable: Boolean;
 begin
   Result:=False;
 end;
@@ -1092,6 +1200,65 @@ begin
     DataBase.DeAllocateCursorHandle(FCursor);
 end;
 
+function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
+
+Const
+  Terminators = SQLDelimiterCharacters+
+                [ #0,'=','+','-','*','\','/','[',']','|' ];
+
+var
+  I: Integer;
+  Ch : Char;
+  TermArr : Set of Char;
+  TempStr, TempMacroName : String;
+  MacroFlag : Boolean;
+
+  Procedure SubstituteMacro;
+
+  var
+    Param: TParam;
+  begin
+    Param := Macros.FindParam( TempMacroName );
+    if Assigned( Param ) then
+      Result := Result + Param.AsString
+    else
+      Result := Result + MacroChar + TempMacroName;
+    TempMacroName:='';
+  end;
+
+begin
+  Result := OrigSQL;
+  if not MacroCheck then
+    Exit;
+  TermArr := Terminators +[MacroChar];
+  Result := '';
+  MacroFlag := False;
+  for Ch in OrigSQL do
+    begin
+    if not MacroFlag and (Ch=MacroChar) then
+      begin
+      MacroFlag := True;
+      TempMacroName := '';
+      end
+    else if MacroFlag then
+      begin
+      if not (Ch In TermArr) then
+        TempMacroName := TempMacroName + Ch
+      else
+        begin
+        SubstituteMacro;
+        if Ch <> MacroChar then
+          MacroFlag := False;
+        TempMacroName := '';
+        end
+      end;
+    if not MacroFlag then
+      Result := Result + Ch;
+    end;
+  if (TempMacroName<>'') then
+    SubstituteMacro;
+end;
+
 procedure TCustomSQLStatement.DoPrepare;
 
 var
@@ -1103,7 +1270,7 @@ begin
     FOrigSQL := Database.GetSchemaInfoSQL(GetSchemaType, GetSchemaObjectName, GetSchemaPattern);
   if (FOrigSQL='') then
     DatabaseError(SErrNoStatement);
-  FServerSQL:=FOrigSQL;
+  FServerSQL:=ExpandMacros( FOrigSQL );
   GetStatementInfo(FServerSQL,StmInfo);
   AllocateCursor;
   FCursor.FSelectable:=True; // let PrepareStatement and/or Execute alter it
@@ -1112,12 +1279,15 @@ begin
   If LogEvent(detPrepare) then
     Log(detPrepare,FServerSQL);
   Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
+  // Update
+  FCursor.FInitFieldDef:=FCursor.FSelectable;
 end;
 
-Procedure TCustomSQLStatement.Prepare;
+procedure TCustomSQLStatement.Prepare;
 
 begin
-  if Prepared then exit;
+  if Prepared then
+    exit;
   if not assigned(Database) then
     DatabaseError(SErrDatabasenAssigned);
   if not assigned(Transaction) then
@@ -1133,10 +1303,14 @@ begin
   end;
 end;
 
-Procedure TCustomSQLStatement.Execute;
+procedure TCustomSQLStatement.Execute;
 begin
-  Prepare;
-  DoExecute;
+  CheckPrepare;
+  try
+    DoExecute;
+  finally
+    CheckUnPrepare;
+  end;
 end;
 
 procedure TCustomSQLStatement.DoUnPrepare;
@@ -1160,7 +1334,7 @@ begin
     Result:=Nil;
 end;
 
-Procedure TCustomSQLStatement.Unprepare;
+procedure TCustomSQLStatement.Unprepare;
 begin
   // Some SQLConnections does not support statement [un]preparation, but they have allocated local cursor(s)
   //  so let them do cleanup f.e. cancel pending queries and/or free resultset
@@ -1169,7 +1343,7 @@ begin
     DoUnprepare;
 end;
 
-function TCustomSQLStatement.ParamByName(Const AParamName: String): TParam;
+function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
 begin
   Result:=FParams.ParamByName(AParamName);
 end;
@@ -2068,7 +2242,7 @@ begin
     Qry.Open
     end
   else
-    Qry.Execute;
+    Qry.ExecSQL;
   if (scoApplyUpdatesChecksRowsAffected in Options) and (Qry.RowsAffected<>1) then
     begin
     Qry.Close;
@@ -2238,7 +2412,11 @@ begin
     CloseDataSets;
     If LogEvent(detCommit) then
       Log(detCommit,SCommitting);
-    if (stoUseImplicit in Options) or SQLConnection.AttemptCommit(FTrans) then
+    // The inherited closetrans must always be called.
+    // So the last (FTrans=Nil) is for the case of forced close. (Bug IDs 35246 and 33737)
+    // Order is important:
+    // some connections do not have FTrans, but they must still go through AttemptCommit.
+    if (stoUseImplicit in Options) or SQLConnection.AttemptCommit(FTrans) or (FTrans=Nil) then
       begin
       CloseTrans;
       FreeAndNil(FTrans);
@@ -2265,7 +2443,12 @@ begin
     CloseDataSets;
     If LogEvent(detRollback) then
       Log(detRollback,SRollingBack);
-    if SQLConnection.AttemptRollBack(FTrans) then
+    // The inherited closetrans must always be called.
+    // So the last (FTrans=Nil) is for the case of forced close. (Bug IDs 35246 and 33737)
+    // Order is important:
+    // some connections do not have FTrans, but they must still go through AttemptCommit.
+    // FTrans=Nil for the case of forced close.
+    if SQLConnection.AttemptRollBack(FTrans) or (FTrans=Nil) then
       begin
       CloseTrans;
       FreeAndNil(FTrans);
@@ -2493,7 +2676,8 @@ end;
 
 { TCustomSQLQuery }
 
-Function TCustomSQLQuery.CreateSQLStatement(aOwner : TComponent)  : TCustomSQLStatement;
+function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
+  ): TCustomSQLStatement;
 
 begin
   Result:=TQuerySQLStatement.Create(Self);
@@ -2550,6 +2734,11 @@ begin
   Result:=Params.ParamByName(AParamName);
 end;
 
+function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
+begin
+  Result:=Macros.ParamByName(AParamName);
+end;
+
 procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
 
 begin
@@ -2612,6 +2801,18 @@ begin
   Result := SQLstr;
 end;
 
+procedure TCustomSQLQuery.OpenCursor(InfoQuery: Boolean);
+begin
+  if InfoQuery then
+    CheckPrepare;
+  try
+    inherited OpenCursor(InfoQuery);
+  finally
+    if InfoQuery then
+      CheckUnPrepare;
+  end;
+end;
+
 function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean;
 
 
@@ -2704,16 +2905,15 @@ begin
   end;
 end;
 
-procedure TCustomSQLQuery.SetActive(Value: Boolean);
+procedure TCustomSQLQuery.ApplyFilter;
 
 begin
-  inherited SetActive(Value);
-// The query is UnPrepared, so that if a transaction closes all datasets
-// they also get unprepared
-  if not Value and IsPrepared then UnPrepare;
+  if Prepared then
+    FStatement.Unprepare;
+  InternalRefresh;
+  First;
 end;
 
-
 procedure TCustomSQLQuery.SetServerFiltered(Value: Boolean);
 
 begin
@@ -2722,11 +2922,7 @@ begin
   if (ServerFiltered <> Value) then
     begin
     FServerFiltered := Value;
-    if Active then 
-      begin
-      Close;
-      Open;
-      end;
+    if Active then ApplyFilter;
     end;
 end;
 
@@ -2735,11 +2931,7 @@ begin
   if Value <> ServerFilter then
     begin
     FServerFilterText := Value;
-    if Active then 
-      begin
-      Close;
-      Open;
-      end;
+    if Active then ApplyFilter;
     end;
 end;
 
@@ -2748,15 +2940,13 @@ procedure TCustomSQLQuery.Prepare;
 
 begin
   FStatement.Prepare;
-  if Assigned(FStatement.FCursor) then
-    with FStatement.FCursor do
-      FInitFieldDef := FSelectable;
 end;
 
 procedure TCustomSQLQuery.UnPrepare;
 
 begin
-  CheckInactive;
+  if Not Refreshing then
+    CheckInactive;
   If Assigned(FStatement) then
     FStatement.Unprepare;
 end;
@@ -2767,6 +2957,11 @@ begin
      SQLConnection.FreeFldBuffers(Cursor);
 end;
 
+function TCustomSQLQuery.GetMacroChar: Char;
+begin
+  Result := FStatement.MacroChar;
+end;
+
 function TCustomSQLQuery.GetParamCheck: Boolean;
 begin
   Result:=FStatement.ParamCheck;
@@ -2777,6 +2972,16 @@ begin
   Result:=FStatement.Params;
 end;
 
+function TCustomSQLQuery.GetMacroCheck: Boolean;
+begin
+  Result:=FStatement.MacroCheck;
+end;
+
+function TCustomSQLQuery.GetMacros: TParams;
+begin
+  Result:=FStatement.Macros;
+end;
+
 function TCustomSQLQuery.GetParseSQL: Boolean;
 begin
   Result:=FStatement.ParseSQL;
@@ -2821,7 +3026,7 @@ end;
 
 procedure TCustomSQLQuery.Execute;
 begin
-  FStatement.Execute;
+  FStatement.DoExecute;
 end;
 
 function TCustomSQLQuery.RowsAffected: TRowsCount;
@@ -2850,13 +3055,16 @@ end;
 
 procedure TCustomSQLQuery.InternalClose;
 begin
+
   if assigned(Cursor) then
     begin
     if Cursor.FSelectable then
       FreeFldBuffers;
+    CheckUnPrepare;
     // Some SQLConnections does not support statement [un]preparation,
     //  so let them do cleanup f.e. cancel pending queries and/or free resultset
-    if not Prepared then FStatement.DoUnprepare;
+    // if not Prepared then
+    //  FStatement.DoUnprepare;
     end;
 
   if DefaultFields then
@@ -2872,15 +3080,13 @@ begin
 end;
 
 procedure TCustomSQLQuery.InternalInitFieldDefs;
+
 begin
   if FLoadingFieldDefs then
     Exit;
-
   FLoadingFieldDefs := True;
-
   try
     FieldDefs.Clear;
-    Prepare;
     SQLConnection.AddFieldDefs(Cursor,FieldDefs);
   finally
     FLoadingFieldDefs := False;
@@ -2893,6 +3099,7 @@ procedure TCustomSQLQuery.InternalOpen;
 var counter, fieldc : integer;
     F               : TField;
     IndexFields     : TStrings;
+
 begin
   if IsReadFromPacket then
     begin
@@ -2904,7 +3111,7 @@ begin
     end
   else
     begin
-    Prepare;
+    CheckPrepare;
     if not Cursor.FSelectable then
       DatabaseError(SErrNoSelectStatement,Self);
 
@@ -2914,13 +3121,14 @@ begin
     if DefaultFields and FUpdateable and FusePrimaryKeyAsKey and (not IsUniDirectional) then
       UpdateServerIndexDefs;
 
-    Execute;
+    FStatement.Execute;
     if not Cursor.FSelectable then
       DatabaseError(SErrNoSelectStatement,Self);
 
     // InternalInitFieldDef is only called after a prepare. i.e. not twice if
     // a dataset is opened - closed - opened.
-    if Cursor.FInitFieldDef then InternalInitFieldDefs;
+    if Cursor.FInitFieldDef then
+      InternalInitFieldDefs;
     if DefaultFields then
       begin
       CreateFields;
@@ -2961,22 +3169,40 @@ end;
 
 // public part
 
+procedure TCustomSQLQuery.CheckPrepare;
+
+begin
+  if Not IsPrepared then
+    begin
+    Prepare;
+    FDoUnPrepare:=True;
+    end;
+end;
+
+procedure TCustomSQLQuery.CheckUnPrepare;
+
+begin
+  if FDoUnPrepare then
+    begin
+    FDoUnPrepare:=False;
+    UnPrepare;
+    end;
+end;
+
+
 procedure TCustomSQLQuery.ExecSQL;
+
 begin
+  CheckPrepare;
   try
-    Prepare;
     Execute;
+    // Always retrieve rows affected
+    FStatement.RowsAffected;
     If sqoAutoCommit in Options then
-      begin
-      // Retrieve rows affected
-      FStatement.RowsAffected;
       SQLTransaction.Commit;
-      end;
   finally
-    // Cursor has to be assigned, or else the prepare went wrong before PrepareStatment was
-    //   called, so UnPrepareStatement shoudn't be called either
-    // Don't deallocate cursor; f.e. RowsAffected is requested later
-    if not Prepared and (assigned(Database)) and (assigned(Cursor)) then SQLConnection.UnPrepareStatement(Cursor);
+    CheckUnPrepare;
+    // if not Prepared and (assigned(Database)) and (assigned(Cursor)) then SQLConnection.UnPrepareStatement(Cursor);
   end;
 end;
 
@@ -3065,6 +3291,11 @@ begin
     end
 end;
 
+procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
+begin
+  FStatement.MacroChar:=AValue;
+end;
+
 function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
 
 begin
@@ -3191,6 +3422,11 @@ begin
   FStatement.ParamCheck:=AValue;
 end;
 
+procedure TCustomSQLQuery.SetMacroCheck(AValue: Boolean);
+begin
+  FStatement.MacroCheck:=AValue;
+end;
+
 procedure TCustomSQLQuery.SetOptions(AValue: TSQLQueryOptions);
 begin
   if FOptions=AValue then Exit;
@@ -3236,6 +3472,11 @@ begin
   FStatement.Params.Assign(AValue);
 end;
 
+procedure TCustomSQLQuery.SetMacros(AValue: TParams);
+begin
+  FStatement.Macros.Assign(AValue);
+end;
+
 procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
 
 Var

packages/fcl-db/tests/dbtestframework.lpi

@@ -121,7 +121,7 @@
     <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../units/x86_64-linux"/>
+      <OtherUnitFiles Value="../src/base;../src/dbase;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mssql;../src/sqldb/mysql;../src/sqldb/odbc;../src/sqldb/oracle;../src/sqldb/postgres;../src/sqldb/sqlite;../src/memds;../src/sdf;../src/export"/>
     </SearchPaths>
     <Parsing>
       <SyntaxOptions>

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -257,6 +257,7 @@ begin
       FieldtypeDefinitions[ftBlob]    := 'IMAGE';
       FieldtypeDefinitions[ftMemo]    := 'TEXT';
       FieldtypeDefinitions[ftGraphic] := '';
+      FieldtypeDefinitions[ftGuid]    := 'UNIQUEIDENTIFIER';
       FieldtypeDefinitions[ftWideString] := 'NVARCHAR(10)';
       FieldtypeDefinitions[ftFixedWideChar] := 'NCHAR(10)';
       //FieldtypeDefinitions[ftWideMemo] := 'NTEXT'; // Sybase has UNITEXT?

packages/fcl-db/tests/testfieldtypes.pas

@@ -53,6 +53,7 @@ type
     procedure TestSQLInterval;
     procedure TestSQLIdentity;
     procedure TestSQLReal;
+    procedure TestSQLUUID;
 
     procedure TestStringLargerThen8192;
     procedure TestInsertLargeStrFields; // bug 9600
@@ -133,8 +134,8 @@ type
     procedure TestQueryAfterReconnect; // bug 16438
 
     procedure TestStringsReplace;
-    // Test SQLIte3 AlwaysUseBigInt, introduced after bug ID 36486.
-    Procedure TestAlwaysUseBigint;
+    // Test SQLite3 AlwaysUseBigInt, introduced after bug ID 36486.
+    Procedure TestSQLite3AlwaysUseBigint;
   end;
 
 
@@ -732,7 +733,7 @@ begin
     Open;
     for i := 0 to testValuesCount-1 do
       begin
-      ACheckFieldValueProc(fields[0],i);
+      ACheckFieldValueProc(Fields[0],i);
       Next;
       end;
     close;
@@ -931,6 +932,30 @@ begin
 end;
 
 
+const testUUIDValues: array[0..2] of shortstring = ('{00000000-0000-0000-0000-000000000000}','{A972C577-DFB0-064E-1189-0154C99310DA}','{A0EEBC99-9C0B-4EF8-BB6D-6BB9BD380A11}');
+// Placed here, as long as bug 18702 is not solved
+function TestSQLUUID_GetSQLText(const i: integer) : string;
+begin
+  if i < Length(testUUIDValues) then
+    Result := QuotedStr(Copy(testUUIDValues[i],2,36))
+  else
+    Result := 'NULL';
+end;
+procedure TTestFieldTypes.TestSQLUUID;
+  procedure CheckFieldValue(AField:TField; i: integer);
+  begin
+    if i < Length(testUUIDValues) then
+      AssertEquals(testUUIDValues[i], AField.AsString)
+    else
+      AssertTrue(AField.IsNull);
+  end;
+begin
+  if FieldtypeDefinitions[ftGuid] = '' then
+    Ignore(STestNotApplicable);
+  TestSQLFieldType(ftGuid, FieldtypeDefinitions[ftGuid], 39, @TestSQLUUID_GetSQLText, @CheckFieldValue);
+end;
+
+
 procedure TTestFieldTypes.TestStringLargerThen8192;
 // See also: TestInsertLargeStrFields
 var
@@ -1501,7 +1526,7 @@ begin
   TestXXParamQuery(ftFMTBcd, FieldtypeDefinitions[ftFMTBcd], testValuesCount, testFmtBCDValues);
 end;
 
-Procedure TTestFieldTypes.TestFmtBCDParamQuery2;
+procedure TTestFieldTypes.TestFmtBCDParamQuery2;
 begin
   // This test tests FmtBCD params with smaller precision, which fits into INT32
   // TestFmtBCDParamQuery tests FmtBCD params with bigger precision, which fits into INT64
@@ -2429,7 +2454,7 @@ begin
     inherited RunTest;
 end;
 
-Procedure TTestFieldTypes.TestAlwaysUseBigint;
+procedure TTestFieldTypes.TestSQLite3AlwaysUseBigint;
 
 var
   I : byte;

packages/fcl-db/tests/testsqldb.pas

@@ -30,8 +30,10 @@ type
   TTestTSQLQuery = class(TSQLDBTestCase)
   private
     FMyQ: TSQLQuery;
+    FPrepareCount:Integer;
     procedure DoAfterPost(DataSet: TDataSet);
     Procedure DoApplyUpdates;
+    procedure DoCount(Sender: TSQLConnection; EventType: TDBEventType; const Msg: String);
     Procedure TrySetQueryOptions;
     Procedure TrySetPacketRecords;
   Protected
@@ -56,6 +58,8 @@ type
     procedure TestSequence;
     procedure TestReturningInsert;
     procedure TestReturningUpdate;
+    procedure TestMacros;
+    Procedure TestPrepareCount;
   end;
 
   { TTestTSQLConnection }
@@ -94,6 +98,7 @@ implementation
 procedure TTestTSQLQuery.Setup;
 begin
   inherited Setup;
+  FPrepareCount:=0;
   SQLDBConnector.Connection.Options:=[];
 end;
 
@@ -339,6 +344,12 @@ begin
   FMyQ.ApplyUpdates();
 end;
 
+procedure TTestTSQLQuery.DoCount(Sender: TSQLConnection; EventType: TDBEventType; const Msg: String);
+begin
+  If (EventType=detPrepare) then
+    Inc(FPrepareCount);
+end;
+
 procedure TTestTSQLQuery.TestCheckRowsAffected;
 var Q: TSQLQuery;
     I: Integer;
@@ -723,6 +734,69 @@ begin
   AssertEquals('#2.b updated', 'b2', FMyQ.FieldByName('b').AsString);
 end;
 
+procedure TTestTSQLQuery.TestMacros;
+begin
+  with SQLDBConnector do
+    begin
+    ExecuteDirect('create table FPDEV2 (id integer not null, constraint PK_FPDEV2 primary key(id))');
+    CommitDDL;
+    ExecuteDirect('insert into FPDEV2 (id) values (1)');
+    ExecuteDirect('insert into FPDEV2 (id) values (2)');
+    end;
+
+  With SQLDBConnector.Query do
+    begin
+    SQL.Text:='Select ID from FPDEV2 '+
+      '%WHERE_CL' +sLineBreak+
+      '%ORDER_CL' +sLineBreak;
+    MacroCheck:=true;
+    MacroByName('WHERE_CL').AsString:='where 1=1';
+    MacroByName('ORDER_CL').AsString:='order by 1';
+    Open;
+    AssertEquals('Correct SQL executed, macros substituted: ',1,Fields[0].AsInteger);
+    Close;
+    MacroByName('ORDER_CL').AsString := 'Order by 1 DESC';
+    Open;
+    AssertEquals('Correct SQL executed, macro value changed: ',2,Fields[0].AsInteger);
+    end;
+end;
+
+procedure TTestTSQLQuery.TestPrepareCount;
+
+begin
+  with SQLDBConnector do
+    begin
+    ExecuteDirect('create table FPDEV2 (id integer not null, constraint PK_FPDEV2 primary key(id))');
+    CommitDDL;
+    ExecuteDirect('insert into FPDEV2 (id) values (1)');
+    ExecuteDirect('insert into FPDEV2 (id) values (2)');
+    Connection.OnLog:=@DoCount;
+    Connection.LogEvents:=[detPrepare];
+    end;
+  try
+    With SQLDBConnector.Query do
+      begin
+      Unidirectional:=True; // Disable server index defs etc
+      UsePrimaryKeyAsKey:=False; // Idem
+      SQL.Text:='Select ID from FPDEV2 where (ID=:ID)';
+      ParamByname('ID').AsInteger:=1;
+      Prepare;
+      Open;
+      AssertEquals('Correct record count param 1',1,RecordCount);
+      AssertEquals('Correct SQL executed, correct paramete: ',1,Fields[0].AsInteger);
+      Close;
+      ParamByname('ID').AsInteger:=2;
+      Open;
+      AssertEquals('Correct record count param 2',1,RecordCount);
+      AssertEquals('Correct SQL executed, macro value changed: ',2,Fields[0].AsInteger);
+      end;
+    AssertEquals('Prepare called only once ',1,FPrepareCount);
+  finally
+    SQLDBConnector.Connection.OnLog:=Nil;
+  end;
+
+end;
+
 
 { TTestTSQLConnection }