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.
+