1 unit fSQLConsole;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, memds, db, FileUtil, LResources, Forms, Controls, Graphics,
9   Dialogs, DBGrids, ComCtrls, ExtCtrls, StdCtrls, ActnList,
10   SynMemo, SynHighlighterSQL, SynCompletion, lcltype;
11 
12 type
13 
14   { TfrmSQLConsole }
15 
16   TfrmSQLConsole = class(TForm)
17     acSQL: TActionList;
18     acExecute: TAction;
19     acPrev: TAction;
20     acNext: TAction;
21     acExport: TAction;
22     acSaveSQL: TAction;
23     acLoadSQL: TAction;
24     acGetSQL: TAction;
25     btnClose: TButton;
26     btnHelp: TButton;
27     dsrSQL: TDatasource;
28     dbgrdSQL: TDBGrid;
29     imgSQL: TImageList;
30     dlgOpen: TOpenDialog;
31     lblTime: TLabel;
32     Panel1: TPanel;
33     mSQL: TSynMemo;
34     dlgSave: TSaveDialog;
35     SynAutoComplete1: TSynAutoComplete;
36     SynSQLSyn1: TSynSQLSyn;
37     ToolBar1: TToolBar;
38     ToolButton1: TToolButton;
39     ToolButton10: TToolButton;
40     ToolButton11: TToolButton;
41     ToolButton2: TToolButton;
42     ToolButton3: TToolButton;
43     ToolButton4: TToolButton;
44     ToolButton5: TToolButton;
45     ToolButton6: TToolButton;
46     ToolButton7: TToolButton;
47     ToolButton8: TToolButton;
48     ToolButton9: TToolButton;
49     procedure acExecuteExecute(Sender: TObject);
50     procedure acExportExecute(Sender: TObject);
51     procedure acGetSQLExecute(Sender: TObject);
52     procedure acLoadSQLExecute(Sender: TObject);
53     procedure acNextExecute(Sender: TObject);
54     procedure acPrevExecute(Sender: TObject);
55     procedure acSaveSQLExecute(Sender: TObject);
56     procedure btnCloseClick(Sender: TObject);
57     procedure btnHelpClick(Sender: TObject);
58     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
59     procedure FormShow(Sender: TObject);
60   private
61     aSQL : Array [1..50] of String;
62     aSQLPos : Word;
63     procedure LoadSQLCommands;
64     procedure SaveSQLCommands;
65     procedure AddSQLCommand(cmd : String);
66     procedure ExportToCsv(FileName : string);
67     procedure ExportToHTML(FileName : string);
68     procedure Show_aSQL;
69   public
70     { public declarations }
71   end;
72 
73 var
74   frmSQLConsole: TfrmSQLConsole;
75 
76 implementation
77 {$R *.lfm}
78 
79 uses dUtils, dData, uMyIni;
80 
81 { TfrmSQLConsole }
82 
83 procedure TfrmSQLConsole.FormShow(Sender: TObject);
84 begin
85   dmUtils.LoadWindowPos(frmSQLConsole);
86   mSQL.ClearAll;
87   LoadSQLCommands
88 end;
89 
90 procedure TfrmSQLConsole.acExecuteExecute(Sender: TObject);
91 var
92   err : Boolean = False;
93   t   : TDateTime;
94   h,m,s,ms : Word;
95 begin
96   try
97     dmData.qSQLConsole.Close;
98     mSQL.Text := trim(mSQL.Text);
99     if mSQL.Text = '' then
100       exit;
101     dmData.qSQLConsole.SQL.Text := mSQL.Text;
102     if dmData.DebugLevel>=1 then Writeln(dmData.qSQLConsole.SQL.Text);
103     AddSQLCommand(mSQL.Text);
104     if dmData.trSQLConsole.Active then
105       dmData.trSQLConsole.Rollback;
106     dmData.trSQLConsole.StartTransaction;
107     t := now;
108     if (Pos('UPDATE',UpperCase(mSQL.Text)) > 0) or (Pos('DELETE',UpperCase(mSQL.Text)) > 0) or
109        (Pos('REPAIR TABLE',UpperCase(mSQL.Text))>0) or (Pos('OPTIMIZE TABLE',UpperCase(mSQL.Text))>0) or
110        (Pos('DROP',UpperCase(mSQL.Text))>0) or (Pos('TRUNCATE',UpperCase(mSQL.Text))>0) or
111        (Pos('CREATE',UpperCase(mSQL.Text))>0) then
112       dmData.qSQLConsole.ExecSQL
113     else
114       dmData.qSQLConsole.Open
115   except
116     on E : exception do
117     begin
118       Application.MessageBox(PChar('SQL error:'+E.Message),'Error ...',mb_ok + mb_IconError);
119       dmData.trSQLConsole.Rollback
120     end
121   end;
122   if not err then
123     dmData.trSQLConsole.Commit;
124   t := t - now;
125   DecodeTime(t,h,m,s,ms);
126   lblTime.Caption := 'It takes about '+IntToStr(m)+' minutes '+IntToStr(s)+ 'seconds '+
127                      IntToStr(ms)+' milliseconds'
128 end;
129 
130 procedure TfrmSQLConsole.acExportExecute(Sender: TObject);
131 begin
132   dlgSave.DefaultExt := '.csv';
133   dlgSave.Filter := 'CSV|*.csv|HTML|*.html';
134   if dlgSave.Execute then
135   begin
136     if ExtractFileExt(dlgSave.FileName) = '.csv' then
137       ExportToCsv(dlgSave.FileName)
138     else
139       ExportToHTML(dlgSave.FileName)
140   end
141 end;
142 
143 procedure TfrmSQLConsole.acGetSQLExecute(Sender: TObject);
144 begin
145   mSQL.Text := dmData.qCQRLOG.SQL.Text
146 end;
147 
148 procedure TfrmSQLConsole.acLoadSQLExecute(Sender: TObject);
149 begin
150   dlgOpen.Filter := 'SQL|*.sql';
151   if dlgOpen.Execute then
152     mSQL.Lines.LoadFromFile(dlgOpen.FileName)
153 end;
154 
155 procedure TfrmSQLConsole.acNextExecute(Sender: TObject);
156 begin
157   Show_aSQL;
158   //Writeln('aSQLPos:',aSQLPos);
159   if aSQLPos > 1 then
160   begin
161     if (aSQL[aSQLPos-1] = '') then
162       exit;
163     dec(aSQLPos);
164     mSQL.Text := aSQL[aSQLPos]
165   end
166 end;
167 
168 procedure TfrmSQLConsole.acPrevExecute(Sender: TObject);
169 begin
170   Show_aSQL;
171   //Writeln('aSQLPos:',aSQLPos);
172   if aSQLPos < 50 then
173   begin
174     if (aSQL[aSQLPos+1] = '') then
175       exit;
176     Inc(aSQLPos);
177     mSQL.Text := aSQL[aSQLPos]
178   end
179 end;
180 
181 procedure TfrmSQLConsole.acSaveSQLExecute(Sender: TObject);
182 begin
183   dlgSave.DefaultExt := '.sql';
184   dlgSave.Filter := 'SQL|*.sql';
185   if dlgSave.Execute then
186     mSQL.Lines.SaveToFile(dlgSave.FileName)
187 end;
188 
189 procedure TfrmSQLConsole.btnCloseClick(Sender: TObject);
190 begin
191   Close
192 end;
193 
194 procedure TfrmSQLConsole.btnHelpClick(Sender: TObject);
195 begin
196   ShowHelp
197 end;
198 
199 procedure TfrmSQLConsole.FormClose(Sender: TObject;
200   var CloseAction: TCloseAction);
201 begin
202   dmData.qSQLConsole.Close;
203   dmUtils.SaveWindowPos(frmSQLConsole);
204   SaveSQLCommands
205 end;
206 
207 procedure TfrmSQLConsole.ExportToCsv(FileName : string);
208 var
209   f : TextFile;
210   i : Integer;
211 begin
212   AssignFile(f, FileName);
213   Rewrite(f);
214   dmData.qSQLConsole.DisableControls;
215   try
216     for i:=0 to dmData.qSQLConsole.FieldCount-1 do
217       Write(f,dmData.qSQLConsole.Fields[i].DisplayName,';');
218     Writeln(f);
219     dmData.qSQLConsole.First;
220     while not dmData.qSQLConsole.Eof do
221     begin
222       for i:=0 to dmData.qSQLConsole.FieldCount-1 do
223       begin
224         if dmData.qSQLConsole.Fields[i].IsNull then
225           Write(f,';')
226         else
227           Write(f,dmData.qSQLConsole.Fields[i].AsVariant,';')
228       end;
229       Writeln(f);
230       dmData.qSQLConsole.Next
231     end
232   finally
233     dmData.qSQLConsole.EnableControls;
234     CloseFile(f)
235   end
236 end;
237 
238 procedure TfrmSQLConsole.ExportToHTML(FileName : string);
239 var
240   f : TextFile;
241   i : Integer;
242 begin
243   AssignFile(f, FileName);
244   Rewrite(f);
245   dmData.qSQLConsole.DisableControls;
246   try
247     Writeln(f,'<table>');
248     Writeln(f,'<tr>');
249     for i:=0 to dmData.qSQLConsole.FieldCount-1 do
250       Write(f,'<td>',dmData.qSQLConsole.Fields[i].DisplayName,'</td>');
251     Writeln(f);
252     Writeln(f,'</tr>');
253     dmData.qSQLConsole.First;
254     while not dmData.qSQLConsole.Eof do
255     begin
256       Writeln(f,'<tr>');
257       for i:=0 to dmData.qSQLConsole.FieldCount-1 do
258       begin
259         if dmData.qSQLConsole.Fields[i].IsNull then
260           Writeln(f,'<td>&nbsp;</td>')
261         else
262           Write(f,'<td>',dmData.qSQLConsole.Fields[i].AsVariant,'</td>')
263       end;
264       Writeln(f);
265       Writeln(f,'</tr>');
266       dmData.qSQLConsole.Next
267     end;
268     Writeln(f,'</table>')
269   finally
270     dmData.qSQLConsole.EnableControls;
271     CloseFile(f)
272   end
273 end;
274 
275 procedure TfrmSQLConsole.LoadSQLCommands;
276 var
277   i : Integer = 0;
278 begin
279   for i:=1 to 50 do
280     aSQL[i] := trim(cqrini.ReadString('SQLConsole',IntToStr(i),''));
281   mSQL.Text := aSQL[1];
282   aSQLPos   := 1
283 end;
284 
285 procedure TfrmSQLConsole.SaveSQLCommands;
286 var
287   i : Integer = 0;
288 begin
289   for i:=1 to 50 do
290     cqrini.WriteString('SQLConsole',IntToStr(i),aSQL[i]);
291   cqrini.SaveToDisk
292 end;
293 
294 procedure TfrmSQLConsole.AddSQLCommand(cmd : String);
295 var
296   i : Integer = 0;
297 begin
298   Show_aSQL;
299   if (cmd = aSQL[1]) then
300     exit;
301   for i:=49 downto 1 do
302     aSQL[i+1] := aSQL[i];
303   aSQL[1] := cmd;
304   aSQLPos := 1;
305   Show_aSQL;
306   SaveSQLCommands
307 end;
308 
309 procedure TfrmSQLConsole.Show_aSQL;
310 var
311   i : Integer;
312 begin
313   exit;
314   Writeln('');
315   for i:=1 to 50 do
316     Write(aSQL[i],'|');
317   Writeln('')
318 end;
319 
320 end.
321 
322