* Parameter support when executing query

tools/lazdatadesktop/fpddwrappers.pas

@@ -0,0 +1,337 @@
+unit fpddwrappers;
+{
+This unit adds features available in 3.3.1 to the 3.2.2 version of sqldb dictionary engines.
+}
+
+{$mode ObjFPC}{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  Classes, SysUtils,
+  db, sqldb,
+  fpdatadict,
+  fpddsqldb,
+  fpddfb,      // Firebird
+  fpddmysql40, // MySQL 4.0
+  fpddmysql41, // MySQL 4.1
+  fpddmysql50, // MySQL 5.0
+  fpddmysql51, // MySQL 5.1
+  fpddmysql55, // MySQL 5.5
+  fpddmysql56, // MySQL 5.6
+  fpddmysql57, // MySQL 5.7
+  fpddmysql80, // MySQL 8.0
+  fpddoracle,  // Oracle
+  fpddpq,      // PostgreSQL
+  fpddsqlite3, // SQLite 3
+  fpddodbc,    // Any ODBC supported
+  fpddmssql;
+
+
+Type
+
+
+  { TSQLDBMySql40DDEngine }
+
+
+  TSQLDBMySql40DDEngine = Class(fpddmysql40.TSQLDBMySql40DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql41DDEngine }
+
+  TSQLDBMySql41DDEngine = Class(fpddmysql41.TSQLDBMySql41DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql5DDEngine }
+
+  TSQLDBMySql5DDEngine = Class(fpddmysql50.TSQLDBMySql5DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql51DDEngine }
+
+  TSQLDBMySql51DDEngine = Class(fpddmysql51.TSQLDBMySql51DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql55DDEngine }
+
+  TSQLDBMySql55DDEngine = Class(fpddmysql55.TSQLDBMySql55DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql56DDEngine }
+
+  TSQLDBMySql56DDEngine = Class(fpddmysql56.TSQLDBMySql56DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql56DDEngine }
+
+  { TSQLDBMySql57DDEngine }
+
+  TSQLDBMySql57DDEngine = Class(fpddmysql57.TSQLDBMySql57DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBMySql80DDEngine }
+
+  TSQLDBMySql80DDEngine = Class(fpddmysql80.TSQLDBMySql80DDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBFBDDEngine }
+
+  TSQLDBFBDDEngine = Class(fpddfb.TSQLDBFBDDEngine)
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBOracleDDEngine }
+
+  TSQLDBOracleDDEngine = Class(fpddoracle.TSQLDBOracleDDEngine)
+  Public
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBPostGreSQLDDEngine }
+
+  TSQLDBPostGreSQLDDEngine = Class(fpddpq.TSQLDBPostGreSQLDDEngine)
+  Public
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBSQLite3DDEngine }
+
+  TSQLDBSQLite3DDEngine = Class(fpddsqlite3.TSQLDBSQLite3DDEngine)
+  Public
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TSQLDBODBCDDEngine }
+
+  TSQLDBODBCDDEngine = Class(fpddodbc.TSQLDBODBCDDEngine)
+  Public
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+  { TFPDDMSSQLEngine }
+
+  TFPDDMSSQLEngine = Class(fpddmssql.TSQLDBMSSQLDDEngine)
+  Public
+    Class function EngineCapabilities : TFPDDEngineCapabilities; override;
+  end;
+
+
+
+
+Procedure RegisterMySQL40DDEngine;
+Procedure RegisterMySQL41DDEngine;
+Procedure RegisterMySQL50DDEngine;
+Procedure RegisterMySQL51DDEngine;
+Procedure RegisterMySQL55DDEngine;
+Procedure RegisterMySQL56DDEngine;
+Procedure RegisterMySQL57DDEngine;
+Procedure RegisterMySQL80DDEngine;
+Procedure RegisterFBDDEngine;
+Procedure RegisterOracleDDEngine;
+Procedure RegisterPostgreSQLDDengine;
+Procedure RegisterSQLite3DDEngine;
+Procedure RegisterODBCDDengine;
+Procedure RegisterMSSQLDDEngine;
+
+implementation
+
+procedure RegisterMySQL40DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL40DDEngine);
+end;
+
+procedure RegisterMySQL41DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL41DDEngine);
+end;
+
+procedure RegisterMySQL50DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL5DDEngine);
+
+end;
+
+procedure RegisterMySQL51DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL51DDEngine);
+
+end;
+
+procedure RegisterMySQL55DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL55DDEngine);
+
+end;
+
+procedure RegisterMySQL56DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL56DDEngine);
+
+end;
+
+procedure RegisterMySQL57DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL57DDEngine);
+end;
+
+procedure RegisterMySQL80DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMySQL80DDEngine);
+end;
+
+procedure RegisterFBDDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBFBDDEngine);
+end;
+
+procedure RegisterOracleDDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBOracleDDEngine);
+end;
+
+procedure RegisterPostgreSQLDDengine;
+begin
+  RegisterDictionaryEngine(TSQLDBPostGreSQLDDEngine);
+end;
+
+procedure RegisterSQLite3DDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBSQLite3DDEngine);
+end;
+
+procedure RegisterODBCDDengine;
+begin
+  RegisterDictionaryEngine(TSQLDBODBCDDEngine);
+end;
+
+procedure RegisterMSSQLDDEngine;
+begin
+  RegisterDictionaryEngine(TSQLDBMSSQLDDEngine);
+end;
+
+
+{ TSQLDBMySql40DDEngine }
+
+class function TSQLDBMySql40DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+
+{ TSQLDBMySql41DDEngine }
+
+class function TSQLDBMySql41DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBMySql5DDEngine }
+
+class function TSQLDBMySql5DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBMySql51DDEngine }
+
+class function TSQLDBMySql51DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBMySql55DDEngine }
+
+class function TSQLDBMySql55DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBMySql56DDEngine }
+
+class function TSQLDBMySql56DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBMySql57DDEngine }
+
+class function TSQLDBMySql57DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBMySql80DDEngine }
+
+class function TSQLDBMySql80DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected]
+end;
+
+{ TSQLDBFBDDEngine }
+
+class function TSQLDBFBDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected,ecSequences];
+end;
+
+{ TSQLDBOracleDDEngine }
+
+class function TSQLDBOracleDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected,ecSequences];
+end;
+
+{ TSQLDBPostGreSQLDDEngine }
+
+class function TSQLDBPostGreSQLDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected,ecSequences];
+end;
+
+{ TSQLDBSQLite3DDEngine }
+
+class function TSQLDBSQLite3DDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected];
+end;
+
+{ TSQLDBODBCDDEngine }
+
+class function TSQLDBODBCDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected];
+end;
+
+{ TFPDDMSSQLEngine }
+
+class function TFPDDMSSQLEngine.EngineCapabilities: TFPDDEngineCapabilities;
+begin
+  Result:=inherited EngineCapabilities;
+  Result:=Result+[ecRowsAffected,ecSequences];
+end;
+
+
+end.
+

