ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBSQLEditFrame.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 43462 byte(s)
Log Message: 
Updated for IBX 4 release

File Contents

# User Rev Content
1 tony 158 (*
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 tony 209 IBSQL, IBDatabase, IBUpdate, IBDatabaseInfo,
36 tony 315 IBCustomDataSet, db, LazSynTextArea, IB;
37 tony 158
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 tony 291 Uses IBUtils, IBMessages, Variants;
210 tony 158
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 tony 315 if Components[i] is TIBCustomDataSet then
385     TIBCustomDataSet(Components[i]).Database := FDatabase
386 tony 158 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 tony 263 ColParamName: string;
761 tony 158 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 tony 263 if UseOldValues then
778     ColParamName := 'OLD_' + AnsiUpperCase(ColumnName)
779     else
780     ColParamName := AnsiUpperCase(ColumnName);
781    
782 tony 158 if QuotedStrings then
783 tony 263 WhereClause := WhereClause +
784     Separator +
785     '"' + ColumnName + '" = :"' + ColParamName + '"'
786 tony 158 else
787 tony 263 WhereClause := WhereClause +
788     Separator +
789     QuoteIdentifierIfNeeded(Database.SQLDialect,ColumnName) +
790     ' = :' +
791     QuoteIdentifierIfNeeded(Database.SQLDialect,ColParamName);
792 tony 158 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 tony 263 if QuotedStrings then
912     InsertSQL := InsertSQL + Separator + '"' + AnsiUpperCase(FieldNames[I]) + '"'
913     else
914     InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,AnsiUpperCase(FieldNames[I])) ;
915 tony 158 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 tony 209 InsertSQL := InsertSQL + Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,IdentityCols.FieldByName('ColumnName').AsString);
936 tony 158 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 tony 263 UpdateSQL := Separator + '"' + FieldNames[I] + '" = :"' + AnsiUpperCase(FieldNames[I]) + '"'
973 tony 158 else
974 tony 263 UpdateSQL := Separator + QuoteIdentifierIfNeeded(Database.SQLDialect,FieldNames[I]) + ' = :' +
975     QuoteIdentifierIfNeeded(Database.SQLDialect,AnsiUpperCase(FieldNames[I]));
976 tony 158 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