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> </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