tools/lazdatadesktop/fraparams.lfm

@@ -0,0 +1,56 @@
+object fraParams: TfraParams
+  Left = 0
+  Height = 288
+  Top = 0
+  Width = 569
+  ClientHeight = 288
+  ClientWidth = 569
+  TabOrder = 0
+  DesignLeft = 573
+  DesignTop = 289
+  object SGParams: TStringGrid
+    Left = 0
+    Height = 288
+    Top = 0
+    Width = 569
+    Align = alClient
+    AutoFillColumns = True
+    ColCount = 4
+    Columns = <    
+      item
+        ReadOnly = True
+        SizePriority = 0
+        Title.Caption = 'Name'
+        Width = 160
+      end    
+      item
+        ButtonStyle = cbsPickList
+        SizePriority = 0
+        Title.Caption = 'Data type'
+        Width = 120
+      end    
+      item
+        ButtonStyle = cbsCheckboxColumn
+        SizePriority = 0
+        Title.Caption = 'Null'
+        Width = 60
+      end    
+      item
+        SizePriority = 2
+        Title.Caption = 'Value'
+        Width = 227
+      end>
+    FixedCols = 0
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goEditing, goAlwaysShowEditor, goSmoothScroll]
+    RowCount = 1
+    TabOrder = 0
+    OnEditingDone = SGParamsEditingDone
+    OnSetEditText = SGParamsSetEditText
+    ColWidths = (
+      160
+      120
+      60
+      227
+    )
+  end
+end

tools/lazdatadesktop/fraparams.lrs

