ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSQLEditFrame.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 43462 byte(s)
Log Message:
Release 2.3.2 committed

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-17 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26 unit IBSQLEditFrame;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, FileUtil, SynEdit, SynHighlighterSQL, LResources, Forms,
34 Controls, ActnList, Menus, Dialogs, ComCtrls, ExtCtrls, StdCtrls, IBQuery,
35 IBSQL, IBDatabase, IBUpdate, IBDatabaseInfo,
36 IBCustomDataset, db, LazSynTextArea, IB;
37
38 type
39
40 { TIBSQLEditFrame }
41
42 TIBSQLEditFrame = class(TFrame)
43 PackageNameSource: TDataSource;
44 PackageNames: TIBQuery;
45 ReadOnlyFieldsSource: TDataSource;
46 IBUpdate6: TIBUpdate;
47 ReadOnlyFields: TIBQuery;
48 IBUpdate5: TIBUpdate;
49 IdentityColsSource: TDataSource;
50 FieldNameList: TIBQuery;
51 FieldsSource: TDataSource;
52 DatabaseInfo: TIBDatabaseInfo;
53 IdentityCols: TIBQuery;
54 IBUpdate1: TIBUpdate;
55 IBUpdate2: TIBUpdate;
56 IBUpdate3: TIBUpdate;
57 IBUpdate4: TIBUpdate;
58 SQLTransaction: TIBTransaction;
59 IdentifyStatementSQL: TIBSQL;
60 PrimaryKeys: TIBQuery;
61 PrimaryKeySource: TDataSource;
62 ProcInputParams: TIBQuery;
63 ProcInputSource: TDataSource;
64 ProcOutputParams: TIBQuery;
65 ProcOutputSource: TDataSource;
66 Redo: TAction;
67 ToolButton10: TToolButton;
68 ToolButton11: TToolButton;
69 Undo: TAction;
70 SaveToFile: TAction;
71 LoadFromFile: TAction;
72 BtnImages: TImageList;
73 MenuItem8: TMenuItem;
74 MenuItem9: TMenuItem;
75 OpenDialog1: TOpenDialog;
76 SaveDialog1: TSaveDialog;
77 ToolBar1: TToolBar;
78 ToolButton1: TToolButton;
79 ToolButton2: TToolButton;
80 ToolButton3: TToolButton;
81 ToolButton4: TToolButton;
82 ToolButton5: TToolButton;
83 ToolButton6: TToolButton;
84 ToolButton7: TToolButton;
85 ToolButton8: TToolButton;
86 ToolButton9: TToolButton;
87 UserProcedures: TIBQuery;
88 UserProcSource: TDataSource;
89 UserTables: TIBQuery;
90 UserTableSource: TDataSource;
91 WrapText: TAction;
92 Clear: TAction;
93 MenuItem1: TMenuItem;
94 MenuItem2: TMenuItem;
95 MenuItem3: TMenuItem;
96 MenuItem4: TMenuItem;
97 MenuItem5: TMenuItem;
98 MenuItem6: TMenuItem;
99 MenuItem7: TMenuItem;
100 PopupMenu1: TPopupMenu;
101 SelectAll: TAction;
102 Paste: TAction;
103 CopyText: TAction;
104 Cut: TAction;
105 ActionList1: TActionList;
106 SQLText: TSynEdit;
107 SynSQLSyn1: TSynSQLSyn;
108 procedure ClearExecute(Sender: TObject);
109 procedure CopyTextExecute(Sender: TObject);
110 procedure CutExecute(Sender: TObject);
111 procedure CutUpdate(Sender: TObject);
112 procedure FieldNameListBeforeOpen(DataSet: TDataSet);
113 procedure IBUpdate1ApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
114 Params: ISQLParams);
115 procedure LoadFromFileExecute(Sender: TObject);
116 procedure PackageNamesAfterScroll(DataSet: TDataSet);
117 procedure PackageNamesBeforeClose(DataSet: TDataSet);
118 procedure PasteExecute(Sender: TObject);
119 procedure PasteUpdate(Sender: TObject);
120 procedure RedoExecute(Sender: TObject);
121 procedure RedoUpdate(Sender: TObject);
122 procedure SaveToFileExecute(Sender: TObject);
123 procedure SelectAllExecute(Sender: TObject);
124 procedure SelectAllUpdate(Sender: TObject);
125 procedure UndoExecute(Sender: TObject);
126 procedure UndoUpdate(Sender: TObject);
127 procedure UserProceduresAfterOpen(DataSet: TDataSet);
128 procedure UserProceduresBeforeClose(DataSet: TDataSet);
129 procedure UserProceduresBeforeOpen(DataSet: TDataSet);
130 procedure UserTablesAfterOpen(DataSet: TDataSet);
131 procedure UserTablesBeforeClose(DataSet: TDataSet);
132 procedure UserTablesBeforeOpen(DataSet: TDataSet);
133 procedure WrapTextExecute(Sender: TObject);
134 procedure WrapTextUpdate(Sender: TObject);
135 private
136 FDatabase: TIBDatabase;
137 FExcludeIdentityColumns: boolean;
138 FExecuteOnlyProcs: boolean;
139 FIncludeReadOnlyFields: boolean;
140 FIncludeSystemTables: boolean;
141 FOnUserTablesOpened: TNotifyEvent;
142 FOpening: boolean;
143 FSelectProcs: boolean;
144 FQuerySync: boolean;
145 procedure AddWhereClause(QuotedStrings: boolean; SQL: TStrings;
146 UseOldValues: boolean);
147 function GetSQLType(SQLType: TIBSQLStatementTypes): string;
148 procedure GetFieldNames(Dataset: TDataset; var FieldNames: TStrings;
149 aIncludeReadOnly: boolean = true);
150 procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; FieldNames,PrimaryKeyNames, SQL: TStrings); overload;
151 procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean;
152 FieldNames, ReadOnlyFieldNames, SQL: TStrings); overload;
153 procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean;
154 FieldNames, ReadOnlyFieldNames, SQL: TStrings); overload;
155 procedure GenerateExecuteSQL(PackageName, ProcName: string;
156 QuotedStrings: boolean; ExecuteOnly: boolean; InputParams, OutputParams,
157 ExecuteSQL: TStrings); overload;
158 procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; ReadOnlyFieldNames, SQL: TStrings); overload;
159 procedure SetDatabase(AValue: TIBDatabase);
160 procedure SetExcludeIdentityColumns(AValue: boolean);
161 procedure SetExecuteOnlyProcs(AValue: boolean);
162 procedure SetIncludeReadOnlyFields(AValue: boolean);
163 procedure SetIncludeSystemTables(AValue: boolean);
164 procedure SetSelectProcs(AValue: boolean);
165
166 public
167 constructor Create(aOwner: TComponent); override;
168 procedure DoWrapText(Lines: TStrings); overload;
169 procedure DoWrapText; overload;
170 procedure UnWrapText;
171 procedure RefreshAll;
172 procedure SelectAllFields(Checked: boolean);
173 procedure GenerateSelectSQL(QuotedStrings: boolean; AddReadOnlyFields: boolean = false); overload;
174 procedure GenerateSelectSQL(QuotedStrings: boolean; SQL: TStrings; AddReadOnlyFields: boolean = false); overload;
175 procedure GenerateRefreshSQL(QuotedStrings: boolean);
176 procedure GenerateRefreshSQL(QuotedStrings: boolean; SQL: TStrings; AddReadOnlyFields: boolean = false);
177 procedure GenerateExecuteSQL(QuotedStrings: boolean); overload;
178 procedure GenerateInsertSQL(QuotedStrings: boolean); overload;
179 procedure GenerateInsertSQL(QuotedStrings: boolean; SQL: TStrings); overload;
180 procedure GenerateModifySQL(QuotedStrings: boolean; aIncludePrimaryKeys: boolean); overload;
181 procedure GenerateModifySQL(QuotedStrings: boolean; SQL: TStrings; aIncludePrimaryKeys: boolean); overload;
182 procedure GenerateDeleteSQL(QuotedStrings: boolean); overload;
183 procedure GenerateDeleteSQL(QuotedStrings: boolean; SQL: TStrings); overload;
184 function GetStatementType(var IsStoredProcedure: boolean): TIBSQLStatementTypes;
185 procedure InsertSelectedPrimaryKey;
186 procedure InsertSelectedFieldName;
187 procedure InsertTableName;
188 procedure InsertProcName;
189 procedure InsertPackageName;
190 procedure InsertSelectedInputParam;
191 procedure InsertSelectedOutputParam;
192 procedure InsertSelectedIdentityCol;
193 procedure InsertSelectedReadOnlyField;
194 procedure OpenUserProcedures;
195 function SyncQueryBuilder: TIBSQLStatementTypes; overload;
196 function SyncQueryBuilder(SQL: TStrings): TIBSQLStatementTypes; overload;
197 procedure TestSQL(GenerateParamNames: boolean);
198 property Database: TIBDatabase read FDatabase write SetDatabase;
199 property IncludeReadOnlyFields: boolean read FIncludeReadOnlyFields write SetIncludeReadOnlyFields;
200 property IncludeSystemTables: boolean read FIncludeSystemTables write SetIncludeSystemTables;
201 property ExcludeIdentityColumns: boolean read FExcludeIdentityColumns write SetExcludeIdentityColumns;
202 property ExecuteOnlyProcs: boolean read FExecuteOnlyProcs write SetExecuteOnlyProcs;
203 property SelectProcs: boolean read FSelectProcs write SetSelectProcs;
204 property OnUserTablesOpened: TNotifyEvent read FOnUserTablesOpened write FOnUserTablesOpened;
205 end;
206
207 implementation
208
209 Uses IBUtils, FBMessages, Variants;
210
211 {$R *.lfm}
212
213 const
214 sNoPrimaryKeys = 'RF.RDB$FIELD_NAME not in ' +
215 '(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
216 'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME)';
217
218 { TIBSQLEditFrame }
219
220 procedure TIBSQLEditFrame.CutUpdate(Sender: TObject);
221 begin
222 (Sender as TAction).Enabled := SQLText.SelText <> '';
223 end;
224
225 procedure TIBSQLEditFrame.FieldNameListBeforeOpen(DataSet: TDataSet);
226 begin
227 if not IncludeReadOnlyFields then
228 (DataSet as TIBQuery).Parser.Add2WhereClause('B.RDB$COMPUTED_SOURCE is NULL');
229 (DataSet as TIBQuery).Parser.Add2WhereClause(sNoPrimaryKeys);
230 if ExcludeIdentityColumns and (DatabaseInfo.ODSMajorVersion >= 12) then
231 (DataSet as TIBQuery).Parser.Add2WhereClause('RF.RDB$IDENTITY_TYPE is NULL');
232 end;
233
234 procedure TIBSQLEditFrame.IBUpdate1ApplyUpdates(Sender: TObject;
235 UpdateKind: TUpdateKind; Params: ISQLParams);
236 begin
237 //do nothing - dummy to allow edits without database update
238 end;
239
240 procedure TIBSQLEditFrame.LoadFromFileExecute(Sender: TObject);
241 begin
242 if OpenDialog1.Execute then
243 SQLText.Lines.LoadFromFile(OpenDialog1.FileName);
244 end;
245
246 procedure TIBSQLEditFrame.PackageNamesAfterScroll(DataSet: TDataSet);
247 begin
248 UserProcedures.Active := false;
249 UserProcedures.Active := true;
250 end;
251
252 procedure TIBSQLEditFrame.PackageNamesBeforeClose(DataSet: TDataSet);
253 begin
254 UserProcedures.Active := false;
255 end;
256
257 procedure TIBSQLEditFrame.PasteExecute(Sender: TObject);
258 begin
259 SQLText.PasteFromClipboard;
260 end;
261
262 procedure TIBSQLEditFrame.PasteUpdate(Sender: TObject);
263 begin
264 (Sender as TAction).Enabled := SQLText.CanPaste;
265 end;
266
267 procedure TIBSQLEditFrame.RedoExecute(Sender: TObject);
268 begin
269 SQLText.Redo;
270 end;
271
272 procedure TIBSQLEditFrame.RedoUpdate(Sender: TObject);
273 begin
274 (Sender as TAction).Enabled := SQLText.CanRedo;
275 end;
276
277 procedure TIBSQLEditFrame.SaveToFileExecute(Sender: TObject);
278 begin
279 if SaveDialog1.Execute then
280 SQLText.Lines.SaveToFile(SaveDialog1.FileName);
281 end;
282
283 procedure TIBSQLEditFrame.SelectAllExecute(Sender: TObject);
284 begin
285 SQLText.SelectAll;
286 end;
287
288 procedure TIBSQLEditFrame.SelectAllUpdate(Sender: TObject);
289 begin
290 (Sender as TAction).Enabled := SQLText.Lines.Count > 0;
291 end;
292
293 procedure TIBSQLEditFrame.UndoExecute(Sender: TObject);
294 begin
295 SQLText.Undo;
296 end;
297
298 procedure TIBSQLEditFrame.UndoUpdate(Sender: TObject);
299 begin
300 (Sender as TAction).Enabled := SQLText.CanUndo;
301 end;
302
303 procedure TIBSQLEditFrame.UserProceduresAfterOpen(DataSet: TDataSet);
304 begin
305 ProcInputParams.Active := true;
306 ProcOutputParams.Active := true;
307 end;
308
309 procedure TIBSQLEditFrame.UserProceduresBeforeClose(DataSet: TDataSet);
310 begin
311 ProcInputParams.Active := false;
312 ProcOutputParams.Active := false;
313 end;
314
315 procedure TIBSQLEditFrame.UserProceduresBeforeOpen(DataSet: TDataSet);
316 begin
317 if not (ExecuteOnlyProcs and SelectProcs) then
318 begin
319 if ExecuteOnlyProcs then
320 (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PROCEDURE_TYPE = 2');
321 if SelectProcs then
322 (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PROCEDURE_TYPE = 1 AND RDB$PROCEDURE_OUTPUTS > 0');
323 end;
324 if PackageNames.Active then
325 begin
326 if PackageNames.FieldByName('PACKAGE_NAME_TYPE').AsInteger = 0 then {global procedures}
327 (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PACKAGE_NAME is NULL')
328 else
329 (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$PACKAGE_NAME = ''' +
330 PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString + '''');
331 end;
332 // writeln((DataSet as TIBQuery).Parser.SQLText);
333 end;
334
335 procedure TIBSQLEditFrame.UserTablesAfterOpen(DataSet: TDataSet);
336 begin
337 FieldNameList.Active := true;
338 PrimaryKeys.Active := true;
339 IdentityCols.Active := DatabaseInfo.ODSMajorVersion >= 12;
340 ReadOnlyFields.Active := true;
341 FOpening := true;
342 try
343 if assigned(FOnUserTablesOpened) then
344 OnUserTablesOpened(self);
345 finally
346 FOpening := false;
347 end;
348 end;
349
350 procedure TIBSQLEditFrame.UserTablesBeforeClose(DataSet: TDataSet);
351 begin
352 FieldNameList.Active := false;
353 PrimaryKeys.Active := false;
354 IdentityCols.Active := false;
355 ReadOnlyFields.Active := false;
356 end;
357
358 procedure TIBSQLEditFrame.UserTablesBeforeOpen(DataSet: TDataSet);
359 begin
360 if not IncludeSystemTables then
361 (DataSet as TIBQuery).Parser.Add2WhereClause('RDB$SYSTEM_FLAG = 0');
362 end;
363
364 procedure TIBSQLEditFrame.WrapTextExecute(Sender: TObject);
365 begin
366 UnWrapText;
367 DoWrapText;
368 end;
369
370 procedure TIBSQLEditFrame.WrapTextUpdate(Sender: TObject);
371 begin
372 (Sender as TAction).Enabled := SQLText.Lines.Count > 0;
373 end;
374
375 procedure TIBSQLEditFrame.SetDatabase(AValue: TIBDatabase);
376 var i: integer;
377 begin
378 if FDatabase = AValue then Exit;
379 FDatabase := AValue;
380 FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
381 SQLTransaction.Active := false;
382 SQLTransaction.DefaultDatabase := FDatabase;
383 for i := 0 to ComponentCount - 1 do
384 if Components[i] is TIBCustomDataset then
385 TIBCustomDataset(Components[i]).Database := FDatabase
386 else
387 if Components[i] is TIBSQL then
388 TIBSQL(Components[i]).Database := FDatabase
389 else
390 if Components[i] is TIBDatabaseInfo then
391 TIBDatabaseInfo(Components[i]).Database := FDatabase;
392 if (FDatabase <> nil) and FDatabase.Connected then
393 SQLTransaction.Active := true;
394 end;
395
396 procedure TIBSQLEditFrame.SetExcludeIdentityColumns(AValue: boolean);
397 begin
398 if FExcludeIdentityColumns = AValue then Exit;
399 FExcludeIdentityColumns := AValue;
400 RefreshAll;
401 end;
402
403 procedure TIBSQLEditFrame.SetExecuteOnlyProcs(AValue: boolean);
404 begin
405 if FExecuteOnlyProcs = AValue then Exit;
406 FExecuteOnlyProcs := AValue;
407 RefreshAll;
408 end;
409
410 procedure TIBSQLEditFrame.SetIncludeReadOnlyFields(AValue: boolean);
411 begin
412 if FIncludeReadOnlyFields = AValue then Exit;
413 FIncludeReadOnlyFields := AValue;
414 RefreshAll;
415 end;
416
417 procedure TIBSQLEditFrame.SetIncludeSystemTables(AValue: boolean);
418 begin
419 if FIncludeSystemTables = AValue then Exit;
420 FIncludeSystemTables := AValue;
421 RefreshAll;
422 SyncQueryBuilder;
423 end;
424
425 procedure TIBSQLEditFrame.SetSelectProcs(AValue: boolean);
426 begin
427 if FSelectProcs = AValue then Exit;
428 FSelectProcs := AValue;
429 RefreshAll;
430 end;
431
432 constructor TIBSQLEditFrame.Create(aOwner: TComponent);
433 begin
434 inherited Create(aOwner);
435 FIncludeReadOnlyFields := true;
436 end;
437
438 procedure TIBSQLEditFrame.DoWrapText;
439 begin
440 DoWrapText(SQLText.Lines);
441 if assigned(SQLText.OnChange) then
442 SQLText.OnChange(self);
443 end;
444
445 type
446 THackedSynEdit = class(TSynEdit)
447 public
448 property TextArea: TLazSynTextArea read FTextArea;
449 end;
450
451 procedure TIBSQLEditFrame.DoWrapText(Lines: TStrings);
452
453 var NewLines: TStringList;
454 i: integer;
455 MaxWidth: integer;
456 MaxChars: integer;
457 Line: string;
458 Tokeniser: TSynSQLSyn;
459 SplitAt: integer;
460 SQLParam: boolean;
461 begin
462 NewLines := TStringList.Create;
463 Tokeniser := TSynSQLSyn.Create(nil); {use the highligher as a tokeniser}
464 try
465 Tokeniser.SQLDialect := sqlInterbase6;
466 SQlText.Canvas.Font := SQLText.Font;
467 with THackedSynEdit(SQLText).TextArea do
468 MaxWidth := Right - Left;
469 for i := 0 to Lines.Count - 1 do
470 begin
471 Line := Lines[i];
472 repeat
473 if (Length(Line) = 0) or (SQlText.Canvas.TextWidth(Line) <= MaxWidth) then
474 begin
475 NewLines.Add(Line);
476 break; {next line}
477 end
478 else
479 begin
480 {Need to split the line at the last complete SQL token}
481 MaxChars := SQlText.Canvas.TextFitInfo(Line,MaxWidth);
482 SQLParam := false;
483 Tokeniser.ResetRange;
484 Tokeniser.SetLine(Line,i);
485 SplitAt := 0;
486 while (Tokeniser.GetTokenPos < MaxChars) and not Tokeniser.GetEol do
487 begin
488 if not SQLParam then
489 SplitAt := Tokeniser.GetTokenPos; {combine param indicator with param}
490 SQLParam := Tokeniser.GetToken = ':';
491 Tokeniser.Next;
492 end;
493
494 if SplitAt <= 0 then {token overflows line}
495 begin
496 NewLines.Add(Line);
497 break; {next line}
498 end;
499 NewLines.Add(system.copy(Line,1,SplitAt));
500 system.Delete(Line,1,SplitAt);
501 end;
502 until Length(Line) = 0;
503 end;
504 Lines.Assign(NewLines);
505 finally
506 NewLines.Free;
507 Tokeniser.Free;
508 end;
509 end;
510
511 const
512 Separators = [' ',#$09,',','.',':'];
513
514 procedure TIBSQLEditFrame.UnWrapText;
515 var Line: string;
516 i: integer;
517 begin
518 Line := '';
519 with SQLText do
520 begin
521 for i := 0 to Lines.Count - 1 do
522 begin
523 if (Length(Line) > 0) and not (Line[Length(Line)] in Separators) then
524 Line := Line + ' ';
525 Line := Line + Lines[i];
526 end;
527
528 if assigned(OnChange) then
529 OnChange(self);
530 Lines.Text := Line;
531 end;
532 end;
533
534 procedure TIBSQLEditFrame.RefreshAll;
535 begin
536 if UserTables.Active then
537 begin
538 UserTables.Active := false;
539 UserTables.Active := true;
540 end;
541 if PackageNames.Active then
542 begin
543 PackageNames.Active := false;
544 OpenUserProcedures;
545 end
546 else
547 if UserProcedures.Active then
548 begin
549 UserProcedures.Active := false;
550 OpenUserProcedures;
551 end;
552 end;
553
554 procedure TIBSQLEditFrame.SelectAllFields(Checked: boolean);
555
556 procedure DoSelectAllFields(Dataset: TDataset; aValue: boolean);
557 begin
558 with Dataset do
559 if Active then
560 begin
561 DisableControls;
562 try
563 First;
564 while not Eof do
565 begin
566 Edit;
567 FieldByName('Selected').AsInteger := ord(aValue);
568 Post;
569 Next;
570 end;
571 First;
572 finally
573 EnableControls;
574 end;
575 end;
576 end;
577
578 begin
579 if FOpening or (Database = nil) or not Database.Connected then Exit;
580 DoSelectAllFields(FieldNameList,Checked);
581 DoSelectAllFields(PrimaryKeys,Checked);
582 DoSelectAllFields(IdentityCols,Checked);
583 DoSelectAllFields(ReadOnlyFields,Checked);
584 end;
585
586 procedure TIBSQLEditFrame.GenerateSelectSQL(QuotedStrings: boolean;
587 AddReadOnlyFields: boolean);
588 begin
589 GenerateSelectSQL(QuotedStrings,SQLText.Lines,AddReadOnlyFields);
590 end;
591
592 procedure TIBSQLEditFrame.GenerateRefreshSQL(QuotedStrings: boolean);
593 begin
594 GenerateRefreshSQL(QuotedStrings,SQLText.Lines);
595 end;
596
597 procedure TIBSQLEditFrame.GenerateSelectSQL(QuotedStrings: boolean;
598 SQL: TStrings; AddReadOnlyFields: boolean);
599 var FieldNames: TStrings;
600 PrimaryKeyNames: TStrings;
601 ReadOnlyFieldNames: TStrings;
602 begin
603 SQL.Clear;
604 FieldNames := TStringList.Create;
605 PrimaryKeyNames := TStringList.Create;
606 ReadOnlyFieldNames := TStringList.Create;
607 try
608 GetFieldNames(PrimaryKeys,PrimaryKeyNames);
609 GetFieldNames(FieldNameList,FieldNames);
610 if not IncludeReadOnlyFields and AddReadOnlyFields then
611 begin
612 GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
613 FieldNames.AddStrings(ReadOnlyFieldNames);
614 end;
615 GenerateSelectSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,FieldNames,PrimaryKeyNames,SQL);
616 finally
617 FieldNames.Free;
618 PrimaryKeyNames.Free;
619 ReadOnlyFieldNames.Free;
620 end;
621 DoWrapText(SQL);
622 end;
623
624 procedure TIBSQLEditFrame.GenerateRefreshSQL(QuotedStrings: boolean;
625 SQL: TStrings; AddReadOnlyFields: boolean);
626 begin
627 SQL.Clear;
628 GenerateSelectSQL(QuotedStrings,SQL,AddReadOnlyFields);
629 AddWhereClause(QuotedStrings,SQL,false);
630 end;
631
632 procedure TIBSQLEditFrame.GenerateExecuteSQL(QuotedStrings: boolean);
633 var InputParams: TStrings;
634 OutputParams: TStrings;
635 PackageName: string;
636 begin
637 SQLText.Lines.Clear;
638
639 InputParams := TStringList.Create;
640 OutputParams := TStringList.Create;
641 try
642 if PackageNames.Active and (PackageNames.FieldByName('Package_Name_Type').AsInteger = 1) then
643 PackageName := PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString
644 else
645 PackageName := '';
646 GetFieldNames(ProcInputParams,InputParams);
647 GetFieldNames(ProcOutputParams,OutputParams);
648 GenerateExecuteSQL(PackageName,UserProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString,
649 QuotedStrings, UserProcedures.FieldByName('RDB$PROCEDURE_TYPE').AsInteger = 2,
650 InputParams,OutputParams,SQLText.Lines);
651 finally
652 InputParams.Free;
653 OutputParams.Free;
654 end;
655 end;
656
657 procedure TIBSQLEditFrame.GenerateInsertSQL(QuotedStrings: boolean);
658 begin
659 GenerateInsertSQL(QuotedStrings,SQLText.Lines);
660 end;
661
662 procedure TIBSQLEditFrame.GenerateModifySQL(QuotedStrings: boolean;
663 aIncludePrimaryKeys: boolean);
664 begin
665 GenerateModifySQL(QuotedStrings,SQLText.Lines,aIncludePrimaryKeys);
666 end;
667
668 procedure TIBSQLEditFrame.GenerateDeleteSQL(QuotedStrings: boolean);
669 begin
670 GenerateDeleteSQL(QuotedStrings,SQLText.Lines);
671 end;
672
673 procedure TIBSQLEditFrame.GenerateInsertSQL(QuotedStrings: boolean; SQL: TStrings);
674 var FieldNames: TStrings;
675 ReadOnlyFieldNames: TStrings;
676 InsertFields: TStrings;
677 I: integer;
678 begin
679 SQL.Clear;
680 FieldNames := TStringList.Create;
681 ReadOnlyFieldNames := TStringList.Create;
682 InsertFields := TStringList.Create;
683 try
684 GetFieldNames(PrimaryKeys,InsertFields);
685 for I := InsertFields.Count - 1 downto 0 do
686 if IdentityCols.Active and IdentityCols.Locate('ColumnName;Selected',VarArrayOf([InsertFields[I],1]),[loCaseInsensitive]) then
687 InsertFields.Delete(I);
688 GetFieldNames(FieldNameList,FieldNames,false);
689 InsertFields.AddStrings(FieldNames);
690 GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
691 GenerateInsertSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,InsertFields,ReadOnlyFieldNames,SQL);
692 finally
693 FieldNames.Free;
694 ReadOnlyFieldNames.Free;
695 InsertFields.Free;
696 end;
697 DoWrapText(SQL);
698 end;
699
700 procedure TIBSQLEditFrame.GenerateModifySQL(QuotedStrings: boolean;
701 SQL: TStrings; aIncludePrimaryKeys: boolean);
702 var FieldNames: TStrings;
703 ReadOnlyFieldNames: TStrings;
704 UpdateFields: TStrings;
705 begin
706 SQL.Clear;
707 FieldNames := TStringList.Create;
708 ReadOnlyFieldNames := TStringList.Create;
709 UpdateFields := TStringList.Create;
710 try
711 if aIncludePrimaryKeys then
712 GetFieldNames(PrimaryKeys,UpdateFields);
713 GetFieldNames(FieldNameList,FieldNames,false);
714 UpdateFields.AddStrings(FieldNames);
715 GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
716 GenerateModifySQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,
717 QuotedStrings,UpdateFields,ReadOnlyFieldNames,SQL);
718 finally
719 FieldNames.Free;
720 ReadOnlyFieldNames.Free;
721 UpdateFields.Free;
722 end;
723 end;
724
725 procedure TIBSQLEditFrame.GenerateDeleteSQL(QuotedStrings: boolean;
726 SQL: TStrings);
727 var ReadOnlyFieldNames: TStrings;
728 begin
729 SQL.Clear;
730 ReadOnlyFieldNames := TStringList.Create;
731 try
732 GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
733 GenerateDeleteSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,ReadOnlyFieldNames,SQL)
734 finally
735 ReadOnlyFieldNames.Free;
736 end;
737 end;
738
739 procedure TIBSQLEditFrame.CutExecute(Sender: TObject);
740 begin
741 SQLText.CutToClipboard;
742 end;
743
744 procedure TIBSQLEditFrame.CopyTextExecute(Sender: TObject);
745 begin
746 SQLText.CopyToClipboard;
747 end;
748
749 procedure TIBSQLEditFrame.ClearExecute(Sender: TObject);
750 begin
751 SQLText.Lines.Clear;
752 end;
753
754 procedure TIBSQLEditFrame.AddWhereClause(
755 QuotedStrings: boolean; SQL: TStrings; UseOldValues: boolean);
756 var WhereClause: string;
757 Separator: string;
758 Count: integer;
759 ColumnName: string;
760 ColParamName: string;
761 begin
762 Count := 0;
763 WhereClause := 'Where';
764 Separator := ' A.';
765 with PrimaryKeys do
766 begin
767 DisableControls;
768 try
769 if State = dsEdit then Post;
770 First;
771 while not EOF do
772 begin
773 if FieldByName('Selected').AsInteger <> 0 then
774 begin
775 Inc(Count);
776 ColumnName := FieldByName('ColumnName').AsString;
777 if UseOldValues then
778 ColParamName := 'OLD_' + AnsiUpperCase(ColumnName)
779 else
780 ColParamName := AnsiUpperCase(ColumnName);
781
782 if QuotedStrings then
783 WhereClause := WhereClause +
784 Separator +
785 '"' + ColumnName + '" = :"' + ColParamName + '"'
786 else
787 WhereClause := WhereClause +
788 Separator +
789 QuoteIdentifierIfNeeded(Database.SQLDialect,ColumnName) +
790 ' = :' +
791 QuoteIdentifierIfNeeded(Database.SQLDialect,ColParamName);
792 Separator := ' AND A.';
793 end;
794 Next;
795 end;
796 finally
797 EnableControls
798 end;
799 end;
800 if Count > 0 then
801 SQL.Add(WhereClause);
802 end;
803
804 function TIBSQLEditFrame.GetSQLType(SQLType: TIBSQLStatementTypes): string;
805 begin
806 case SQLType of
807 SQLUnknown: Result := 'Unknown';
808 SQLSelect: Result := 'Select';
809 SQLInsert: Result := 'Insert';
810 SQLUpdate: Result := 'Update';
811 SQLDelete: Result := 'Delete';
812 SQLDDL: Result := 'DDL';
813 SQLGetSegment: Result := 'GetSegment';
814 SQLPutSegment: Result := 'PutSegment';
815 SQLExecProcedure: Result := 'Execute Procedure';
816 SQLStartTransaction: Result := 'StartTransaction';
817 SQLCommit: Result := 'Commit';
818 SQLRollback: Result := 'Rollback';
819 SQLSelectForUpdate: Result := 'Select for Update';
820 SQLSetGenerator: Result := 'Set Generator';
821 end;
822 end;
823
824 procedure TIBSQLEditFrame.GetFieldNames(Dataset: TDataset;
825 var FieldNames: TStrings; aIncludeReadOnly: boolean);
826 begin
827 with DataSet do
828 begin
829 DisableControls;
830 try
831 if State = dsEdit then Post;
832 First;
833 while not EOF do
834 begin
835 if (FieldByName('Selected').AsInteger <> 0) and (aIncludeReadOnly or (FieldByName('ReadOnly').AsInteger = 0)) then
836 FieldNames.Add(FieldByName('ColumnName').AsString);
837 Next;
838 end;
839 finally
840 EnableControls
841 end;
842 end;
843 end;
844
845 procedure TIBSQLEditFrame.GenerateSelectSQL(TableName: string;
846 QuotedStrings: boolean; FieldNames, PrimaryKeyNames, SQL: TStrings);
847 var SelectSQL: string;
848 Separator : string;
849 I: integer;
850 Lines: TStrings;
851 begin
852 SelectSQL := 'Select';
853 Separator := ' A.';
854 for I := 0 to PrimaryKeyNames.Count - 1 do
855 begin
856 if QuotedStrings then
857 SelectSQL := SelectSQL + Separator + '"' + PrimaryKeyNames[I] + '"'
858 else
859 SelectSQL := SelectSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,PrimaryKeyNames[I]);
860 Separator := ', A.';
861 end;
862 for I := 0 to FieldNames.Count - 1 do
863 begin
864 if QuotedStrings then
865 SelectSQL := SelectSQL + Separator + '"' + FieldNames[I] + '"'
866 else
867 SelectSQL := SelectSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]);
868 Separator := ', A.';
869 end;
870 if QuotedStrings then
871 SelectSQL := SelectSQL + ' From "' + TableName + '" A'
872 else
873 SelectSQL := SelectSQL + ' From ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A';
874 Lines := TStringList.Create;
875 try
876 Lines.Text := SelectSQL;
877 SQL.AddStrings(Lines);
878 finally
879 Lines.Free;
880 end;
881 end;
882
883 procedure TIBSQLEditFrame.GenerateInsertSQL(TableName: string;
884 QuotedStrings: boolean; FieldNames, ReadOnlyFieldNames, SQL: TStrings);
885 var InsertSQL: string;
886 Separator: string;
887 Lines: TStrings;
888 I: integer;
889 begin
890 Lines := TStringList.Create;
891 try
892 if QuotedStrings then
893 InsertSQL := 'Insert Into "' + TableName + '" ('
894 else
895 InsertSQL := 'Insert Into ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' (';
896 Separator := '';
897 for I := 0 to FieldNames.Count - 1 do
898 begin
899 if QuotedStrings then
900 InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
901 else
902 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) ;
903 Separator := ', ';
904 end;
905 InsertSQL := InsertSQL + ')';
906 Lines.Add(InsertSQL);
907 InsertSQL := 'Values(';
908 Separator := ':';
909 for I := 0 to FieldNames.Count - 1 do
910 begin
911 if QuotedStrings then
912 InsertSQL := InsertSQL + Separator + '"' + AnsiUpperCase(FieldNames[I]) + '"'
913 else
914 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,AnsiUpperCase(FieldNames[I])) ;
915 Separator := ', :';
916 end;
917 InsertSQL := InsertSQL + ')';
918 Lines.Add(InsertSQL);
919
920 {Is database Firebird 2.1 or later?}
921 if (DatabaseInfo.ODSMajorVersion > 11) or
922 ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1)) then
923 begin
924 InsertSQL := '';
925 Separator := ' RETURNING ';
926 if IdentityCols.Active and (IdentityCols.RecordCount > 0) then
927 begin
928 IdentityCols.First;
929 while not IdentityCols.Eof do
930 begin
931 if (IdentityCols.FieldByName('Selected').AsInteger <> 0) and
932 (not PrimaryKeys.Active or not PrimaryKeys.Locate('columnName;Selected',
933 VarArrayOf([IdentityCols.FieldByName('ColumnName').AsString,0]),[loCaseInsensitive])) then
934 begin
935 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,IdentityCols.FieldByName('ColumnName').AsString);
936 Separator := ', ';
937 end;
938 IdentityCols.Next;
939 end;
940 end;
941 for I := 0 to ReadOnlyFieldNames.Count - 1 do
942 begin
943 if QuotedStrings then
944 InsertSQL := InsertSQL + Separator + '"' + ReadOnlyFieldNames[I] + '"'
945 else
946 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
947 Separator := ', ';
948 end;
949 Lines.Add(InsertSQL);
950 end;
951 SQL.AddStrings(Lines);
952 finally
953 Lines.Free;
954 end;
955 end;
956
957 procedure TIBSQLEditFrame.GenerateModifySQL(TableName: string;
958 QuotedStrings: boolean; FieldNames, ReadOnlyFieldNames, SQL: TStrings);
959 var UpdateSQL: string;
960 Separator: string;
961 I: integer;
962 begin
963 Separator := ' A.';
964 if QuotedStrings then
965 UpdateSQL := 'Update "' + TableName + '" A Set '
966 else
967 UpdateSQL := 'Update ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A Set ';
968 SQL.Add(UpdateSQL);
969 for I := 0 to FieldNames.Count - 1 do
970 begin
971 if QuotedStrings then
972 UpdateSQL := Separator + '"' + FieldNames[I] + '" = :"' + AnsiUpperCase(FieldNames[I]) + '"'
973 else
974 UpdateSQL := Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) + ' = :' +
975 QuoteIdentifierIfNeeded(Database.SQLDialect,AnsiUpperCase(FieldNames[I]));
976 if I < FieldNames.Count - 1 then
977 UpdateSQL := UpdateSQL + ',';
978 SQL.Add(UpdateSQL);
979 end;
980 AddWhereClause(QuotedStrings,SQL,true);
981
982 {Is database Firebird 2.1 or later?}
983 if (DatabaseInfo.ODSMajorVersion > 11) or
984 ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1)) then
985 begin
986 Separator := ' RETURNING A.';
987 UpdateSQL := '';
988 for I := 0 to ReadOnlyFieldNames.Count - 1 do
989 begin
990 if QuotedStrings then
991 UpdateSQL := UpdateSQL + Separator + '"' + ReadOnlyFieldNames[I] + '"'
992 else
993 UpdateSQL := UpdateSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
994 Separator := ', A.';
995 end;
996 SQL.Add(UpdateSQL);
997 end;
998 end;
999
1000 procedure TIBSQLEditFrame.GenerateDeleteSQL(TableName: string;
1001 QuotedStrings: boolean; ReadOnlyFieldNames, SQL: TStrings);
1002 {var ReturningText, Separator: string;
1003 I: integer; }
1004 begin
1005 if QuotedStrings then
1006 SQL.Add('Delete From "' + TableName + '" A')
1007 else
1008 SQL.Add('Delete From ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A');
1009 AddWhereClause(QuotedStrings,SQL,true);
1010 { Separator := ' RETURNING A.';
1011 ReturningText := '';
1012 for I := 0 to ReadOnlyFieldNames.Count - 1 do
1013 begin
1014 if QuotedStrings then
1015 ReturningText := ReturningText + Separator + '"' + ReadOnlyFieldNames[I] + '"'
1016 else
1017 ReturningText := ReturningText + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
1018 Separator := ', A.';
1019 end;
1020 SQL.Add(ReturningText);}
1021 end;
1022
1023 const
1024 sqlCheckProcedureNames = 'Select * From RDB$PROCEDURES Where Upper(Trim(RDB$PROCEDURE_NAME)) = Upper(:ProcName)';
1025
1026 function TIBSQLEditFrame.GetStatementType(var IsStoredProcedure: boolean
1027 ): TIBSQLStatementTypes;
1028 var TableName: string;
1029 begin
1030 Result := sqlUnknown;
1031 if not assigned(Database) or not Database.Connected or (Trim(SQLText.Lines.Text) = '') then
1032 Exit;
1033 IsStoredProcedure := false;
1034 with TIBSQL.Create(nil) do
1035 try
1036 Database := self.Database;
1037 Transaction := SQLTransaction;
1038 SQL.Assign(SQLText.Lines);
1039 GenerateParamNames := true; {permissive}
1040 try
1041 Prepare;
1042 Result := SQLStatementType
1043 except on E:EIBError do
1044 // ShowMessage(E.Message);
1045 end;
1046 if (Result = SQLSelect) and (MetaData.Count > 0) then
1047 begin
1048 TableName := MetaData[0].GetRelationName;
1049 SQL.Text := sqlCheckProcedureNames;
1050 Prepare;
1051 ParamByName('ProcName').AsString := TableName;
1052 ExecQuery;
1053 try
1054 IsStoredProcedure := not EOF;
1055 finally
1056 Close
1057 end;
1058 end;
1059 finally
1060 Free
1061 end;
1062 end;
1063
1064 procedure TIBSQLEditFrame.GenerateExecuteSQL(PackageName,ProcName: string;
1065 QuotedStrings: boolean; ExecuteOnly: boolean; InputParams, OutputParams,
1066 ExecuteSQL: TStrings);
1067
1068 function GetProcName: string;
1069 begin
1070 if QuotedStrings then
1071 begin
1072 if PackageName = '' then
1073 Result := QuoteIdentifier(Database.SQLDialect,ProcName)
1074 else
1075 Result := QuoteIdentifier(Database.SQLDialect,PackageName) + '.' +
1076 QuoteIdentifier(Database.SQLDialect,ProcName);
1077 end
1078 else
1079 if PackageName = '' then
1080 Result := QuoteIdentifierIfNeeded(Database.SQLDialect,ProcName)
1081 else
1082 Result := QuoteIdentifierIfNeeded(Database.SQLDialect,PackageName) + '.' +
1083 QuoteIdentifierIfNeeded(Database.SQLDialect,ProcName);
1084 end;
1085
1086 var SQL: string;
1087 I: integer;
1088 Separator: string;
1089 Lines: TStrings;
1090 begin
1091 Lines := TStringList.Create;
1092 try
1093 Separator := '';
1094 if not ExecuteOnly and (OutputParams.Count > 0) then //Select Query
1095 begin
1096 SQL := 'Select ';
1097 for I := 0 to OutputParams.Count - 1 do
1098 begin
1099 if QuotedStrings then
1100 SQL := SQL + Separator + '"' + OutputParams[I] + '"'
1101 else
1102 SQL := SQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,OutputParams[I]);
1103 Separator := ', ';
1104 end;
1105 SQL := SQL + ' From ' + GetProcName;
1106 if InputParams.Count > 0 then
1107 begin
1108 Separator := '(:';
1109 for I := 0 to InputParams.Count - 1 do
1110 begin
1111 SQL := SQL + Separator + AnsiUpperCase(InputParams[I]);
1112 Separator := ', :';
1113 end;
1114 SQL := SQL + ')'
1115 end
1116 end
1117 else // Execute Procedure
1118 begin
1119 SQL := 'Execute Procedure ' + GetProcName;
1120 if InputParams.Count > 0 then
1121 begin
1122 Separator := ' :';
1123 for I := 0 to InputParams.Count - 1 do
1124 begin
1125 SQL := SQL + Separator + AnsiUpperCase(InputParams[I]);
1126 Separator := ', :';
1127 end;
1128 end
1129 end;
1130 Lines.Add(SQL + ';');
1131 ExecuteSQL.AddStrings(Lines);
1132 finally
1133 Lines.Free
1134 end
1135 end;
1136
1137 procedure TIBSQLEditFrame.InsertSelectedPrimaryKey;
1138 begin
1139 SQLText.SelText := PrimaryKeys.FieldByName('ColumnName').AsString;
1140 SQLText.SetFocus
1141 end;
1142
1143 procedure TIBSQLEditFrame.InsertSelectedFieldName;
1144 begin
1145 SQLText.SelText := FieldNameList.FieldByName('ColumnName').AsString;
1146 SQLText.SetFocus
1147 end;
1148
1149 procedure TIBSQLEditFrame.InsertTableName;
1150 begin
1151 SQLText.SelText := UserTables.FieldByName('RDB$RELATION_NAME').AsString;
1152 SQLText.SetFocus
1153 end;
1154
1155 procedure TIBSQLEditFrame.InsertProcName;
1156 begin
1157 SQLText.SelText := UserProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString;
1158 SQLText.SetFocus
1159 end;
1160
1161 procedure TIBSQLEditFrame.InsertPackageName;
1162 begin
1163 if PackageNames.Active and (PackageNames.FieldByName('PACKAGE_NAME_TYPE').AsInteger = 1) then
1164 begin
1165 SQLText.SelText := PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString;
1166 SQLText.SetFocus
1167 end;
1168 end;
1169
1170 procedure TIBSQLEditFrame.InsertSelectedInputParam;
1171 begin
1172 SQLText.SelText := ProcInputParams.FieldByName('ColumnName').AsString;
1173 SQLText.SetFocus
1174 end;
1175
1176 procedure TIBSQLEditFrame.InsertSelectedOutputParam;
1177 begin
1178 SQLText.SelText := ProcOutputParams.FieldByName('ColumnName').AsString;
1179 SQLText.SetFocus
1180 end;
1181
1182 procedure TIBSQLEditFrame.InsertSelectedIdentityCol;
1183 begin
1184 SQLText.SelText := IdentityCols.FieldByName('ColumnName').AsString;
1185 SQLText.SetFocus
1186 end;
1187
1188 procedure TIBSQLEditFrame.InsertSelectedReadOnlyField;
1189 begin
1190 SQLText.SelText := ReadOnlyFields.FieldByName('ColumnName').AsString;
1191 SQLText.SetFocus
1192 end;
1193
1194 procedure TIBSQLEditFrame.OpenUserProcedures;
1195 begin
1196 if DatabaseInfo.ODSMajorVersion < 12 then
1197 UserProcedures.Active := true
1198 else
1199 PackageNames.Active := true;
1200 end;
1201
1202 procedure GetSymbols(Lines: TStrings; var WordList: TStrings; MaxSymbols: integer = 3);
1203 var Tokeniser: TSynSQLSyn;
1204 i: integer;
1205 Token: string;
1206 begin
1207 Tokeniser := TSynSQLSyn.Create(nil); {use the highligher as a tokeniser}
1208 try
1209 Tokeniser.SQLDialect := sqlInterbase6;
1210 for i := 0 to Lines.Count - 1 do
1211 begin
1212 Tokeniser.SetLine(Lines[i],i);
1213 repeat
1214 if not (Tokeniser.GetTokenID in [tkComment,tkSpace,tkUnknown]) then
1215 begin
1216 Dec(MaxSymbols);
1217 Token := Tokeniser.GetToken;
1218 if (Length(Token) > 1) and (Token[1] = '"') and (Token[Length(Token)] = '"') then
1219 WordList.AddObject(system.copy(Token,2,Length(Token)-2),WordList) {note convention to indicate quoted}
1220 else
1221 WordList.Add(AnsiUpperCase(Token));
1222 // writeln(WordList[WordList.Count-1]);
1223 end;
1224 if MaxSymbols = 0 then
1225 Exit;
1226 Tokeniser.Next;
1227 until Tokeniser.GetEol;
1228 end;
1229 finally
1230 Tokeniser.Free;
1231 end;
1232 end;
1233
1234 function TIBSQLEditFrame.SyncQueryBuilder: TIBSQLStatementTypes;
1235 begin
1236 Result := SyncQueryBuilder(SQLText.Lines);
1237 end;
1238
1239 function TIBSQLEditFrame.SyncQueryBuilder(SQL: TStrings): TIBSQLStatementTypes;
1240 var TableName: string;
1241 FirstWord: string;
1242 Symbols: TStrings;
1243 i: integer;
1244
1245 function FindProcedure(StartIndex: integer): boolean;
1246 begin
1247 if StartIndex >= Symbols.Count then Exit;
1248
1249 if DatabaseInfo.ODSMajorVersion < 12 then {No packages}
1250 begin
1251 UserProcedures.Active := true;
1252 Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex],[]);
1253 end
1254 else
1255 begin
1256 PackageNames.Active := true;
1257 if (StartIndex < Symbols.Count - 2) and (Symbols[StartIndex+1] = '.') and
1258 PackageNames.Locate('RDB$PACKAGE_NAME',Symbols[StartIndex],[]) then
1259 Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex+2],[])
1260 else
1261 Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex],[]);
1262 end;
1263 end;
1264
1265 begin
1266 if (Database = nil) or not Database.Connected or FQuerySync then Exit;
1267
1268 FQuerySync := true;
1269 Result := SQLUnknown;
1270 TableName := '';
1271 Symbols := TStringList.Create;
1272 try
1273 try
1274 IdentifyStatementSQL.Transaction.Active := true;
1275 IdentifyStatementSQL.SQL.Assign(SQL);
1276 IdentifyStatementSQL.Prepare;
1277 Result := IdentifyStatementSQL.SQLStatementType;
1278 case Result of
1279 SQLSelect:
1280 begin
1281 if IdentifyStatementSQL.MetaData.Count > 0 then
1282 TableName := IdentifyStatementSQL.MetaData[0].GetRelationName
1283 else
1284 Exit;
1285 if (Pos('MON$',TableName) > 0) or (Pos('RDB$',TableName) > 0) or (Pos('SEC$',TableName) > 0) then
1286 IncludeSystemTables := true;
1287
1288 if not UserTables.Locate('RDB$RELATION_NAME',TableName,[]) then
1289 begin
1290 {We don't know if the stored procedure is in a package because
1291 the relationname is always the procedure name regardless of
1292 whether it is a non-package procedure or in a package. Hence,
1293 we have to look for the From keyword to find the full procedure name}
1294 GetSymbols(IdentifyStatementSQL.SQL,Symbols,-1); {Get All Symbols}
1295 for i := 0 to Symbols.Count - 1 do
1296 begin
1297 if (Symbols[i] = 'FROM') and (Symbols.Objects[i] = nil) then
1298 begin
1299 if FindProcedure(i+1) then
1300 Result := SQLExecProcedure;
1301 Exit;
1302 end;
1303 end;
1304 {Should have found it - try relationname in hope rather than expectation}
1305 UserProcedures.Active := true;
1306 if UserProcedures.Locate('RDB$PROCEDURE_NAME',TableName,[]) then
1307 Result := SQLExecProcedure;
1308 end;
1309 end;
1310 { If not a select statement then return table or procedure name
1311 as First Table Name }
1312 SQLUpdate:
1313 begin
1314 GetSymbols(IdentifyStatementSQL.SQL,Symbols,2);
1315 UserTables.Locate('RDB$RELATION_NAME',Symbols[1],[]);
1316 end;
1317
1318 SQLInsert:
1319 begin
1320 GetSymbols(IdentifyStatementSQL.SQL,Symbols,3);
1321 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1322 end;
1323
1324 SQLDelete:
1325 begin
1326 GetSymbols(IdentifyStatementSQL.SQL,Symbols,3);
1327 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1328 end;
1329
1330 SQLExecProcedure:
1331 begin
1332 GetSymbols(IdentifyStatementSQL.SQL,Symbols,5);
1333 FirstWord := Symbols[0];
1334 if FirstWord = 'INSERT' then {INSERT...RETURNING}
1335 begin
1336 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1337 Result := SQLInsert;
1338 end
1339 else
1340 if FirstWord = 'UPDATE' then {UPDATE...RETURNING}
1341 begin
1342 UserTables.Locate('RDB$RELATION_NAME',Symbols[1],[]);
1343 Result := SQLUpdate;
1344 end
1345 else
1346 if FirstWord = 'DELETE' then {DELETE...RETURNING}
1347 begin
1348 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1349 Result := SQLDelete;
1350 end
1351 else
1352 FindProcedure(2);
1353 end;
1354 end
1355 except on E:EIBError do
1356 // ShowMessage(E.Message);
1357 end;
1358 finally
1359 Symbols.Free;
1360 FQuerySync := false;
1361 end;
1362 end;
1363
1364 procedure TIBSQLEditFrame.TestSQL(GenerateParamNames: boolean);
1365 begin
1366 if not assigned(Database) or not Database.Connected then
1367 begin
1368 Messagedlg('No Database Connected',mtError,[mbOK],0);
1369 Exit;
1370 end;
1371 with TIBSQL.Create(nil) do
1372 try
1373 Database := self.Database;
1374 Transaction := SQLTransaction;
1375 GenerateParamNames := GenerateParamNames;
1376 SQL.Assign(SQLText.Lines);
1377 try
1378 Prepare;
1379 ShowMessage('SQL '+ GetSQLType(SQLStatementType) + ' Statement Looks OK');
1380 except on E:EIBError do
1381 ShowMessage(E.Message);
1382 end;
1383 finally
1384 Free
1385 end;
1386 end;
1387
1388
1389 end.
1390