diff --git a/tools/lazdatadesktop/fraquery.lfm b/tools/lazdatadesktop/fraquery.lfm index a9b99479f5..960a683427 100644 --- a/tools/lazdatadesktop/fraquery.lfm +++ b/tools/lazdatadesktop/fraquery.lfm @@ -767,6 +767,21 @@ object QueryFrame: TQueryFrame Hint = 'Select All' ShortCut = 16449 end + object aCopyAsSQLConst: TAction + Category = 'Edit' + Caption = 'Copy as pascal string constant' + OnExecute = aCopyAsSQLConstExecute + end + object aCopyAsTStringsAdd: TAction + Category = 'Edit' + Caption = 'TStrings.Add statements' + OnExecute = aCopyAsTStringsAddExecute + end + object aCleanPascalCode: TAction + Category = 'Edit' + Caption = 'Clean up pascal code' + OnExecute = aCleanPascalCodeExecute + end end object SQLSyn: TSynSQLSyn DefaultFilter = 'SQL Files (*.sql)|*.sql' @@ -822,6 +837,18 @@ object QueryFrame: TQueryFrame object mnuSelectAll: TMenuItem Action = aSelectAll end + object MenuItem1: TMenuItem + Caption = 'Copy as...' + object MenuItem2: TMenuItem + Action = aCopyAsSQLConst + end + object MenuItem3: TMenuItem + Action = aCopyAsTStringsAdd + end + end + object MenuItem4: TMenuItem + Action = aCleanPascalCode + end object mnuSep: TMenuItem Caption = '-' end diff --git a/tools/lazdatadesktop/fraquery.pp b/tools/lazdatadesktop/fraquery.pp index 13fcff2aef..097282f5d5 100644 --- a/tools/lazdatadesktop/fraquery.pp +++ b/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; + dmImages, fpDatadict, fradata, lazdatadeskstr, sqlscript, sqldb, fpddsqldb, lazddsqlutils; type TExecuteMode = (emSingle,emSelection,emScript,emSelectionScript); @@ -21,6 +21,9 @@ type ACloseQuery: TAction; ACreateCode: TAction; aCommit: TAction; + aCopyAsSQLConst: TAction; + aCopyAsTStringsAdd: TAction; + aCleanPascalCode: TAction; aRollBack: TAction; AExecuteSelectionScript: TAction; AExecuteScript: TAction; @@ -37,6 +40,10 @@ type aCut: TEditCut; aPaste: TEditPaste; aSelectAll: TEditSelectAll; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; mnuPrevSQL: TMenuItem; mnuNextSQL: TMenuItem; mnuSep2: TMenuItem; @@ -75,8 +82,11 @@ type TSResult: TTabSheet; TSData: TTabSheet; TBQuery: TToolBar; + procedure aCleanPascalCodeExecute(Sender: TObject); procedure aCommitExecute(Sender: TObject); procedure aCommitUpdate(Sender: TObject); + procedure aCopyAsSQLConstExecute(Sender: TObject); + procedure aCopyAsTStringsAddExecute(Sender: TObject); procedure AExecuteExecute(Sender: TObject); procedure AExecuteScriptExecute(Sender: TObject); procedure AExecuteSelectionExecute(Sender: TObject); @@ -108,6 +118,8 @@ type FScriptMode : TScriptMode; FErrorCount, FStatementCount : Integer; + FSQLConstName: String; + FSQLQuoteOptions: TQuoteOptions; FAbortScript : Boolean; procedure ClearResults; function CountStatements(const S: String): Integer; @@ -150,6 +162,8 @@ type Property QueryHistory : TStrings Read FQueryHistory; Property CurrentQuery : Integer Read FCurrentQuery; Property Busy : TBusyMode Read FBusy; + Property SQLQuoteOptions : TQuoteOptions Read FSQLQuoteOptions Write FSQLQuoteOptions; + Property SQLConstName : String Read FSQLConstName Write FSQLConstName; { public declarations } end; @@ -166,7 +180,7 @@ type implementation -uses strutils, fpdataexporter, fpcodegenerator; +uses Clipbrd, strutils, fpdataexporter, fpcodegenerator; {$r *.lfm} @@ -433,12 +447,82 @@ begin Transaction.Commit; end; +procedure TQueryFrame.aCleanPascalCodeExecute(Sender: TObject); +var + Src,Dest : TStrings; + +begin + Dest:=nil; + Src:=TStringList.Create; + try + Dest:=TStringList.Create; + if FMSQL.SelEnd=FMSQL.SelEnd then + Src.AddStrings(FMSQL.Lines) + else + Src.Text:=FMSQL.SelText; + UnQuoteSQL(Src,Dest); + if FMSQL.SelEnd=FMSQL.SelEnd then + FMSQL.Lines:=Dest + else + FMSQL.SelText:=Dest.Text + + finally + Dest.Free; + Src.Free; + end; +end; + procedure TQueryFrame.aCommitUpdate(Sender: TObject); begin (Sender as TAction).Enabled:=HaveTransaction and Transaction.Active; end; +procedure TQueryFrame.aCopyAsSQLConstExecute(Sender: TObject); + +var + Src,Dest : TStrings; + +begin + Dest:=nil; + Src:=TStringList.Create; + try + Dest:=TStringList.Create; + if FMSQL.SelEnd=FMSQL.SelEnd then + Src.AddStrings(FMSQL.Lines) + else + Src.Text:=FMSQL.SelText; + QuoteSQL(Src,Dest,SQLQuoteOptions,SQLConstName); + Clipboard.AsText:=Dest.Text; + finally + Dest.Free; + Src.Free; + end; +end; + + + +procedure TQueryFrame.aCopyAsTStringsAddExecute(Sender: TObject); +var + Src,Dest : TStrings; + +begin + Dest:=nil; + Src:=TStringList.Create; + try + Dest:=TStringList.Create; + if FMSQL.SelEnd=FMSQL.SelEnd then + Src.AddStrings(FMSQL.Lines) + else + Src.Text:=FMSQL.SelText; + QuoteSQL(Src,Dest,[qoTStringsAdd],SQLConstName); + Clipboard.AsText:=Dest.Text; + finally + Dest.Free; + Src.Free; + end; +end; + procedure TQueryFrame.AExecuteScriptExecute(Sender: TObject); begin ClearResults; @@ -629,7 +713,7 @@ begin If Not assigned(FEngine) then Raise Exception.Create(SErrNoEngine); S:=ExtractDelimited(1,Trim(Qry),[' ',#9,#13,#10]); - If (CompareText(S,'SELECT')<>0) then + If (IndexText(S,['With','SELECT'])=-1) then begin N:=FEngine.RunQuery(Qry); TE:=Now; diff --git a/tools/lazdatadesktop/lazdatadesktop.lpi b/tools/lazdatadesktop/lazdatadesktop.lpi index bef6404fb6..9095ee5339 100644 --- a/tools/lazdatadesktop/lazdatadesktop.lpi +++ b/tools/lazdatadesktop/lazdatadesktop.lpi @@ -68,7 +68,7 @@ - + @@ -158,6 +158,10 @@ + + + + @@ -178,10 +182,5 @@ - - - - - diff --git a/tools/lazdatadesktop/lazdatadesktop.lpr b/tools/lazdatadesktop/lazdatadesktop.lpr index 14ae455592..80661072ae 100644 --- a/tools/lazdatadesktop/lazdatadesktop.lpr +++ b/tools/lazdatadesktop/lazdatadesktop.lpr @@ -11,7 +11,7 @@ uses frmgeneratesql, RunTimeTypeInfoControls, frmSQLConnect, ddfiles, frmselectconnectiontype, lazdatadeskstr, fraquery, fradata, fraconnection, - reglddfeatures; + reglddfeatures, lazddsqlutils; {$R *.res} diff --git a/tools/lazdatadesktop/lazddsqlutils.pas b/tools/lazdatadesktop/lazddsqlutils.pas new file mode 100644 index 0000000000..2bae7cf6a1 --- /dev/null +++ b/tools/lazdatadesktop/lazddsqlutils.pas @@ -0,0 +1,149 @@ +unit lazddsqlutils; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils; + +Type + TQuoteOption = (qoAddLineBreak,qoAddConst,qoTStringsAdd); + TQuoteOptions = Set of TQuoteOption; + + +procedure UnquoteSQL(Src,Dest : TStrings); +procedure QuoteSQL(Src,Dest : TStrings; Options : TQuoteOptions; Const aConstName : string = ''); + + +implementation + +procedure TStringsAddQuoteSQL(Src,Dest : TStrings; Const aConstName : string = ''); + +Var + ind : String; + i : Integer; + S : String; + +begin + Ind:=''; + if aConstName<>'' then + begin + Dest.Add('with %s do',[aConstName]); + Dest.Add(' begin'); + Ind:=' '; + end; + For I:=0 to Src.Count-1 do + begin + S:=Src[I]; + S:='Add('''+StringReplace(S,'''','''''',[rfReplaceAll])+''');'; + Dest.Add(Ind+S); + end; + if aConstName<>'' then + Dest.Add(' end;'); +end; + +procedure QuoteSQL(Src,Dest : TStrings; Options : TQuoteOptions; Const aConstName : string = ''); + +Var + ind : String; + i : Integer; + S : String; + +begin + if (qoTStringsAdd in Options) then + begin + TStringsAddQuoteSQL(Src,Dest,aConstName); + exit; + end; + ind:=' '; + Dest.Clear; + if (qoAddConst in Options) then + begin + Dest.Add(' SQLSelect = '); + ind:=ind+' '; + end; + For I:=0 to Src.Count-1 do + begin + S:=Src[I]; + S:=''''+StringReplace(S,'''','''''',[rfReplaceAll]); + if I=Src.Count-1 then + begin + S:=S+''''; + if (qoAddConst in Options) then + S:=S+';'; + end + else + begin + if qoAddLineBreak in Options then + S:=S+''' + sLineBreak+' + else + S:=S+' '' + '; + end; + Dest.Add(Ind+S); + end; +end; + +procedure UnquoteSQL(Src,Dest : TStrings); + +Const + Q = ''''; + +Var + + S,U : String; + I,L,FirstQ,LastQ : Integer; + C : Char; + InQ : Boolean; + +begin + Dest.Clear; + For S in Src do + begin + U:=''; + I:=1; + L:=Length(S); + InQ:=False; + LastQ:=0; + FirstQ:=0; + While (I<=L) do + begin + C:=S[I]; + if C<>Q then + U:=U+C + else + if InQ then + begin + if (I0 then + U:=Copy(U,1,LastQ); + // Strip all before first quote + if Trim(Copy(U,1,FirstQ))='' then + Delete(U,1,FirstQ); + Dest.Add(U); + end; +end; + + + +end. +