@@ -0,0 +1,15 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TfraParams','FORMDATA',[
+  'TPF0'#10'TfraParams'#9'fraParams'#4'Left'#2#0#6'Height'#3#240#0#3'Top'#2#0#5
+  +'Width'#3#209#1#12'ClientHeight'#3#240#0#11'ClientWidth'#3#209#1#8'TabOrder'
+  +#2#0#10'DesignLeft'#3'='#2#9'DesignTop'#3'!'#1#0#11'TStringGrid'#8'SGParams'
+  +#4'Left'#2#0#6'Height'#3#240#0#3'Top'#2#0#5'Width'#3#209#1#5'Align'#7#8'alCl'
+  +'ient'#8'ColCount'#2#4#7'Columns'#14#1#8'ReadOnly'#9#13'Title.Caption'#6#4'N'
+  +'ame'#5'Width'#3#128#0#0#1#11'ButtonStyle'#7#11'cbsPickList'#13'Title.Captio'
+  +'n'#6#9'Data type'#5'Width'#2'P'#0#1#11'ButtonStyle'#7#17'cbsCheckboxColumn'
+  +#13'Title.Caption'#6#4'Null'#5'Width'#2'0'#0#1#13'Title.Caption'#6#5'Value'#0
+  +#0#9'FixedCols'#2#0#7'Options'#11#15'goFixedVertLine'#15'goFixedHorzLine'#10
+  +'goVertLine'#10'goHorzLine'#18'goAlwaysShowEditor'#14'goSmoothScroll'#0#8'Ro'
+  +'wCount'#2#2#8'TabOrder'#2#0#0#0#0
+]);

tools/lazdatadesktop/fraparams.pas

@@ -0,0 +1,246 @@
+unit fraparams;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, db, Grids;
+
+type
+
+  { TfraParams }
+
+  TfraParams = class(TFrame)
+    SGParams: TStringGrid;
+    procedure SGParamsEditingDone(Sender: TObject);
+    procedure SGParamsSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string);
+  private
+    FParamHistory: TParams;
+    FParams: TParams;
+    procedure AddValueToHistory(P: TParam);
+    procedure ApplyHistoryValues;
+    procedure ApplyValue(P: TParam; aValue: UTF8String);
+    procedure DisplayParams;
+    procedure FillDataTypePicklist;
+    procedure SetParams(AValue: TParams);
+
+  public
+    constructor Create(aOwner : TComponent); override;
+    Destructor Destroy; override;
+    Property Params : TParams Read FParams Write SetParams;
+    Property ParamHistory : TParams Read FParamHistory;
+  end;
+
+implementation
+
+uses typinfo, fmtbcd;
+
+const
+  colName = 0;
+  colType = 1;
+  colNull = 2;
+  colValue = 3;
+
+  SupportedParams = [ftString, ftSmallint, ftInteger, ftWord,
+    ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
+    ftMemo, ftFixedChar, ftWideString, ftLargeint, ftVariant, ftGuid,
+    ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo];
+
+
+{$R *.lfm}
+
+Function DataTypeToString (T : TFieldType) : String;
+
+begin
+  Str(T,Result);
+  Delete(Result,1,2);
+end;
+
+Function StringToDataType (aValue : String) : TFieldType;
+
+var
+  I : Integer;
+
+begin
+  if (Length(aValue)>1) and ((Upcase(Avalue[1])<>'F') or (Upcase(Avalue[1])<>'T')) then
+    aValue:='ft'+aValue;
+  I:=GetEnumValue(TypeInfo(TFieldType),aValue);
+  if I=-1 then
+    Result:=ftUnknown
+  else
+    Result:=TFieldType(I);
+end;
+
+{ TfraParams }
+
+function CompareParams(Item1, Item2: TCollectionItem): Integer;
+begin
+  Result:=CompareText(TParam(Item1).Name,TParam(Item2).Name);
+end;
+
+procedure TfraParams.SGParamsEditingDone(Sender: TObject);
+begin
+
+end;
+
+procedure TfraParams.ApplyValue(P : TParam; aValue : UTF8String);
+
+var
+  T : TFieldType;
+
+begin
+  T:=P.DataType;
+  Case T of
+    ftString,
+    ftMemo,
+    ftFixedChar : P.AsString:=aValue;
+    ftWideString,
+    ftFixedWideChar,
+    ftWideMemo : P.AsUnicodeString:=UTF8Decode(aValue);
+    ftSmallint : P.AsSmallInt:=StrToInt(aValue);
+    ftInteger : P.Asinteger:=StrToInt(aValue);
+    ftWord  : P.AsWord:=StrToInt(aValue);
+    ftBoolean : P.AsBoolean:=StrToBool(aValue);
+    ftFloat : P.AsFloat:=StrToFloat(aValue);
+    ftCurrency : P.AsCurrency:=StrToCurr(aValue);
+    ftBCD : P.AsBCD:=StrToBCD(aValue);
+    ftDate : P.AsDate:=StrToDate(aValue);
+    ftTime : P.AsTime:=StrToTime(aValue);
+    ftDateTime : P.AsDateTime:=StrToDateTime(aValue);
+    ftLargeint : P.AsLargeInt:=StrToInt64(aValue);
+    ftVariant : P.Value:=aValue;
+    ftGuid : P.AsString:=aValue;
+    ftTimeStamp : P.AsDate:=StrToDateTime(aValue);
+    ftFMTBcd : P.AsFMTBCD:=StrToBCD(aValue);
+  else
+    // Not supported;
+  end;
+  // To make sure we have the correct type
+  P.DataType:=T;
+end;
+
+procedure TfraParams.AddValueToHistory(P : TParam);
+
+Var
+  PHist : TParam;
+
+begin
+  PHist:=FParamHistory.FindParam(P.Name);
+  if PHist=Nil then
+    PHist:=(FParamHistory.Add as TParam);
+  PHist.Assign(P);
+end;
+
+procedure TfraParams.SGParamsSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string);
+
+Var
+  P : TParam;
+  T : TFieldType;
+
+begin
+  Dec(aRow);
+  if (aRow>=0) and (aRow<FParams.Count) then
+    P:=FParams[aRow]
+  else
+    Exit;
+  T:=P.DataType;
+  Case aCol of
+    colName : ; // Cannot happen, read-only ?
+    colType : P.DataType:=StringToDataType(Value) ;
+    colNull : if Value='1' then
+                begin
+                P.Clear;
+                P.DataType:=T;
+                end;
+    colValue : begin
+               ApplyValue(P,Value);
+               AddValueToHistory(P);
+               SGParams.Cells[colNull,aRow+1]:=IntToStr(Ord(P.IsNull));
+               end
+  else
+    // Should not happen either
+  end;
+end;
+
+procedure TfraParams.ApplyHistoryValues;
+
+Var
+  Dest,Src: TParam;
+  I : Integer;
+
+begin
+  For I:=0 to FParams.Count-1 do
+    begin
+    Dest:=FParams[i];
+    Src:=FParamHistory.FindParam(Dest.Name);
+    if Assigned(Src) then
+      Dest.Assign(Src);
+    end;
+end;
+
+procedure TfraParams.DisplayParams;
+
+Var
+  P : TParam;
+  aRow : integer;
+  S : String;
+
+begin
+  SGParams.RowCount:=FParams.Count+1;
+  FParams.Sort(@CompareParams);
+  aRow:=0;
+  For P in FParams do
+    begin
+    Inc(aRow);
+    SGParams.Cells[colName,aRow]:=P.Name;
+    SGParams.Cells[colType,aRow]:=DataTypeToString(P.DataType);
+    SGParams.Cells[colNull,aRow]:=IntToStr(Ord(P.IsNull));
+    if not P.IsNull then
+      S:=P.Value
+    else
+      S:='';
+    SGParams.Cells[colValue,aRow]:=S;
+    end;
+end;
+
+procedure TfraParams.SetParams(AValue: TParams);
+begin
+  if FParams=AValue then Exit;
+  FParams.Assign(AValue);
+  ApplyHistoryValues;
+  DisplayParams;
+end;
+
+Procedure TfraParams.FillDataTypePicklist;
+
+var
+  L : TStrings;
+  T : TFieldType;
+
+begin
+  L:=SGParams.Columns[colType].PickList;
+  For T in TFieldType do
+    if T in SupportedParams then
+      L.Add(DataTypeToString(T));
+end;
+
+constructor TfraParams.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FParams:=TParams.Create(Self);
+  FParamHistory:=TParams.Create(Self);
+  FillDataTypePicklist;
+end;
+
+destructor TfraParams.Destroy;
+begin
+  FreeAndNil(FParams);
+  FreeAndNil(FParamHistory);
+  inherited Destroy;
+end;
+
+
+
+end.
+

