* Add copy from/to pascal code menu items

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

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;

tools/lazdatadesktop/lazdatadesktop.lpi

@@ -68,7 +68,7 @@
         <MinVersion Minor="1" Release="1" Valid="True"/>
       </Item8>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="lazdatadesktop.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -158,6 +158,10 @@
         <ResourceBaseClass Value="DataModule"/>
         <UnitName Value="dmImages"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="lazddsqlutils.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -178,10 +182,5 @@
         </Win32>
       </Options>
     </Linking>
-    <Other>
-      <ConfigFile>
-        <WriteConfigFilePath Value="$(ProjOutDir)/fpclaz.cfg"/>
-      </ConfigFile>
-    </Other>
   </CompilerOptions>
 </CONFIG>

tools/lazdatadesktop/lazdatadesktop.lpr

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

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 (I<L) and (S[I+1]=Q) then
+            begin
+            U:=U+C;
+            Inc(i);
+            end
+          else
+            begin
+            InQ:=False;
+            LastQ:=Length(U);
+            end
+          end
+        else
+          begin
+          InQ:=True;
+          if FirstQ=0 then
+            FirstQ:=Length(U);
+          end;
+      Inc(I);
+      end;
+    // Strip all after last quote
+    If LastQ>0 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.
+