ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/ibsqleditor.pas
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 12825 byte(s)
Log Message:
Committing updates for Release R2-0-1

File Contents

# Content
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2011 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26 unit IBSQLEditor;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
34 StdCtrls, ExtCtrls, ComCtrls, IBSystemTables, IBSQL, IBDatabase, IB,
35 LCLVersion;
36
37 type
38
39 { TIBSQLEditorForm }
40
41 TIBSQLEditorForm = class(TForm)
42 Button1: TButton;
43 Button2: TButton;
44 GenerateParams: TCheckBox;
45 GenerateBtn: TButton;
46 IBTransaction1: TIBTransaction;
47 Label5: TLabel;
48 SelectProcedure: TLabel;
49 TestBtn: TButton;
50 IncludePrimaryKeys: TCheckBox;
51 Label1: TLabel;
52 Label10: TLabel;
53 Label11: TLabel;
54 Label12: TLabel;
55 Label14: TLabel;
56 Label15: TLabel;
57 Label16: TLabel;
58 Label17: TLabel;
59 Label18: TLabel;
60 Label2: TLabel;
61 Label3: TLabel;
62 Label4: TLabel;
63 Label8: TLabel;
64 Label9: TLabel;
65 SelectFieldsList: TListBox;
66 ProcOutputList: TListBox;
67 SelectPrimaryKeys: TListBox;
68 InsertFieldsList: TListBox;
69 ModifyFieldsList: TListBox;
70 ModifyPrimaryKeys: TListBox;
71 DeletePrimaryKeys: TListBox;
72 ProcInputList: TListBox;
73 PageControl: TPageControl;
74 QuoteFields: TCheckBox;
75 SQLText: TMemo;
76 SelectPage: TTabSheet;
77 InsertPage: TTabSheet;
78 ModifyPage: TTabSheet;
79 DeletePage: TTabSheet;
80 ExecutePage: TTabSheet;
81 SelectTableNames: TComboBox;
82 InsertTableNames: TComboBox;
83 ModifyTableNames: TComboBox;
84 DeleteTableNames: TComboBox;
85 ProcedureNames: TComboBox;
86 procedure GenerateBtnClick(Sender: TObject);
87 procedure TestBtnClick(Sender: TObject);
88 procedure DeletePageShow(Sender: TObject);
89 procedure DeleteTableNamesCloseUp(Sender: TObject);
90 procedure ExecutePageShow(Sender: TObject);
91 procedure FormShow(Sender: TObject);
92 procedure IncludePrimaryKeysClick(Sender: TObject);
93 procedure InsertPageShow(Sender: TObject);
94 procedure Label13Click(Sender: TObject);
95 procedure ModifyPageShow(Sender: TObject);
96 procedure ModifyTableNamesCloseUp(Sender: TObject);
97 procedure ProcedureNamesCloseUp(Sender: TObject);
98 procedure SelectFieldsListDblClick(Sender: TObject);
99 procedure SelectPageShow(Sender: TObject);
100 procedure SelectTableNamesCloseUp(Sender: TObject);
101 procedure InsertTableNamesCloseUp(Sender: TObject);
102 private
103 { private declarations }
104 FTableName: string;
105 FIBSystemTables: TIBSystemTables;
106 FExecuteOnly: boolean;
107 protected
108 procedure Loaded; override;
109 public
110 { public declarations }
111 constructor Create(TheOwner: TComponent); override;
112 destructor Destroy; override;
113 procedure SetDatabase(Database: TIBDatabase);
114 end;
115
116 var
117 IBSQLEditorForm: TIBSQLEditorForm;
118
119 function EditIBSQL(DataSet: TIBSQL): boolean;
120
121 implementation
122
123 {$R *.lfm}
124
125 uses InterfaceBase
126 {$if lcl_fullversion >= 01070000}, LCLPlatformDef {$ENDIF};
127
128 function EditIBSQL(DataSet: TIBSQL): boolean;
129 begin
130 Result := false;
131 if assigned(DataSet.Database) then
132 try
133 DataSet.Database.Connected := true;
134 except on E: Exception do
135 ShowMessage(E.Message)
136 end;
137
138 with TIBSQLEditorForm.Create(Application) do
139 try
140 SetDatabase(DataSet.Database);
141 SQLText.Lines.Assign(DataSet.SQL);
142 GenerateParams.Checked := DataSet.GenerateParamNames;
143 Result := ShowModal = mrOK;
144 if Result then
145 begin
146 DataSet.SQL.Assign(SQLText.Lines);
147 DataSet.GenerateParamNames := GenerateParams.Checked
148 end;
149 finally
150 Free
151 end;
152
153 end;
154
155 { TIBSQLEditorForm }
156
157 procedure TIBSQLEditorForm.FormShow(Sender: TObject);
158 var IsProcedureName: boolean;
159 begin
160 if WidgetSet.LCLPlatform = lpGtk2 then
161 PageControl.TabPosition := tpLeft
162 else
163 PageControl.TabPosition := tpTop;
164 GenerateBtn.Enabled := (IBTransaction1.DefaultDatabase <> nil) and IBTransaction1.DefaultDatabase.Connected;
165 TestBtn.Enabled := (IBTransaction1.DefaultDatabase <> nil) and IBTransaction1.DefaultDatabase.Connected;
166 if Trim(SQLText.Text) <> '' then
167 begin
168 case FIBSystemTables.GetStatementType(SQLText.Text,IsProcedureName) of
169 SQLSelect:
170 if IsProcedureName then
171 PageControl.ActivePage := ExecutePage
172 else
173 PageControl.ActivePage := SelectPage;
174 SQLInsert: PageControl.ActivePage := InsertPage;
175 SQLUpdate: PageControl.ActivePage := ModifyPage;
176 SQLDelete: PageControl.ActivePage := DeletePage;
177 SQLExecProcedure: PageControl.ActivePage := ExecutePage;
178 else
179 PageControl.ActivePage := SelectPage;
180 end;
181 FIBSystemTables.GetTableAndColumns(SQLText.Text,FTableName,nil)
182 end;
183 end;
184
185 procedure TIBSQLEditorForm.IncludePrimaryKeysClick(Sender: TObject);
186 begin
187 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked);
188 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
189 end;
190
191 procedure TIBSQLEditorForm.DeletePageShow(Sender: TObject);
192 var TableName: string;
193 begin
194 FIBSystemTables.GetTableNames(DeleteTableNames.Items);
195 if Trim(SQLText.Text) = '' then
196 begin
197 if FTableName <> '' then
198 DeleteTableNames.ItemIndex := DeleteTableNames.Items.IndexOf(FTableName)
199 else
200 if DeleteTableNames.Items.Count > 0 then
201 DeleteTableNames.ItemIndex := 0
202 end
203 else
204 begin
205 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
206 DeleteTableNames.ItemIndex := DeleteTableNames.Items.IndexOf(TableName);
207 end;
208 FIBSystemTables.GetPrimaryKeys(DeleteTableNames.Text,DeletePrimaryKeys.Items);
209
210 end;
211
212 procedure TIBSQLEditorForm.GenerateBtnClick(Sender: TObject);
213 var FieldNames: TStrings;
214 begin
215 FieldNames := nil;
216 if PageControl.ActivePage = SelectPage then
217 begin
218 FieldNames := FIBSystemTables.GetFieldNames(SelectFieldsList);
219 FIBSystemTables.GenerateSelectSQL(SelectTableNames.Text,QuoteFields.Checked,FieldNames,SQLText.Lines);
220 end
221 else
222 if PageControl.ActivePage = InsertPage then
223 begin
224 FieldNames := FIBSystemTables.GetFieldNames(InsertFieldsList);
225 FIBSystemTables.GenerateInsertSQL(InsertTableNames.Text,QuoteFields.Checked,FieldNames,SQLText.Lines);
226 end
227 else
228 if PageControl.ActivePage = ModifyPage then
229 begin
230 FieldNames := FIBSystemTables.GetFieldNames(ModifyFieldsList);
231 FIBSystemTables.GenerateModifySQL(ModifyTableNames.Text,QuoteFields.Checked,FieldNames,SQLText.Lines);
232 end
233 else
234 if PageControl.ActivePage = DeletePage then
235 FIBSystemTables.GenerateDeleteSQL(DeleteTableNames.Text,QuoteFields.Checked,SQLText.Lines)
236 else
237 if PageControl.ActivePage = ExecutePage then
238 FIBSystemTables.GenerateExecuteSQL(ProcedureNames.Text,QuoteFields.Checked, FExecuteOnly,
239 ProcInputList.Items,ProcOutputList.Items,SQLText.Lines);
240
241 if FieldNames <> nil then
242 FieldNames.Free
243 end;
244
245 procedure TIBSQLEditorForm.TestBtnClick(Sender: TObject);
246 begin
247 FIBSystemTables.TestSQL(SQLText.Text,GenerateParams.Checked);
248 end;
249
250 procedure TIBSQLEditorForm.DeleteTableNamesCloseUp(Sender: TObject);
251 begin
252 FTableName := DeleteTableNames.Text;
253 FIBSystemTables.GetPrimaryKeys(DeleteTableNames.Text,DeletePrimaryKeys.Items);
254 end;
255
256 procedure TIBSQLEditorForm.ExecutePageShow(Sender: TObject);
257 var ProcName: string;
258 IsProcedureName: boolean;
259 begin
260 FIBSystemTables.GetProcedureNames(ProcedureNames.Items);
261 if ProcedureNames.Items.Count > 0 then
262 begin
263 if (FIBSystemTables.GetStatementType(SQLText.Text,IsProcedureName) = SQLExecProcedure) or IsProcedureName then
264 begin
265 FIBSystemTables.GetTableAndColumns(SQLText.Text,ProcName,nil);
266 ProcedureNames.ItemIndex := ProcedureNames.Items.IndexOf(ProcName)
267 end
268 else
269 ProcedureNames.ItemIndex := 0;
270 end;
271 FIBSystemTables.GetProcParams(ProcedureNames.Text,FExecuteOnly,ProcInputList.Items,ProcOutputList.Items);
272 SelectProcedure.Visible := not FExecuteOnly;
273 end;
274
275 procedure TIBSQLEditorForm.InsertPageShow(Sender: TObject);
276 var TableName: string;
277 begin
278 FIBSystemTables.GetTableNames(InsertTableNames.Items);
279 if Trim(SQLText.Text) = '' then
280 begin
281 if FTableName <> '' then
282 InsertTableNames.ItemIndex := InsertTableNames.Items.IndexOf(FTableName)
283 else
284 if InsertTableNames.Items.Count > 0 then
285 InsertTableNames.ItemIndex := 0
286 end
287 else
288 begin
289 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
290 InsertTableNames.ItemIndex := InsertTableNames.Items.IndexOf(TableName);
291 end;
292 FIBSystemTables.GetFieldNames(InsertTableNames.Text,InsertFieldsList.Items);
293
294 end;
295
296 procedure TIBSQLEditorForm.Label13Click(Sender: TObject);
297 begin
298 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked);
299 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
300 end;
301
302 procedure TIBSQLEditorForm.ModifyPageShow(Sender: TObject);
303 var TableName: string;
304 begin
305 FIBSystemTables.GetTableNames(ModifyTableNames.Items);
306 if Trim(SQLText.Text) = '' then
307 begin
308 if FTableName <> '' then
309 ModifyTableNames.ItemIndex := ModifyTableNames.Items.IndexOf(FTableName)
310 else
311 if ModifyTableNames.Items.Count > 0 then
312 ModifyTableNames.ItemIndex := 0;
313 end
314 else
315 begin
316 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
317 ModifyTableNames.ItemIndex := ModifyTableNames.Items.IndexOf(TableName);
318 end;
319 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked,false);
320 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
321 end;
322
323 procedure TIBSQLEditorForm.ModifyTableNamesCloseUp(Sender: TObject);
324 begin
325 FTableName := ModifyTableNames.Text;
326 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked,false);
327 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
328 end;
329
330 procedure TIBSQLEditorForm.ProcedureNamesCloseUp(Sender: TObject);
331 begin
332 FIBSystemTables.GetProcParams(ProcedureNames.Text,FExecuteOnly,ProcInputList.Items,ProcOutputList.Items);
333 SelectProcedure.Visible := not FExecuteOnly
334 end;
335
336 procedure TIBSQLEditorForm.SelectFieldsListDblClick(Sender: TObject);
337 begin
338 SQLText.SelText:= (Sender as TListBox).Items[(Sender as TListBox).ItemIndex];
339 end;
340
341 procedure TIBSQLEditorForm.SelectPageShow(Sender: TObject);
342 var TableName: string;
343 begin
344 FIBSystemTables.GetTableNames(SelectTableNames.Items);
345 if Trim(SQLText.Text) = '' then
346 begin
347 if FTableName <> '' then
348 SelectTableNames.ItemIndex := SelectTableNames.Items.IndexOf(FTableName)
349 else
350 if SelectTableNames.Items.Count > 0 then
351 SelectTableNames.ItemIndex := 0;
352 end
353 else
354 begin
355 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
356 SelectTableNames.ItemIndex := SelectTableNames.Items.IndexOf(TableName);
357 end;
358 FIBSystemTables.GetFieldNames(SelectTableNames.Text,SelectFieldsList.Items);
359 FIBSystemTables.GetPrimaryKeys(SelectTableNames.Text,SelectPrimaryKeys.Items);
360 end;
361
362 procedure TIBSQLEditorForm.SelectTableNamesCloseUp(Sender: TObject);
363 begin
364 FTableName := SelectTableNames.Text;
365 try
366 FIBSystemTables.GetFieldNames(SelectTableNames.Text,SelectFieldsList.Items);
367 FIBSystemTables.GetPrimaryKeys(SelectTableNames.Text,SelectPrimaryKeys.Items);
368 except {ignore} end;
369 end;
370
371 procedure TIBSQLEditorForm.InsertTableNamesCloseUp(Sender: TObject);
372 begin
373 FTableName := InsertTableNames.Text;
374 FIBSystemTables.GetFieldNames(InsertTableNames.Text,InsertFieldsList.Items);
375 end;
376
377 procedure TIBSQLEditorForm.Loaded;
378 begin
379 inherited Loaded;
380 {$IFDEF WINDOWS}
381 if assigned(PageControl) then
382 PageControl.TabPosition := tpTop;
383 {$ENDIF}
384 end;
385
386 constructor TIBSQLEditorForm.Create(TheOwner: TComponent);
387 begin
388 inherited Create(TheOwner);
389 FIBSystemTables := TIBSystemTables.Create;
390 end;
391
392 destructor TIBSQLEditorForm.Destroy;
393 begin
394 if assigned(FIBSystemTables) then FIBSystemTables.Free;
395 inherited Destroy;
396 end;
397
398 procedure TIBSQLEditorForm.SetDatabase(Database: TIBDatabase);
399 begin
400 IBTransaction1.DefaultDatabase := Database;
401 FIBSystemTables.SelectDatabase(Database,IBTransaction1)
402 end;
403
404 end.