tools/lazdatadesktop/fraquery.lfm

@@ -19,94 +19,99 @@ object QueryFrame: TQueryFrame
     ShowHint = True
     TabOrder = 0
     object TBExecute: TToolButton
-      Left = 1
+      Left = 24
       Top = 2
       Action = AExecute
       DropdownMenu = PMExecute
       Style = tbsDropDown
     end
     object TBSep1: TToolButton
-      Left = 59
+      Left = 82
       Height = 22
       Top = 2
       Caption = 'TBSep1'
       Style = tbsSeparator
     end
     object TBPrevious: TToolButton
-      Left = 67
+      Left = 90
       Top = 2
       Action = APreviousQuery
     end
     object TBNext: TToolButton
-      Left = 90
+      Left = 113
       Top = 2
       Action = ANextQuery
     end
     object TBSep2: TToolButton
-      Left = 113
+      Left = 136
       Height = 22
       Top = 2
       Caption = 'TBSep2'
       Style = tbsSeparator
     end
     object TBClose: TToolButton
-      Left = 36
+      Left = 59
       Top = 2
       Action = ACloseQuery
     end
     object TBLoadSQL: TToolButton
-      Left = 121
+      Left = 144
       Top = 2
       Action = ALoadSQL
     end
     object TBSaveSQL: TToolButton
