ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSQLEditFrame.pas
Revision: 158
Committed: Thu Mar 1 11:23:33 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 42964 byte(s)
Log Message:
Repository resync

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, IBLookupComboEditBox,
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 i, index: integer;
706 begin
707 SQL.Clear;
708 FieldNames := TStringList.Create;
709 ReadOnlyFieldNames := TStringList.Create;
710 UpdateFields := TStringList.Create;
711 try
712 if aIncludePrimaryKeys then
713 GetFieldNames(PrimaryKeys,UpdateFields);
714 GetFieldNames(FieldNameList,FieldNames,false);
715 UpdateFields.AddStrings(FieldNames);
716 GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
717 GenerateModifySQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,
718 QuotedStrings,UpdateFields,ReadOnlyFieldNames,SQL);
719 finally
720 FieldNames.Free;
721 ReadOnlyFieldNames.Free;
722 UpdateFields.Free;
723 end;
724 end;
725
726 procedure TIBSQLEditFrame.GenerateDeleteSQL(QuotedStrings: boolean;
727 SQL: TStrings);
728 var ReadOnlyFieldNames: TStrings;
729 begin
730 SQL.Clear;
731 ReadOnlyFieldNames := TStringList.Create;
732 try
733 GetFieldNames(ReadOnlyFields,ReadOnlyFieldNames,true);
734 GenerateDeleteSQL(UserTables.FieldByName('RDB$RELATION_NAME').AsString,QuotedStrings,ReadOnlyFieldNames,SQL)
735 finally
736 ReadOnlyFieldNames.Free;
737 end;
738 end;
739
740 procedure TIBSQLEditFrame.CutExecute(Sender: TObject);
741 begin
742 SQLText.CutToClipboard;
743 end;
744
745 procedure TIBSQLEditFrame.CopyTextExecute(Sender: TObject);
746 begin
747 SQLText.CopyToClipboard;
748 end;
749
750 procedure TIBSQLEditFrame.ClearExecute(Sender: TObject);
751 begin
752 SQLText.Lines.Clear;
753 end;
754
755 procedure TIBSQLEditFrame.AddWhereClause(
756 QuotedStrings: boolean; SQL: TStrings; UseOldValues: boolean);
757 var WhereClause: string;
758 Separator: string;
759 Count: integer;
760 Prefix: string;
761 ColumnName: string;
762 begin
763 Count := 0;
764 WhereClause := 'Where';
765 Separator := ' A.';
766 if UseOldValues then
767 Prefix := ':OLD_'
768 else
769 Prefix := ':';
770 with PrimaryKeys do
771 begin
772 DisableControls;
773 try
774 if State = dsEdit then Post;
775 First;
776 while not EOF do
777 begin
778 if FieldByName('Selected').AsInteger <> 0 then
779 begin
780 Inc(Count);
781 ColumnName := FieldByName('ColumnName').AsString;
782 if QuotedStrings then
783 WhereClause := WhereClause + Separator + '"' + ColumnName +
784 '" = ' + Prefix+ AnsiUpperCase(ColumnName)
785 else
786 WhereClause := WhereClause + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ColumnName) +
787 ' = ' + Prefix + AnsiUpperCase(ColumnName);
788 Separator := ' AND A.';
789 end;
790 Next;
791 end;
792 finally
793 EnableControls
794 end;
795 end;
796 if Count > 0 then
797 SQL.Add(WhereClause);
798 end;
799
800 function TIBSQLEditFrame.GetSQLType(SQLType: TIBSQLStatementTypes): string;
801 begin
802 case SQLType of
803 SQLUnknown: Result := 'Unknown';
804 SQLSelect: Result := 'Select';
805 SQLInsert: Result := 'Insert';
806 SQLUpdate: Result := 'Update';
807 SQLDelete: Result := 'Delete';
808 SQLDDL: Result := 'DDL';
809 SQLGetSegment: Result := 'GetSegment';
810 SQLPutSegment: Result := 'PutSegment';
811 SQLExecProcedure: Result := 'Execute Procedure';
812 SQLStartTransaction: Result := 'StartTransaction';
813 SQLCommit: Result := 'Commit';
814 SQLRollback: Result := 'Rollback';
815 SQLSelectForUpdate: Result := 'Select for Update';
816 SQLSetGenerator: Result := 'Set Generator';
817 end;
818 end;
819
820 procedure TIBSQLEditFrame.GetFieldNames(Dataset: TDataset;
821 var FieldNames: TStrings; aIncludeReadOnly: boolean);
822 begin
823 with DataSet do
824 begin
825 DisableControls;
826 try
827 if State = dsEdit then Post;
828 First;
829 while not EOF do
830 begin
831 if (FieldByName('Selected').AsInteger <> 0) and (aIncludeReadOnly or (FieldByName('ReadOnly').AsInteger = 0)) then
832 FieldNames.Add(FieldByName('ColumnName').AsString);
833 Next;
834 end;
835 finally
836 EnableControls
837 end;
838 end;
839 end;
840
841 procedure TIBSQLEditFrame.GenerateSelectSQL(TableName: string;
842 QuotedStrings: boolean; FieldNames, PrimaryKeyNames, SQL: TStrings);
843 var SelectSQL: string;
844 Separator : string;
845 I: integer;
846 Lines: TStrings;
847 begin
848 SelectSQL := 'Select';
849 Separator := ' A.';
850 for I := 0 to PrimaryKeyNames.Count - 1 do
851 begin
852 if QuotedStrings then
853 SelectSQL := SelectSQL + Separator + '"' + PrimaryKeyNames[I] + '"'
854 else
855 SelectSQL := SelectSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,PrimaryKeyNames[I]);
856 Separator := ', A.';
857 end;
858 for I := 0 to FieldNames.Count - 1 do
859 begin
860 if QuotedStrings then
861 SelectSQL := SelectSQL + Separator + '"' + FieldNames[I] + '"'
862 else
863 SelectSQL := SelectSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]);
864 Separator := ', A.';
865 end;
866 if QuotedStrings then
867 SelectSQL := SelectSQL + ' From "' + TableName + '" A'
868 else
869 SelectSQL := SelectSQL + ' From ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A';
870 Lines := TStringList.Create;
871 try
872 Lines.Text := SelectSQL;
873 SQL.AddStrings(Lines);
874 finally
875 Lines.Free;
876 end;
877 end;
878
879 procedure TIBSQLEditFrame.GenerateInsertSQL(TableName: string;
880 QuotedStrings: boolean; FieldNames, ReadOnlyFieldNames, SQL: TStrings);
881 var InsertSQL: string;
882 Separator: string;
883 Lines: TStrings;
884 I: integer;
885 begin
886 Lines := TStringList.Create;
887 try
888 if QuotedStrings then
889 InsertSQL := 'Insert Into "' + TableName + '" ('
890 else
891 InsertSQL := 'Insert Into ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' (';
892 Separator := '';
893 for I := 0 to FieldNames.Count - 1 do
894 begin
895 if QuotedStrings then
896 InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
897 else
898 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) ;
899 Separator := ', ';
900 end;
901 InsertSQL := InsertSQL + ')';
902 Lines.Add(InsertSQL);
903 InsertSQL := 'Values(';
904 Separator := ':';
905 for I := 0 to FieldNames.Count - 1 do
906 begin
907 InsertSQL := InsertSQL + Separator + AnsiUpperCase(FieldNames[I]) ;
908 Separator := ', :';
909 end;
910 InsertSQL := InsertSQL + ')';
911 Lines.Add(InsertSQL);
912
913 {Is database Firebird 2.1 or later?}
914 if (DatabaseInfo.ODSMajorVersion > 11) or
915 ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1)) then
916 begin
917 InsertSQL := '';
918 Separator := ' RETURNING ';
919 if IdentityCols.Active and (IdentityCols.RecordCount > 0) then
920 begin
921 IdentityCols.First;
922 while not IdentityCols.Eof do
923 begin
924 if (IdentityCols.FieldByName('Selected').AsInteger <> 0) and
925 (not PrimaryKeys.Active or not PrimaryKeys.Locate('columnName;Selected',
926 VarArrayOf([IdentityCols.FieldByName('ColumnName').AsString,0]),[loCaseInsensitive])) then
927 begin
928 InsertSQL := InsertSQL + Separator + IdentityCols.FieldByName('ColumnName').AsString;
929 Separator := ', ';
930 end;
931 IdentityCols.Next;
932 end;
933 end;
934 for I := 0 to ReadOnlyFieldNames.Count - 1 do
935 begin
936 if QuotedStrings then
937 InsertSQL := InsertSQL + Separator + '"' + ReadOnlyFieldNames[I] + '"'
938 else
939 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
940 Separator := ', ';
941 end;
942 Lines.Add(InsertSQL);
943 end;
944 SQL.AddStrings(Lines);
945 finally
946 Lines.Free;
947 end;
948 end;
949
950 procedure TIBSQLEditFrame.GenerateModifySQL(TableName: string;
951 QuotedStrings: boolean; FieldNames, ReadOnlyFieldNames, SQL: TStrings);
952 var UpdateSQL: string;
953 Separator: string;
954 I: integer;
955 begin
956 Separator := ' A.';
957 if QuotedStrings then
958 UpdateSQL := 'Update "' + TableName + '" A Set '
959 else
960 UpdateSQL := 'Update ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A Set ';
961 SQL.Add(UpdateSQL);
962 for I := 0 to FieldNames.Count - 1 do
963 begin
964 if QuotedStrings then
965 UpdateSQL := Separator + '"' + FieldNames[I] + '" = :' + AnsiUpperCase(FieldNames[I])
966 else
967 UpdateSQL := Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) + ' = :' + AnsiUpperCase(FieldNames[I]);
968 if I < FieldNames.Count - 1 then
969 UpdateSQL := UpdateSQL + ',';
970 SQL.Add(UpdateSQL);
971 end;
972 AddWhereClause(QuotedStrings,SQL,true);
973
974 {Is database Firebird 2.1 or later?}
975 if (DatabaseInfo.ODSMajorVersion > 11) or
976 ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1)) then
977 begin
978 Separator := ' RETURNING A.';
979 UpdateSQL := '';
980 for I := 0 to ReadOnlyFieldNames.Count - 1 do
981 begin
982 if QuotedStrings then
983 UpdateSQL := UpdateSQL + Separator + '"' + ReadOnlyFieldNames[I] + '"'
984 else
985 UpdateSQL := UpdateSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
986 Separator := ', A.';
987 end;
988 SQL.Add(UpdateSQL);
989 end;
990 end;
991
992 procedure TIBSQLEditFrame.GenerateDeleteSQL(TableName: string;
993 QuotedStrings: boolean; ReadOnlyFieldNames, SQL: TStrings);
994 {var ReturningText, Separator: string;
995 I: integer; }
996 begin
997 if QuotedStrings then
998 SQL.Add('Delete From "' + TableName + '" A')
999 else
1000 SQL.Add('Delete From ' + QuoteIdentifierIfNeeded(Database.SQLDialect,TableName) + ' A');
1001 AddWhereClause(QuotedStrings,SQL,true);
1002 { Separator := ' RETURNING A.';
1003 ReturningText := '';
1004 for I := 0 to ReadOnlyFieldNames.Count - 1 do
1005 begin
1006 if QuotedStrings then
1007 ReturningText := ReturningText + Separator + '"' + ReadOnlyFieldNames[I] + '"'
1008 else
1009 ReturningText := ReturningText + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,ReadOnlyFieldNames[I]);
1010 Separator := ', A.';
1011 end;
1012 SQL.Add(ReturningText);}
1013 end;
1014
1015 const
1016 sqlCheckProcedureNames = 'Select * From RDB$PROCEDURES Where Upper(Trim(RDB$PROCEDURE_NAME)) = Upper(:ProcName)';
1017
1018 function TIBSQLEditFrame.GetStatementType(var IsStoredProcedure: boolean
1019 ): TIBSQLStatementTypes;
1020 var TableName: string;
1021 begin
1022 Result := sqlUnknown;
1023 if not assigned(Database) or not Database.Connected or (Trim(SQLText.Lines.Text) = '') then
1024 Exit;
1025 IsStoredProcedure := false;
1026 with TIBSQL.Create(nil) do
1027 try
1028 Database := self.Database;
1029 Transaction := SQLTransaction;
1030 SQL.Assign(SQLText.Lines);
1031 GenerateParamNames := true; {permissive}
1032 try
1033 Prepare;
1034 Result := SQLStatementType
1035 except on E:EIBError do
1036 // ShowMessage(E.Message);
1037 end;
1038 if (Result = SQLSelect) and (MetaData.Count > 0) then
1039 begin
1040 TableName := MetaData[0].GetRelationName;
1041 SQL.Text := sqlCheckProcedureNames;
1042 Prepare;
1043 ParamByName('ProcName').AsString := TableName;
1044 ExecQuery;
1045 try
1046 IsStoredProcedure := not EOF;
1047 finally
1048 Close
1049 end;
1050 end;
1051 finally
1052 Free
1053 end;
1054 end;
1055
1056 procedure TIBSQLEditFrame.GenerateExecuteSQL(PackageName,ProcName: string;
1057 QuotedStrings: boolean; ExecuteOnly: boolean; InputParams, OutputParams,
1058 ExecuteSQL: TStrings);
1059
1060 function GetProcName: string;
1061 begin
1062 if QuotedStrings then
1063 begin
1064 if PackageName = '' then
1065 Result := QuoteIdentifier(Database.SQLDialect,ProcName)
1066 else
1067 Result := QuoteIdentifier(Database.SQLDialect,PackageName) + '.' +
1068 QuoteIdentifier(Database.SQLDialect,ProcName);
1069 end
1070 else
1071 if PackageName = '' then
1072 Result := QuoteIdentifierIfNeeded(Database.SQLDialect,ProcName)
1073 else
1074 Result := QuoteIdentifierIfNeeded(Database.SQLDialect,PackageName) + '.' +
1075 QuoteIdentifierIfNeeded(Database.SQLDialect,ProcName);
1076 end;
1077
1078 var SQL: string;
1079 I: integer;
1080 Separator: string;
1081 Lines: TStrings;
1082 begin
1083 Lines := TStringList.Create;
1084 try
1085 Separator := '';
1086 if not ExecuteOnly and (OutputParams.Count > 0) then //Select Query
1087 begin
1088 SQL := 'Select ';
1089 for I := 0 to OutputParams.Count - 1 do
1090 begin
1091 if QuotedStrings then
1092 SQL := SQL + Separator + '"' + OutputParams[I] + '"'
1093 else
1094 SQL := SQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,OutputParams[I]);
1095 Separator := ', ';
1096 end;
1097 SQL := SQL + ' From ' + GetProcName;
1098 if InputParams.Count > 0 then
1099 begin
1100 Separator := '(:';
1101 for I := 0 to InputParams.Count - 1 do
1102 begin
1103 SQL := SQL + Separator + AnsiUpperCase(InputParams[I]);
1104 Separator := ', :';
1105 end;
1106 SQL := SQL + ')'
1107 end
1108 end
1109 else // Execute Procedure
1110 begin
1111 SQL := 'Execute Procedure ' + GetProcName;
1112 if InputParams.Count > 0 then
1113 begin
1114 Separator := ' :';
1115 for I := 0 to InputParams.Count - 1 do
1116 begin
1117 SQL := SQL + Separator + AnsiUpperCase(InputParams[I]);
1118 Separator := ', :';
1119 end;
1120 end
1121 end;
1122 Lines.Add(SQL + ';');
1123 ExecuteSQL.AddStrings(Lines);
1124 finally
1125 Lines.Free
1126 end
1127 end;
1128
1129 procedure TIBSQLEditFrame.InsertSelectedPrimaryKey;
1130 begin
1131 SQLText.SelText := PrimaryKeys.FieldByName('ColumnName').AsString;
1132 SQLText.SetFocus
1133 end;
1134
1135 procedure TIBSQLEditFrame.InsertSelectedFieldName;
1136 begin
1137 SQLText.SelText := FieldNameList.FieldByName('ColumnName').AsString;
1138 SQLText.SetFocus
1139 end;
1140
1141 procedure TIBSQLEditFrame.InsertTableName;
1142 begin
1143 SQLText.SelText := UserTables.FieldByName('RDB$RELATION_NAME').AsString;
1144 SQLText.SetFocus
1145 end;
1146
1147 procedure TIBSQLEditFrame.InsertProcName;
1148 begin
1149 SQLText.SelText := UserProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString;
1150 SQLText.SetFocus
1151 end;
1152
1153 procedure TIBSQLEditFrame.InsertPackageName;
1154 begin
1155 if PackageNames.Active and (PackageNames.FieldByName('PACKAGE_NAME_TYPE').AsInteger = 1) then
1156 begin
1157 SQLText.SelText := PackageNames.FieldByName('RDB$PACKAGE_NAME').AsString;
1158 SQLText.SetFocus
1159 end;
1160 end;
1161
1162 procedure TIBSQLEditFrame.InsertSelectedInputParam;
1163 begin
1164 SQLText.SelText := ProcInputParams.FieldByName('ColumnName').AsString;
1165 SQLText.SetFocus
1166 end;
1167
1168 procedure TIBSQLEditFrame.InsertSelectedOutputParam;
1169 begin
1170 SQLText.SelText := ProcOutputParams.FieldByName('ColumnName').AsString;
1171 SQLText.SetFocus
1172 end;
1173
1174 procedure TIBSQLEditFrame.InsertSelectedIdentityCol;
1175 begin
1176 SQLText.SelText := IdentityCols.FieldByName('ColumnName').AsString;
1177 SQLText.SetFocus
1178 end;
1179
1180 procedure TIBSQLEditFrame.InsertSelectedReadOnlyField;
1181 begin
1182 SQLText.SelText := ReadOnlyFields.FieldByName('ColumnName').AsString;
1183 SQLText.SetFocus
1184 end;
1185
1186 procedure TIBSQLEditFrame.OpenUserProcedures;
1187 begin
1188 if DatabaseInfo.ODSMajorVersion < 12 then
1189 UserProcedures.Active := true
1190 else
1191 PackageNames.Active := true;
1192 end;
1193
1194 procedure GetSymbols(Lines: TStrings; var WordList: TStrings; MaxSymbols: integer = 3);
1195 var Tokeniser: TSynSQLSyn;
1196 i: integer;
1197 Token: string;
1198 begin
1199 Tokeniser := TSynSQLSyn.Create(nil); {use the highligher as a tokeniser}
1200 try
1201 Tokeniser.SQLDialect := sqlInterbase6;
1202 for i := 0 to Lines.Count - 1 do
1203 begin
1204 Tokeniser.SetLine(Lines[i],i);
1205 repeat
1206 if not (Tokeniser.GetTokenID in [tkComment,tkSpace,tkUnknown]) then
1207 begin
1208 Dec(MaxSymbols);
1209 Token := Tokeniser.GetToken;
1210 if (Length(Token) > 1) and (Token[1] = '"') and (Token[Length(Token)] = '"') then
1211 WordList.AddObject(system.copy(Token,2,Length(Token)-2),WordList) {note convention to indicate quoted}
1212 else
1213 WordList.Add(AnsiUpperCase(Token));
1214 // writeln(WordList[WordList.Count-1]);
1215 end;
1216 if MaxSymbols = 0 then
1217 Exit;
1218 Tokeniser.Next;
1219 until Tokeniser.GetEol;
1220 end;
1221 finally
1222 Tokeniser.Free;
1223 end;
1224 end;
1225
1226 function TIBSQLEditFrame.SyncQueryBuilder: TIBSQLStatementTypes;
1227 begin
1228 Result := SyncQueryBuilder(SQLText.Lines);
1229 end;
1230
1231 function TIBSQLEditFrame.SyncQueryBuilder(SQL: TStrings): TIBSQLStatementTypes;
1232 var TableName: string;
1233 FirstWord: string;
1234 Symbols: TStrings;
1235 i: integer;
1236
1237 function FindProcedure(StartIndex: integer): boolean;
1238 begin
1239 if StartIndex >= Symbols.Count then Exit;
1240
1241 if DatabaseInfo.ODSMajorVersion < 12 then {No packages}
1242 begin
1243 UserProcedures.Active := true;
1244 Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex],[]);
1245 end
1246 else
1247 begin
1248 PackageNames.Active := true;
1249 if (StartIndex < Symbols.Count - 2) and (Symbols[StartIndex+1] = '.') and
1250 PackageNames.Locate('RDB$PACKAGE_NAME',Symbols[StartIndex],[]) then
1251 Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex+2],[])
1252 else
1253 Result := UserProcedures.Locate('RDB$PROCEDURE_NAME',Symbols[StartIndex],[]);
1254 end;
1255 end;
1256
1257 begin
1258 if (Database = nil) or not Database.Connected or FQuerySync then Exit;
1259
1260 FQuerySync := true;
1261 Result := SQLUnknown;
1262 TableName := '';
1263 Symbols := TStringList.Create;
1264 try
1265 try
1266 IdentifyStatementSQL.Transaction.Active := true;
1267 IdentifyStatementSQL.SQL.Assign(SQL);
1268 IdentifyStatementSQL.Prepare;
1269 Result := IdentifyStatementSQL.SQLStatementType;
1270 case Result of
1271 SQLSelect:
1272 begin
1273 if IdentifyStatementSQL.MetaData.Count > 0 then
1274 TableName := IdentifyStatementSQL.MetaData[0].GetRelationName
1275 else
1276 Exit;
1277 if (Pos('MON$',TableName) > 0) or (Pos('RDB$',TableName) > 0) or (Pos('SEC$',TableName) > 0) then
1278 IncludeSystemTables := true;
1279
1280 if not UserTables.Locate('RDB$RELATION_NAME',TableName,[]) then
1281 begin
1282 {We don't know if the stored procedure is in a package because
1283 the relationname is always the procedure name regardless of
1284 whether it is a non-package procedure or in a package. Hence,
1285 we have to look for the From keyword to find the full procedure name}
1286 GetSymbols(IdentifyStatementSQL.SQL,Symbols,-1); {Get All Symbols}
1287 for i := 0 to Symbols.Count - 1 do
1288 begin
1289 if (Symbols[i] = 'FROM') and (Symbols.Objects[i] = nil) then
1290 begin
1291 if FindProcedure(i+1) then
1292 Result := SQLExecProcedure;
1293 Exit;
1294 end;
1295 end;
1296 {Should have found it - try relationname in hope rather than expectation}
1297 UserProcedures.Active := true;
1298 if UserProcedures.Locate('RDB$PROCEDURE_NAME',TableName,[]) then
1299 Result := SQLExecProcedure;
1300 end;
1301 end;
1302 { If not a select statement then return table or procedure name
1303 as First Table Name }
1304 SQLUpdate:
1305 begin
1306 GetSymbols(IdentifyStatementSQL.SQL,Symbols,2);
1307 UserTables.Locate('RDB$RELATION_NAME',Symbols[1],[]);
1308 end;
1309
1310 SQLInsert:
1311 begin
1312 GetSymbols(IdentifyStatementSQL.SQL,Symbols,3);
1313 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1314 end;
1315
1316 SQLDelete:
1317 begin
1318 GetSymbols(IdentifyStatementSQL.SQL,Symbols,3);
1319 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1320 end;
1321
1322 SQLExecProcedure:
1323 begin
1324 GetSymbols(IdentifyStatementSQL.SQL,Symbols,5);
1325 FirstWord := Symbols[0];
1326 if FirstWord = 'INSERT' then {INSERT...RETURNING}
1327 begin
1328 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1329 Result := SQLInsert;
1330 end
1331 else
1332 if FirstWord = 'UPDATE' then {UPDATE...RETURNING}
1333 begin
1334 UserTables.Locate('RDB$RELATION_NAME',Symbols[1],[]);
1335 Result := SQLUpdate;
1336 end
1337 else
1338 if FirstWord = 'DELETE' then {DELETE...RETURNING}
1339 begin
1340 UserTables.Locate('RDB$RELATION_NAME',Symbols[2],[]);
1341 Result := SQLDelete;
1342 end
1343 else
1344 FindProcedure(2);
1345 end;
1346 end
1347 except on E:EIBError do
1348 // ShowMessage(E.Message);
1349 end;
1350 finally
1351 Symbols.Free;
1352 FQuerySync := false;
1353 end;
1354 end;
1355
1356 procedure TIBSQLEditFrame.TestSQL(GenerateParamNames: boolean);
1357 begin
1358 if not assigned(Database) or not Database.Connected then
1359 begin
1360 Messagedlg('No Database Connected',mtError,[mbOK],0);
1361 Exit;
1362 end;
1363 with TIBSQL.Create(nil) do
1364 try
1365 Database := self.Database;
1366 Transaction := SQLTransaction;
1367 GenerateParamNames := GenerateParamNames;
1368 SQL.Assign(SQLText.Lines);
1369 try
1370 Prepare;
1371 ShowMessage('SQL '+ GetSQLType(SQLStatementType) + ' Statement Looks OK');
1372 except on E:EIBError do
1373 ShowMessage(E.Message);
1374 end;
1375 finally
1376 Free
1377 end;
1378 end;
1379
1380
1381 end.
1382