ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/ibsqleditor.pas
Revision: 37
Committed: Mon Feb 15 14:44:25 2016 UTC (8 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 12746 byte(s)
Log Message:
Committing updates for Release R1-4-0

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;
35
36 type
37
38 { TIBSQLEditorForm }
39
40 TIBSQLEditorForm = class(TForm)
41 Button1: TButton;
42 Button2: TButton;
43 GenerateParams: TCheckBox;
44 GenerateBtn: TButton;
45 IBTransaction1: TIBTransaction;
46 Label5: TLabel;
47 SelectProcedure: TLabel;
48 TestBtn: TButton;
49 IncludePrimaryKeys: TCheckBox;
50 Label1: TLabel;
51 Label10: TLabel;
52 Label11: TLabel;
53 Label12: TLabel;
54 Label14: TLabel;
55 Label15: TLabel;
56 Label16: TLabel;
57 Label17: TLabel;
58 Label18: TLabel;
59 Label2: TLabel;
60 Label3: TLabel;
61 Label4: TLabel;
62 Label8: TLabel;
63 Label9: TLabel;
64 SelectFieldsList: TListBox;
65 ProcOutputList: TListBox;
66 SelectPrimaryKeys: TListBox;
67 InsertFieldsList: TListBox;
68 ModifyFieldsList: TListBox;
69 ModifyPrimaryKeys: TListBox;
70 DeletePrimaryKeys: TListBox;
71 ProcInputList: TListBox;
72 PageControl: TPageControl;
73 QuoteFields: TCheckBox;
74 SQLText: TMemo;
75 SelectPage: TTabSheet;
76 InsertPage: TTabSheet;
77 ModifyPage: TTabSheet;
78 DeletePage: TTabSheet;
79 ExecutePage: TTabSheet;
80 SelectTableNames: TComboBox;
81 InsertTableNames: TComboBox;
82 ModifyTableNames: TComboBox;
83 DeleteTableNames: TComboBox;
84 ProcedureNames: TComboBox;
85 procedure GenerateBtnClick(Sender: TObject);
86 procedure TestBtnClick(Sender: TObject);
87 procedure DeletePageShow(Sender: TObject);
88 procedure DeleteTableNamesCloseUp(Sender: TObject);
89 procedure ExecutePageShow(Sender: TObject);
90 procedure FormShow(Sender: TObject);
91 procedure IncludePrimaryKeysClick(Sender: TObject);
92 procedure InsertPageShow(Sender: TObject);
93 procedure Label13Click(Sender: TObject);
94 procedure ModifyPageShow(Sender: TObject);
95 procedure ModifyTableNamesCloseUp(Sender: TObject);
96 procedure ProcedureNamesCloseUp(Sender: TObject);
97 procedure SelectFieldsListDblClick(Sender: TObject);
98 procedure SelectPageShow(Sender: TObject);
99 procedure SelectTableNamesCloseUp(Sender: TObject);
100 procedure InsertTableNamesCloseUp(Sender: TObject);
101 private
102 { private declarations }
103 FTableName: string;
104 FIBSystemTables: TIBSystemTables;
105 FExecuteOnly: boolean;
106 protected
107 procedure Loaded; override;
108 public
109 { public declarations }
110 constructor Create(TheOwner: TComponent); override;
111 destructor Destroy; override;
112 procedure SetDatabase(Database: TIBDatabase);
113 end;
114
115 var
116 IBSQLEditorForm: TIBSQLEditorForm;
117
118 function EditIBSQL(DataSet: TIBSQL): boolean;
119
120 implementation
121
122 {$R *.lfm}
123
124 uses InterfaceBase;
125
126 function EditIBSQL(DataSet: TIBSQL): boolean;
127 begin
128 Result := false;
129 if assigned(DataSet.Database) then
130 try
131 DataSet.Database.Connected := true;
132 except on E: Exception do
133 ShowMessage(E.Message)
134 end;
135
136 with TIBSQLEditorForm.Create(Application) do
137 try
138 SetDatabase(DataSet.Database);
139 SQLText.Lines.Assign(DataSet.SQL);
140 GenerateParams.Checked := DataSet.GenerateParamNames;
141 Result := ShowModal = mrOK;
142 if Result then
143 begin
144 DataSet.SQL.Assign(SQLText.Lines);
145 DataSet.GenerateParamNames := GenerateParams.Checked
146 end;
147 finally
148 Free
149 end;
150
151 end;
152
153 { TIBSQLEditorForm }
154
155 procedure TIBSQLEditorForm.FormShow(Sender: TObject);
156 var IsProcedureName: boolean;
157 begin
158 if WidgetSet.LCLPlatform = lpGtk2 then
159 PageControl.TabPosition := tpLeft
160 else
161 PageControl.TabPosition := tpTop;
162 GenerateBtn.Enabled := (IBTransaction1.DefaultDatabase <> nil) and IBTransaction1.DefaultDatabase.Connected;
163 TestBtn.Enabled := (IBTransaction1.DefaultDatabase <> nil) and IBTransaction1.DefaultDatabase.Connected;
164 if Trim(SQLText.Text) <> '' then
165 begin
166 case FIBSystemTables.GetStatementType(SQLText.Text,IsProcedureName) of
167 SQLSelect:
168 if IsProcedureName then
169 PageControl.ActivePage := ExecutePage
170 else
171 PageControl.ActivePage := SelectPage;
172 SQLInsert: PageControl.ActivePage := InsertPage;
173 SQLUpdate: PageControl.ActivePage := ModifyPage;
174 SQLDelete: PageControl.ActivePage := DeletePage;
175 SQLExecProcedure: PageControl.ActivePage := ExecutePage;
176 else
177 PageControl.ActivePage := SelectPage;
178 end;
179 FIBSystemTables.GetTableAndColumns(SQLText.Text,FTableName,nil)
180 end;
181 end;
182
183 procedure TIBSQLEditorForm.IncludePrimaryKeysClick(Sender: TObject);
184 begin
185 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked);
186 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
187 end;
188
189 procedure TIBSQLEditorForm.DeletePageShow(Sender: TObject);
190 var TableName: string;
191 begin
192 FIBSystemTables.GetTableNames(DeleteTableNames.Items);
193 if Trim(SQLText.Text) = '' then
194 begin
195 if FTableName <> '' then
196 DeleteTableNames.ItemIndex := DeleteTableNames.Items.IndexOf(FTableName)
197 else
198 if DeleteTableNames.Items.Count > 0 then
199 DeleteTableNames.ItemIndex := 0
200 end
201 else
202 begin
203 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
204 DeleteTableNames.ItemIndex := DeleteTableNames.Items.IndexOf(TableName);
205 end;
206 FIBSystemTables.GetPrimaryKeys(DeleteTableNames.Text,DeletePrimaryKeys.Items);
207
208 end;
209
210 procedure TIBSQLEditorForm.GenerateBtnClick(Sender: TObject);
211 var FieldNames: TStrings;
212 begin
213 FieldNames := nil;
214 if PageControl.ActivePage = SelectPage then
215 begin
216 FieldNames := FIBSystemTables.GetFieldNames(SelectFieldsList);
217 FIBSystemTables.GenerateSelectSQL(SelectTableNames.Text,QuoteFields.Checked,FieldNames,SQLText.Lines);
218 end
219 else
220 if PageControl.ActivePage = InsertPage then
221 begin
222 FieldNames := FIBSystemTables.GetFieldNames(InsertFieldsList);
223 FIBSystemTables.GenerateInsertSQL(InsertTableNames.Text,QuoteFields.Checked,FieldNames,SQLText.Lines);
224 end
225 else
226 if PageControl.ActivePage = ModifyPage then
227 begin
228 FieldNames := FIBSystemTables.GetFieldNames(ModifyFieldsList);
229 FIBSystemTables.GenerateModifySQL(ModifyTableNames.Text,QuoteFields.Checked,FieldNames,SQLText.Lines);
230 end
231 else
232 if PageControl.ActivePage = DeletePage then
233 FIBSystemTables.GenerateDeleteSQL(DeleteTableNames.Text,QuoteFields.Checked,SQLText.Lines)
234 else
235 if PageControl.ActivePage = ExecutePage then
236 FIBSystemTables.GenerateExecuteSQL(ProcedureNames.Text,QuoteFields.Checked, FExecuteOnly,
237 ProcInputList.Items,ProcOutputList.Items,SQLText.Lines);
238
239 if FieldNames <> nil then
240 FieldNames.Free
241 end;
242
243 procedure TIBSQLEditorForm.TestBtnClick(Sender: TObject);
244 begin
245 FIBSystemTables.TestSQL(SQLText.Text,GenerateParams.Checked);
246 end;
247
248 procedure TIBSQLEditorForm.DeleteTableNamesCloseUp(Sender: TObject);
249 begin
250 FTableName := DeleteTableNames.Text;
251 FIBSystemTables.GetPrimaryKeys(DeleteTableNames.Text,DeletePrimaryKeys.Items);
252 end;
253
254 procedure TIBSQLEditorForm.ExecutePageShow(Sender: TObject);
255 var ProcName: string;
256 IsProcedureName: boolean;
257 begin
258 FIBSystemTables.GetProcedureNames(ProcedureNames.Items);
259 if ProcedureNames.Items.Count > 0 then
260 begin
261 if (FIBSystemTables.GetStatementType(SQLText.Text,IsProcedureName) = SQLExecProcedure) or IsProcedureName then
262 begin
263 FIBSystemTables.GetTableAndColumns(SQLText.Text,ProcName,nil);
264 ProcedureNames.ItemIndex := ProcedureNames.Items.IndexOf(ProcName)
265 end
266 else
267 ProcedureNames.ItemIndex := 0;
268 end;
269 FIBSystemTables.GetProcParams(ProcedureNames.Text,FExecuteOnly,ProcInputList.Items,ProcOutputList.Items);
270 SelectProcedure.Visible := not FExecuteOnly;
271 end;
272
273 procedure TIBSQLEditorForm.InsertPageShow(Sender: TObject);
274 var TableName: string;
275 begin
276 FIBSystemTables.GetTableNames(InsertTableNames.Items);
277 if Trim(SQLText.Text) = '' then
278 begin
279 if FTableName <> '' then
280 InsertTableNames.ItemIndex := InsertTableNames.Items.IndexOf(FTableName)
281 else
282 if InsertTableNames.Items.Count > 0 then
283 InsertTableNames.ItemIndex := 0
284 end
285 else
286 begin
287 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
288 InsertTableNames.ItemIndex := InsertTableNames.Items.IndexOf(TableName);
289 end;
290 FIBSystemTables.GetFieldNames(InsertTableNames.Text,InsertFieldsList.Items);
291
292 end;
293
294 procedure TIBSQLEditorForm.Label13Click(Sender: TObject);
295 begin
296 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked);
297 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
298 end;
299
300 procedure TIBSQLEditorForm.ModifyPageShow(Sender: TObject);
301 var TableName: string;
302 begin
303 FIBSystemTables.GetTableNames(ModifyTableNames.Items);
304 if Trim(SQLText.Text) = '' then
305 begin
306 if FTableName <> '' then
307 ModifyTableNames.ItemIndex := ModifyTableNames.Items.IndexOf(FTableName)
308 else
309 if ModifyTableNames.Items.Count > 0 then
310 ModifyTableNames.ItemIndex := 0;
311 end
312 else
313 begin
314 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
315 ModifyTableNames.ItemIndex := ModifyTableNames.Items.IndexOf(TableName);
316 end;
317 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked,false);
318 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
319 end;
320
321 procedure TIBSQLEditorForm.ModifyTableNamesCloseUp(Sender: TObject);
322 begin
323 FTableName := ModifyTableNames.Text;
324 FIBSystemTables.GetFieldNames(ModifyTableNames.Text,ModifyFieldsList.Items,IncludePrimaryKeys.checked,false);
325 FIBSystemTables.GetPrimaryKeys(ModifyTableNames.Text,ModifyPrimaryKeys.Items);
326 end;
327
328 procedure TIBSQLEditorForm.ProcedureNamesCloseUp(Sender: TObject);
329 begin
330 FIBSystemTables.GetProcParams(ProcedureNames.Text,FExecuteOnly,ProcInputList.Items,ProcOutputList.Items);
331 SelectProcedure.Visible := not FExecuteOnly
332 end;
333
334 procedure TIBSQLEditorForm.SelectFieldsListDblClick(Sender: TObject);
335 begin
336 SQLText.SelText:= (Sender as TListBox).Items[(Sender as TListBox).ItemIndex];
337 end;
338
339 procedure TIBSQLEditorForm.SelectPageShow(Sender: TObject);
340 var TableName: string;
341 begin
342 FIBSystemTables.GetTableNames(SelectTableNames.Items);
343 if Trim(SQLText.Text) = '' then
344 begin
345 if FTableName <> '' then
346 SelectTableNames.ItemIndex := SelectTableNames.Items.IndexOf(FTableName)
347 else
348 if SelectTableNames.Items.Count > 0 then
349 SelectTableNames.ItemIndex := 0;
350 end
351 else
352 begin
353 FIBSystemTables.GetTableAndColumns(SQLText.Text,TableName,nil);
354 SelectTableNames.ItemIndex := SelectTableNames.Items.IndexOf(TableName);
355 end;
356 FIBSystemTables.GetFieldNames(SelectTableNames.Text,SelectFieldsList.Items);
357 FIBSystemTables.GetPrimaryKeys(SelectTableNames.Text,SelectPrimaryKeys.Items);
358 end;
359
360 procedure TIBSQLEditorForm.SelectTableNamesCloseUp(Sender: TObject);
361 begin
362 FTableName := SelectTableNames.Text;
363 try
364 FIBSystemTables.GetFieldNames(SelectTableNames.Text,SelectFieldsList.Items);
365 FIBSystemTables.GetPrimaryKeys(SelectTableNames.Text,SelectPrimaryKeys.Items);
366 except {ignore} end;
367 end;
368
369 procedure TIBSQLEditorForm.InsertTableNamesCloseUp(Sender: TObject);
370 begin
371 FTableName := InsertTableNames.Text;
372 FIBSystemTables.GetFieldNames(InsertTableNames.Text,InsertFieldsList.Items);
373 end;
374
375 procedure TIBSQLEditorForm.Loaded;
376 begin
377 inherited Loaded;
378 {$IFDEF WINDOWS}
379 if assigned(PageControl) then
380 PageControl.TabPosition := tpTop;
381 {$ENDIF}
382 end;
383
384 constructor TIBSQLEditorForm.Create(TheOwner: TComponent);
385 begin
386 inherited Create(TheOwner);
387 FIBSystemTables := TIBSystemTables.Create;
388 end;
389
390 destructor TIBSQLEditorForm.Destroy;
391 begin
392 if assigned(FIBSystemTables) then FIBSystemTables.Free;
393 inherited Destroy;
394 end;
395
396 procedure TIBSQLEditorForm.SetDatabase(Database: TIBDatabase);
397 begin
398 IBTransaction1.DefaultDatabase := Database;
399 FIBSystemTables.SelectDatabase(Database,IBTransaction1)
400 end;
401
402 end.