-      Left = 144
+      Left = 167
       Top = 2
       Action = ASaveSQL
     end
     object TBSep3: TToolButton
-      Left = 167
+      Left = 190
       Height = 22
       Top = 2
       Caption = 'TBSep3'
       Style = tbsSeparator
     end
     object TBExport: TToolButton
-      Left = 175
+      Left = 198
       Top = 2
       Action = AExport
     end
     object TBCreateCode: TToolButton
-      Left = 198
+      Left = 221
       Top = 2
       Action = ACreateCode
     end
     object btnCommit: TToolButton
-      Left = 229
+      Left = 252
       Top = 2
       Action = aCommit
     end
     object btnRollback: TToolButton
-      Left = 252
+      Left = 275
       Top = 2
       Action = aRollBack
     end
     object ToolButton5: TToolButton
-      Left = 221
+      Left = 244
       Height = 22
       Top = 2
       Caption = 'ToolButton5'
       Style = tbsSeparator
     end
+    object tbPrepareParams: TToolButton
+      Left = 1
+      Top = 2
+      Action = aPrepareParameters
+    end
   end
   object PCResult: TPageControl
     Left = 0
     Height = 244
     Top = 261
     Width = 640
-    ActivePage = TSResult
+    ActivePage = TSParams
     Align = alBottom
-    TabIndex = 0
+    TabIndex = 2
     TabOrder = 1
     object TSResult: TTabSheet
       Caption = 'Result'
@@ -617,6 +622,9 @@ object QueryFrame: TQueryFrame
     object TSData: TTabSheet
       Caption = 'Data'
     end
+    object TSParams: TTabSheet
+      Caption = 'Parameters'
+    end
   end
   inline FMSQL: TSynEdit
     Left = 0
@@ -1274,6 +1282,14 @@ object QueryFrame: TQueryFrame
       Caption = 'Clean up pascal code'
       OnExecute = aCleanPascalCodeExecute
     end
+    object aPrepareParameters: TAction
+      Category = 'SQL'
+      Caption = 'Prepare Parameters'
+      Hint = 'Prepare parameter values'
+      ImageIndex = 49
+      OnExecute = aPrepareParametersExecute
+      OnUpdate = NotBusy
+    end
   end
   object SQLSyn: TSynSQLSyn
     DefaultFilter = 'SQL Files (*.sql)|*.sql'

tools/lazdatadesktop/fraquery.pp

@@ -8,7 +8,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, SynHighlighterSQL, SynEdit, LResources, Forms,
   DB, LCLType, Controls, ComCtrls, StdCtrls, ActnList, Dialogs, ExtCtrls, Menus, StdActns,
-  dmImages, fpDatadict, fradata, lazdatadeskstr, sqlscript, sqldb, fpddsqldb, lazddsqlutils;
+  dmImages, fpDatadict, fradata, lazdatadeskstr, sqlscript, sqldb, fpddsqldb, lazddsqlutils, fraparams;
 
 type
    TExecuteMode = (emSingle,emSelection,emScript,emSelectionScript);
@@ -24,6 +24,7 @@ type
     aCopyAsSQLConst: TAction;
     aCopyAsTStringsAdd: TAction;
     aCleanPascalCode: TAction;
+    aPrepareParameters: TAction;
     aRollBack: TAction;
     AExecuteSelectionScript: TAction;
     AExecuteScript: TAction;
@@ -65,6 +66,8 @@ type
     SQuery: TSplitter;
     SQLSyn: TSynSQLSyn;
     MResult: TSynEdit;
+    tbPrepareParams: TToolButton;
+    TSParams: TTabSheet;
     TBExecute: TToolButton;
     TBSep1: TToolButton;
     TBPrevious: TToolButton;
@@ -92,6 +95,7 @@ type
     procedure AExecuteSelectionExecute(Sender: TObject);
     procedure AExecuteSelectionScriptExecute(Sender: TObject);
     procedure AExecuteSingleExecute(Sender: TObject);
+    procedure aPrepareParametersExecute(Sender: TObject);
     procedure aRollBackExecute(Sender: TObject);
     procedure aRollBackUpdate(Sender: TObject);
     procedure CloseQueryClick(Sender: TObject);
@@ -100,15 +104,17 @@ type
     procedure HaveSQLSelection(Sender: TObject);
     procedure LoadQueryClick(Sender: TObject);
     procedure NextQueryClick(Sender: TObject);
+    procedure NotBusy(Sender: TObject);
     procedure OnMemoKey(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure PreviousQueryClick(Sender: TObject);
     procedure SaveQueryClick(Sender: TObject);
     procedure ExportDataClick(Sender: TObject);
     procedure CreateCodeClick(Sender: TObject);
-    Procedure NotBusy(Sender: TObject);
+    Procedure HaveParamsAvailabe(Sender: TObject);
     Procedure DataShowing(Sender: TObject);
   private
     { private declarations }
+    FParamFrame : TfraParams;
     FEngine: TFPDDEngine;
     FQueryHistory : TStrings;
     FCurrentQuery : Integer;
@@ -121,7 +127,9 @@ type
     FSQLConstName: String;
     FSQLQuoteOptions: TQuoteOptions;
     FAbortScript : Boolean;
+    FExecParams : TParams;
     procedure AddToResult(const Msg: String; SetCursorPos : Boolean = false);
+    procedure ClearParams;
     procedure ClearResults;
     function CountStatements(const S: String): Integer;
     function DetermineExecuteMode: TExecuteMode;
@@ -138,6 +146,7 @@ type
   public
   Protected
     Function HaveTransaction : Boolean;
+    Function HaveParams : Boolean;
     Function TransactionIsActive : Boolean;
     procedure SetEngine(const AValue: TFPDDEngine);
     Function GetDataset: TDataset;
@@ -165,6 +174,7 @@ type
     Property Busy : TBusyMode Read FBusy;
     Property SQLQuoteOptions : TQuoteOptions Read FSQLQuoteOptions Write FSQLQuoteOptions;
     Property SQLConstName : String Read FSQLConstName Write FSQLConstName;
+    Property ParamFrame : TfraParams Read FParamFrame;
     { public declarations }
   end;
 
@@ -175,13 +185,20 @@ type
      function GetConn: TSQLConnection;
      function GetTrans: TSQLTransaction;
    Public
+     {$IFDEF VER3_2}
+     Procedure ApplyParams(DS : TDataset;Params : TParams);
+     Function RunQuery(SQL : String; Params : TParams) : Integer; overload;
+     {$ENDIF}
      Property SQLConnection : TSQLConnection Read GetConn;
      Property Transaction : TSQLTransaction Read GetTrans;
    end;
 
 implementation
 
-uses Clipbrd, strutils, fpdataexporter, fpcodegenerator;
+uses
+  Clipbrd, strutils,
+  fpdataexporter,
+  fpcodegenerator;
 
 {$r *.lfm}
 
@@ -205,6 +222,31 @@ begin
     Result:=Nil;
 end;
 
+{$IFDEF VER3_2}
+procedure TSQLDBHelper.ApplyParams(DS: TDataset; Params: TParams);
+begin
+  if Assigned(Params) and (DS is TSQLQuery) then
+    TSQLQuery(DS).Params.Assign(Params);
+end;
+
+function TSQLDBHelper.RunQuery(SQL: String; Params: TParams): Integer;
+
+Var
+  Q : TSQLQuery;
+
+begin
+  Q:=CreateSQLQuery(Nil);
+  Try
+    Q.SQL.Text:=SQL;
+    if Assigned(Params) then
+      ApplyParams(Q,Params);
+    Q.ExecSQL;
+    Result:=0;
+  Finally
+    Q.Free;
+  end;
+end;
+{$ENDIF}
 
 constructor TQueryFrame.Create(AOwner: TComponent);
 begin
@@ -231,6 +273,7 @@ begin
     end;
   FEngine:=AValue;
   SetTableNames;
+  TSParams.TabVisible:=HaveParams;
 end;
 
 procedure TQueryFrame.SetTableNames;
@@ -255,6 +298,15 @@ begin
       Result:=Assigned(TSQLDBDDEngine(FEngine).Transaction);
 end;
 
+function TQueryFrame.HaveParams: Boolean;
+begin
+{$ifdef VER3_2}
+  Result:=FEngine is TSQLDBDDEngine;
+{$ELSE}
+  Result:=ecParams in FEngine.EngineCapabilities;
+{$endif}
+end;
+
 function TQueryFrame.TransactionIsActive: Boolean;
 begin
   Result:=HaveTransaction;
@@ -324,6 +376,10 @@ begin
   FScript.OnSQLStatement:=@DoSQLStatement;
   FScript.OnDirective:=@DoDirective;
   FScript.OnCommit:=@DoCommit;
+  PCResult.ActivePage:=TSResult;
+  FParamFrame:=TfraParams.Create(Self);
+  FParamFrame.Parent:=TSParams;
+  FParamFrame.Align:=alClient;
 end;
 
 { ---------------------------------------------------------------------
@@ -545,6 +601,7 @@ begin
     ExecuteQuery(SQL);
   finally
     SQL.Free;
+    ClearParams;
   end;
 end;
 
@@ -552,12 +609,42 @@ procedure TQueryFrame.AExecuteSelectionScriptExecute(Sender: TObject);
 begin
   ClearResults;
   ExecuteScript(Trim(FMSQL.SelText));
+  ClearParams;
 end;
 
 procedure TQueryFrame.AExecuteSingleExecute(Sender: TObject);
 begin
   ClearResults;
   ExecuteQuery(FMSQL.Lines);
+  ClearParams;
+end;
+
+procedure TQueryFrame.ClearParams;
+
+begin
+  FreeAndNil(FExecParams);
+  TSParams.TabVisible:=False;
+end;
+
+procedure TQueryFrame.aPrepareParametersExecute(Sender: TObject);
+
+begin
+//  ShowMessage(ParamFrame.SGParams.Columns[1].PickList.Text);
+  if Assigned(FExecParams) then
+    begin
+    ParamFrame.Params.Clear;
+    FreeAndNil(FExecParams);
+    PCResult.ActivePage:=TSResult;
+    TSParams.TabVisible:=False;
+    end
+  else
+    begin
+    FExecParams:=TParams.Create(TParam);
+    FExecParams.ParseSQL(FMSQL.Lines.Text,True);
+    ParamFrame.Params:=FExecParams;
+    TSParams.TabVisible:=True;
+    PCResult.ActivePage:=TSParams;
+    end;
 end;
 
 procedure TQueryFrame.aRollBackExecute(Sender: TObject);
@@ -577,10 +664,11 @@ begin
   CloseDataset;
 end;
 
-procedure TQueryFrame.NotBusy(Sender : TObject);
+procedure TQueryFrame.HaveParamsAvailabe(Sender: TObject);
 
 begin
-  (Sender as TAction).Enabled:=FBusy=bmIdle;
+  NotBusy(Sender);
+  (Sender as TAction).Enabled:=(Sender as TAction).Enabled and HaveParams;
 end;
 
 procedure TQueryFrame.DataShowing(Sender : TObject);
@@ -626,6 +714,11 @@ begin
   NextQuery;
 end;
 
+procedure TQueryFrame.NotBusy(Sender: TObject);
+begin
+  (Sender as TAction).Enabled:=FBusy=bmIdle;
+end;
+
 procedure TQueryFrame.PreviousQueryClick(Sender : TObject);
 
 begin
@@ -726,15 +819,28 @@ begin
     AddToResult(S,False);
   If Not assigned(FEngine) then
     Raise Exception.Create(SErrNoEngine);
+  if Assigned(FExecParams) then
+    FExecParams.Assign(ParamFrame.Params);
   SQL:=Qry.Text;
   S:=ExtractDelimited(1,Trim(SQL),[' ',#9,#13,#10]);
   If (IndexText(S,['With','SELECT'])=-1) then
     begin
-    N:=FEngine.RunQuery(SQL);
+    if HaveParams and Assigned(FExecParams) then
+      begin
+      {$IFDEF VER3_2}
+      if FEngine is TSQLDBDDEngine then
+        N:=TSQLDBDDEngine(FEngine).RunQuery(SQL,FExecParams)
+      {$ELSE}
+        FEngine.RunQuery(SQL,FExecParams)
+      {$ENDIF}
+      end
+    else
+      N:=FEngine.RunQuery(SQL);
     TE:=Now;
     If ecRowsAffected in FEngine.EngineCapabilities then
       RowsAff:=Format(SRowsAffected,[N]);
     TSData.TabVisible:=False;
+    TSParams.TabVisible:=False;
     PCResult.ActivePage:=TSResult;
     end
   else
@@ -748,8 +854,18 @@ begin
       FData.Dataset:=DS;
       end;
     TSData.TabVisible:=true;
+    TSParams.TabVisible:=False;
     PCResult.ActivePage:=TSData;
     FData.Visible:=True;
+    if HaveParams and Assigned(FExecParams) then
+      begin
+      {$IFDEF VER3_2}
+      if FEngine is TSQLDBDDEngine then
+        TSQLDBDDEngine(FEngine).ApplyParams(DS,FExecParams);
+      {$ELSE}
+        FEngine.ApplyParams(DS,FExecParams)
+      {$ENDIF}
+      end;
     DS.Open;
     TE:=Now;
     RowsAff:=Format(SRecordsFetched,[DS.RecordCount]);
@@ -772,7 +888,7 @@ begin
       Result:=TSQLDBDDEngine(FEngine).Transaction;
 end;
 
-Procedure TQueryFrame.AddToResult(const Msg : String; SetCursorPos : Boolean = false);
+procedure TQueryFrame.AddToResult(const Msg: String; SetCursorPos: Boolean);
 
 var
   MsgLines : TStringList;
@@ -829,6 +945,7 @@ begin
       AddToResult(Msg,True);
       end;
   Finally
+    TSParams.TabVisible:=False;
     if ACount<=0 then
       FBusy:=bmIdle;
   end;
@@ -915,6 +1032,5 @@ begin
   If SQLSyn.TableNames.Count=0 then
     SetTableNames;
 end;
-
 end.
 

tools/lazdatadesktop/frmmain.lfm

@@ -144,14 +144,14 @@ object MainForm: TMainForm
     TabOrder = 1
     object TSConnections: TTabSheet
       Caption = 'Connections'
-      ClientHeight = 406
-      ClientWidth = 452
+      ClientHeight = 404
+      ClientWidth = 450
       ImageIndex = 38
       object LVConnections: TListView
         Left = 0
-        Height = 406
+        Height = 404
         Top = 0
-        Width = 452
+        Width = 450
         Align = alClient
         Columns = <        
           item
@@ -182,14 +182,14 @@ object MainForm: TMainForm
     end
     object TSRecent: TTabSheet
       Caption = 'Dictionaries'
-      ClientHeight = 406
-      ClientWidth = 452
+      ClientHeight = 404
+      ClientWidth = 450
       ImageIndex = 32
       object LVDicts: TListView
         Left = 0
-        Height = 406
+        Height = 404
         Top = 0
-        Width = 452
+        Width = 450
         Align = alClient
         Columns = <        
           item
@@ -217,14 +217,14 @@ object MainForm: TMainForm
     end
     object TSAll: TTabSheet
       Caption = 'Connections/Dictionaries'
-      ClientHeight = 406
-      ClientWidth = 452
+      ClientHeight = 404
+      ClientWidth = 450
       ImageIndex = 29
       object TVAll: TTreeView
         Left = 0
-        Height = 406
+        Height = 404
         Top = 0
-        Width = 452
+        Width = 450
         Align = alClient
         Images = ImgDatamodule.AppImages
         PopupMenu = PMAll

tools/lazdatadesktop/lazdatadesktop.lpi

@@ -12,6 +12,7 @@
       <AutoCreateForms Value="False"/>
       <Title Value="Lazarus Data Desktop"/>
       <Scaled Value="True"/>
+      <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <XPManifest>
         <DpiAware Value="True"/>
@@ -68,7 +69,7 @@
         <MinVersion Minor="1" Release="1" Valid="True"/>
       </Item8>
     </RequiredPackages>
-    <Units Count="16">
+    <Units Count="18">
       <Unit0>
         <Filename Value="lazdatadesktop.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -162,6 +163,17 @@
         <Filename Value="lazddsqlutils.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit15>
+      <Unit16>
+        <Filename Value="fraparams.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="fraParams"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Frame"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="fpddwrappers.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit17>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

tools/lazdatadesktop/lazdatadesktop.lpr

@@ -11,7 +11,7 @@ uses
   frmgeneratesql, RunTimeTypeInfoControls, frmSQLConnect,
   ddfiles, frmselectconnectiontype,
   lazdatadeskstr, fraquery, fradata, fraconnection,
-  reglddfeatures, lazddsqlutils;
+  reglddfeatures, lazddsqlutils, fraparams, fpddwrappers;
 
 {$R *.res}
 

tools/lazdatadesktop/reglddfeatures.pp

@@ -12,8 +12,9 @@ unit reglddfeatures;
 interface
 
 uses
-  // Data dictionary support for database types
   fpdddbf,     // DBF
+{$IFDEF VER3_3}
+  // Data dictionary support for database types
   fpddfb,      // Firebird
   fpddmysql40, // MySQL 4.0
   fpddmysql41, // MySQL 4.1
@@ -22,11 +23,16 @@ uses
   fpddmysql55, // MySQL 5.5
   fpddmysql56, // MySQL 5.6
   fpddmysql57, // MySQL 5.7
+  fpddmysql80, // MySQL 8.0
   fpddoracle,  // Oracle
   fpddpq,      // PostgreSQL
   fpddsqlite3, // SQLite 3
   fpddodbc,    // Any ODBC supported
   fpddmssql,
+{$ELSE}
+  // Descendents for all classes
+  fpddWrappers,
+{$ENDIF}
   // code generators
   fpcgfieldmap,
   fpcgtypesafedataset,
@@ -63,6 +69,7 @@ begin
   RegisterMySQL55DDEngine;
   RegisterMySQL56DDEngine;
   RegisterMySQL57DDEngine;
+  RegisterMySQL80DDEngine;
   RegisterOracleDDEngine;
   RegisterPostgreSQLDDengine;
   RegisterSQLite3DDEngine;