ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBTable.pas
Revision: 308
Committed: Sat Jul 18 10:26:30 2020 UTC (3 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 48153 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 209 {************************************************************************}
2     { }
3     { Borland Delphi Visual Component Library }
4     { InterBase Express core components }
5     { }
6     { Copyright (c) 1998-2000 Inprise Corporation }
7     { }
8     { InterBase Express is based in part on the product }
9     { Free IB Components, written by Gregory H. Deatz for }
10     { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11     { Free IB Components is used under license. }
12     { }
13     { The contents of this file are subject to the InterBase }
14     { Public License Version 1.0 (the "License"); you may not }
15     { use this file except in compliance with the License. You }
16     { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17     { Software distributed under the License is distributed on }
18     { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19     { express or implied. See the License for the specific language }
20     { governing rights and limitations under the License. }
21     { The Original Code was created by InterBase Software Corporation }
22     { and its successors. }
23     { Portions created by Inprise Corporation are Copyright (C) Inprise }
24     { Corporation. All Rights Reserved. }
25     { Contributor(s): Jeff Overcash }
26     { }
27     { IBX For Lazarus (Firebird Express) }
28     { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29     { Portions created by MWA Software are copyright McCallum Whyman }
30     { Associates Ltd 2011 - 2018 }
31     { }
32     {************************************************************************}
33    
34     unit IBTable;
35    
36     {$Mode Delphi}
37    
38     {$codepage UTF8}
39    
40     interface
41    
42     uses SysUtils, Classes, DB, IB, IBCustomDataSet,
43     IBSQL, IBUtils;
44    
45     type
46    
47     { TIBTable }
48    
49     TIBTableType = (ttSystem, ttView);
50     TIBTableTypes = set of TIBTableType;
51     TIndexName = String;
52    
53     TIBTable = class;
54    
55     TIBTable = class(TIBCustomDataSet)
56     private
57     FSystemTable: Boolean;
58     FMultiTableView: Boolean;
59     FMasterLink: TMasterDataLink;
60     FMasterFieldsList: TStringList;
61     FDetailFieldsList: TStringList;
62     FIndexDefs: TIndexDefs;
63     FDefaultIndex: Boolean;
64     FReadOnly: Boolean;
65     FFieldsIndex: Boolean;
66     FTableName: String;
67     FIndexName: TIndexName;
68     FRegenerateSQL: Boolean;
69     FNameList: TStrings;
70     FSwitchingIndex: Boolean;
71     FPrimaryIndexFields: string;
72     FTableTypes: TIBTableTypes;
73     FStoreDefs: boolean;
74     WhereAllRefreshSQL: TStrings;
75     WhereDBKeyRefreshSQL: TStrings;
76     WherePrimaryRefreshSQL: TStrings;
77    
78     function GetIndexFieldCount: Integer;
79     function GetIndexField(Index: Integer): TField;
80     procedure MasterChanged(Sender: TObject);
81     procedure MasterDisabled(Sender: TObject);
82     procedure SetDataSource(Value: TDataSource);
83     procedure SetIndexField(Index: Integer; Value: TField);
84     procedure SetIndexFieldNames(const Value: string);
85     procedure GenerateSQL;
86     procedure GenerateUpdateSQL;
87     procedure SwitchToIndex();
88     procedure InternalTableRefresh();
89     function GetTableNames: TStrings;
90     procedure GetTableNamesFromServer;
91     procedure SetTableTypes(
92     const Value: TIBTableTypes);
93     function InternalGotoDBKey(DBKey: TIBDBKey): Boolean;
94     function FormatFieldsList(Value: string): string;
95     function GetCurrentDBKey: TIBDBKey;
96     function InternalGetUpdatable: Boolean;
97     function GetExists: Boolean;
98     procedure SetIndexDefs(Value: TIndexDefs);
99     procedure ExtractLinkFields;
100     function IndexDefsStored: Boolean;
101     function GetMasterFields: string;
102     procedure SetMasterFields(const Value: string);
103     function GetIndexFieldNames: string;
104     function GetIndexName: string;
105     procedure SetIndexName(const Value: string);
106     procedure SetParams;
107     procedure SetReadOnly(Value: Boolean);
108     procedure SetTableName(Value: String);
109     procedure SetIndex(const Value: string; FieldsIndex: Boolean);
110     procedure ResetSQLStatements;
111     procedure Reopen;
112    
113     protected
114    
115     procedure DoOnNewRecord; override;
116     procedure GetIndexParams(const IndexName: string; FieldsIndex: Boolean;
117     var IndexedName: string);
118     function GetCanModify: Boolean; override;
119     procedure UpdateIndexDefs; override;
120     procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
121     procedure DefChanged(Sender: TObject); virtual;
122     function GetDataSource: TDataSource; override;
123     procedure InitFieldDefs; override;
124     procedure InternalClose; override;
125     procedure InternalOpen; override;
126     procedure InternalRefresh; override;
127     procedure SetFiltered(Value: Boolean); override;
128     procedure SetFilterText(const Value: string); override;
129     procedure SetFilterOptions(Value: TFilterOptions); override;
130     procedure InternalRefreshRow; override;
131     function GetMasterDetailDelay: integer; override;
132     procedure SetMasterDetailDelay(AValue: integer); override;
133    
134     public
135     constructor Create(AOwner: TComponent); override;
136     destructor Destroy; override;
137     procedure AddIndex(const Name, Fields: string; Options: TIndexOptions;
138     const DescFields: string = '');
139     procedure CreateTable;
140     procedure DeleteIndex(const Name: string);
141     procedure DeleteTable;
142     procedure EmptyTable;
143     procedure GetDetailLinkFields(MasterFields, DetailFields: TList); virtual;
144     procedure GetIndexNames(List: TStrings);
145     procedure GotoCurrent(Table: TIBTable);
146     property CurrentDBKey: TIBDBKey read GetCurrentDBKey;
147     property Exists: Boolean read GetExists;
148     property IndexFieldCount: Integer read GetIndexFieldCount;
149     property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
150     property SelectStmtHandle;
151     property TableNames: TStrings read GetTableNames;
152    
153     published
154     property AutoCommit;
155     property Active;
156     property BufferChunks;
157     property CachedUpdates;
158     property DataSetCloseAction;
159     // property Constraints stored ConstraintsStored;
160     property DefaultIndex: Boolean read FDefaultIndex write FDefaultIndex default True;
161     property EnableStatistics;
162     property Filter;
163     property Filtered;
164 tony 308 property SQLFiltered;
165     property SQLFilterParams;
166 tony 209 property GeneratorField;
167     property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs stored IndexDefsStored;
168     property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
169     property IndexName: string read GetIndexName write SetIndexName;
170     property MasterFields: string read GetMasterFields write SetMasterFields;
171     property MasterSource: TDataSource read GetDataSource write SetDataSource;
172     property MasterDetailDelay;
173     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
174     property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
175     property TableName: String read FTableName write SetTableName;
176     property TableTypes: TIBTableTypes read FTableTypes write SetTableTypes default [];
177     property UpdateObject;
178     property UniDirectional;
179    
180     property BeforeDatabaseDisconnect;
181     property AfterDatabaseDisconnect;
182     property DatabaseFree;
183     property BeforeTransactionEnd;
184     property AfterTransactionEnd;
185     property TransactionFree;
186     property OnFilterRecord;
187     end;
188    
189     implementation
190    
191 tony 291 uses IBMessages, IBTypes;
192 tony 209
193     type
194    
195     { TIBMasterDataLink }
196    
197     TIBMasterDataLink = class(TMasterDataLink)
198     private
199     FDelayTimerValue: integer;
200 tony 263 FTimer: TIBTimerInf;
201 tony 209 procedure HandleRefreshTimer(Sender: TObject);
202 tony 217 procedure SetDelayTimerValue(AValue: integer);
203 tony 209 protected
204     procedure DoMasterChange; override;
205     public
206     constructor Create(ADataSet: TDataSet); override;
207     property DelayTimerValue: integer {in Milliseconds}
208 tony 217 read FDelayTimerValue write SetDelayTimerValue;
209 tony 209 end;
210    
211     { TIBMasterDataLink }
212    
213     procedure TIBMasterDataLink.HandleRefreshTimer(Sender: TObject);
214     begin
215 tony 217 FTimer.Enabled := false;
216     if GetDetailDataSet.Active then
217     inherited DoMasterChange;
218 tony 209 end;
219    
220 tony 217 procedure TIBMasterDataLink.SetDelayTimerValue(AValue: integer);
221     begin
222     if FDelayTimerValue = AValue then Exit;
223 tony 263 if assigned(FTimer) then
224     FTimer.Enabled := false;
225 tony 217 FDelayTimerValue := AValue;
226     end;
227    
228 tony 209 procedure TIBMasterDataLink.DoMasterChange;
229     begin
230 tony 263 if assigned(FTimer) and (FDelayTimerValue > 0) then
231 tony 217 with FTimer do
232 tony 209 begin
233 tony 263 FTimer.Enabled := false;
234     FTimer.Interval := FDelayTimerValue;
235     FTimer.Enabled := true;
236 tony 217 end
237 tony 220 else
238     inherited DoMasterChange
239 tony 209 end;
240    
241     constructor TIBMasterDataLink.Create(ADataSet: TDataSet);
242     begin
243     inherited Create(ADataSet);
244 tony 263 if assigned(IBGUIInterface) then
245     begin
246     FTimer := IBGUIInterface.CreateTimer;
247     if FTimer <> nil then
248     begin
249     FTimer.Enabled := false;
250     FTimer.Interval := 0;
251     FTimer.OnTimer := HandleRefreshTimer;
252     end;
253     end;
254 tony 209 FDelayTimerValue := 0;
255     end;
256    
257     { TIBTable }
258    
259     constructor TIBTable.Create(AOwner: TComponent);
260     begin
261     inherited Create(AOwner);
262     FNameList := TStringList.Create;
263     FSwitchingIndex := False;
264     FIndexDefs := TIndexDefs.Create(Self);
265     WhereAllRefreshSQL := TStringList.Create;
266     WhereDBKeyRefreshSQL := TStringList.Create;
267     WherePrimaryRefreshSQL := TStringList.Create;
268     FDefaultIndex := True;
269     FRegenerateSQL := True;
270     FMasterFieldsList := TStringList.Create;
271     FDetailFieldsList := TStringList.Create;
272     FMasterLink := TIBMasterDataLink.Create(Self);
273     FMasterLink.OnMasterChange := MasterChanged;
274     FMasterLink.OnMasterDisable := MasterDisabled;
275     QRefresh.OnSQLChanging := nil;
276     QDelete.OnSQLChanging := nil;
277     QInsert.OnSQLChanging := nil;
278     QModify.OnSQLChanging := nil;
279     end;
280    
281     destructor TIBTable.Destroy;
282     begin
283     FNameList.Free;
284     FIndexDefs.Free;
285     FMasterFieldsList.Free;
286     FDetailFieldsList.Free;
287     FMasterLink.Free;
288     WhereAllRefreshSQL.Free;
289     WhereDBKeyRefreshSQL.Free;
290     WherePrimaryRefreshSQL.Free;
291     inherited Destroy;
292     end;
293    
294     procedure TIBTable.InternalClose;
295     begin
296     DataEvent(dePropertyChange, 0);
297     inherited InternalClose;
298     end;
299    
300     procedure TIBTable.InternalOpen;
301     begin
302     if FTableName = '' then IBError(ibxeNoTableName, [nil]);
303     ActivateConnection;
304     ActivateTransaction;
305     if FRegenerateSQL then
306     begin
307     InternalUnprepare;
308     GenerateSQL;
309     if not FReadOnly then
310     GenerateUpdateSQL;
311     FRegenerateSQL := False;
312     end;
313     { writeln(SelectSQL.Text);
314     writeln(InsertSQL.Text);
315     writeln(DeleteSQL.Text);
316     writeln(ModifySQL.Text); }
317     SetParams;
318     inherited InternalOpen;
319     end;
320    
321     procedure TIBTable.InternalRefresh;
322     var
323     DBKey: TIBDBKey;
324     begin
325     DBKey := CurrentDBKey;
326     Reopen;
327     if DBKey.DBKey[0] <> 0 then
328     InternalGotoDBKey(DBKey);
329     end;
330    
331     procedure TIBTable.SetFiltered(Value: Boolean);
332     begin
333     if(Filtered <> Value) then
334     begin
335     inherited SetFiltered(value);
336     if Active then
337     InternalTableRefresh;
338     end
339     else
340     inherited SetFiltered(value);
341     end;
342    
343     procedure TIBTable.SetFilterText(const Value: string);
344     begin
345     if Filtered and (Value <> Filter) then
346     begin
347     inherited SetFilterText(value);
348     InternalTableRefresh;
349     end
350     else
351     inherited SetFilterText(value);
352     end;
353    
354     procedure TIBTable.SetFilterOptions(Value: TFilterOptions);
355     begin
356     if Value <> [] then
357     IBError(ibxeNotSupported, [nil]);
358     end;
359    
360     procedure TIBTable.InternalRefreshRow;
361     begin
362     if CurrentDBKey.DBKey[0] <> 0 then
363     QRefresh.SQL.Assign(WhereDBKeyRefreshSQL)
364     else if WherePrimaryRefreshSQL.Text <> '' then
365     QRefresh.SQL.Assign(WherePrimaryRefreshSQL)
366     else
367     QRefresh.SQL.Assign(WhereAllRefreshSQL);
368     inherited InternalRefreshRow;
369     end;
370    
371     function TIBTable.GetMasterDetailDelay: integer;
372     begin
373     Result := TIBMasterDataLink(FMasterLink).DelayTimerValue
374     end;
375    
376     procedure TIBTable.SetMasterDetailDelay(AValue: integer);
377     begin
378     TIBMasterDataLink(FMasterLink).DelayTimerValue := AValue;
379     end;
380    
381     procedure TIBTable.DefChanged(Sender: TObject);
382     begin
383     StoreDefs := True;
384     end;
385    
386     procedure TIBTable.InitFieldDefs;
387     var
388     DidActivate: Boolean;
389     Query: TIBSQL;
390     begin
391     if FTableName = '' then IBError(ibxeNoTableName, [nil]);
392     if (InternalPrepared) then
393     InternalInitFieldDefs
394     else
395     begin
396     {Get the field defs from a simple query on the table}
397     ActivateConnection;
398     Query := TIBSQL.Create(self);
399     try
400     Query.Database := DataBase;
401     Query.Transaction := Database.InternalTransaction;
402     DidActivate := false;
403     Query.SQL.Text := 'Select * from ' + QuoteIdentifier(DataBase.SQLDialect, FTableName);
404     with Query.Transaction do
405     begin
406     if not InTransaction then
407     begin
408     StartTransaction;
409     DidActivate := true
410     end;
411     end;
412     Query.Prepare;
413     FieldDefsFromQuery(Query);
414     if DidActivate then
415     Query.Transaction.Rollback;
416     finally
417     Query.Free;
418     end;
419     end;
420     end;
421    
422     { Index / Ranges / Keys }
423    
424     procedure TIBTable.AddIndex(const Name, Fields: string; Options: TIndexOptions;
425     const DescFields: string);
426     var
427     Query: TIBSQL;
428     FieldList: string;
429     begin
430     FieldDefs.Update;
431     if Active then begin
432     CheckBrowseMode;
433     CursorPosChanged;
434     end;
435     Query := TIBSQL.Create(self);
436     try
437     Query.Database := DataBase;
438     Query.Transaction := Transaction;
439     FieldList := FormatFieldsList(Fields);
440     if (ixPrimary in Options) then
441     begin
442     Query.SQL.Text := 'Alter Table ' + {do not localize}
443     QuoteIdentifier(Database.SQLDialect, FTableName) +
444     ' Add CONSTRAINT ' + {do not localize}
445     QuoteIdentifier(Database.SQLDialect, Name)
446     + ' Primary Key (' + {do not localize}
447     FormatFieldsList(Fields) +
448     ')';
449     end
450     else if ([ixUnique, ixDescending] * Options = [ixUnique, ixDescending]) then
451     Query.SQL.Text := 'Create unique Descending Index ' + {do not localize}
452     QuoteIdentifier(Database.SQLDialect, Name) +
453     ' on ' + {do not localize}
454     QuoteIdentifier(Database.SQLDialect, FTableName) +
455     ' (' + FieldList + ')'
456     else if (ixUnique in Options) then
457     Query.SQL.Text := 'Create unique Index ' + {do not localize}
458     QuoteIdentifier(Database.SQLDialect, Name) +
459     ' on ' + {do not localize}
460     QuoteIdentifier(Database.SQLDialect, FTableName) +
461     ' (' + FieldList + ')'
462     else if (ixDescending in Options) then
463     Query.SQL.Text := 'Create Descending Index ' + {do not localize}
464     QuoteIdentifier(Database.SQLDialect, Name) +
465     ' on ' + {do not localize}
466     QuoteIdentifier(Database.SQLDialect, FTableName) +
467     ' (' + FieldList + ')'
468     else
469     Query.SQL.Text := 'Create Index ' + {do not localize}
470     QuoteIdentifier(Database.SQLDialect, Name) +
471     ' on ' + {do not localize}
472     QuoteIdentifier(Database.SQLDialect, FTableName) +
473     ' (' + FieldList + ')';
474     Query.Prepare;
475     Query.ExecQuery;
476     IndexDefs.Updated := False;
477     finally
478     Query.free
479     end;
480     end;
481    
482     procedure TIBTable.DeleteIndex(const Name: string);
483     var
484     Query: TIBSQL;
485    
486     procedure DeleteByIndex;
487     begin
488     Query := TIBSQL.Create(self);
489     try
490     Query.Database := DataBase;
491     Query.Transaction := Transaction;
492     Query.SQL.Text := 'Drop index ' + {do not localize}
493     QuoteIdentifier(Database.SQLDialect, Name);
494     Query.Prepare;
495     Query.ExecQuery;
496     IndexDefs.Updated := False;
497     finally
498     Query.Free;
499     end;
500     end;
501    
502     function DeleteByConstraint: Boolean;
503     begin
504     Result := False;
505     Query := TIBSQL.Create(self);
506     try
507     Query.Database := DataBase;
508     Query.Transaction := Transaction;
509     Query.SQL.Text := 'Select ''foo'' from RDB$RELATION_CONSTRAINTS ' +
510     'where RDB$RELATION_NAME = ' +
511     '''' +
512     ExtractIdentifier(Database.SQLDialect,
513     QuoteIdentifier(DataBase.SQLDialect, FTableName)) +
514     ''' ' +
515     ' AND RDB$CONSTRAINT_NAME = ' +
516     '''' +
517     ExtractIdentifier(Database.SQLDialect,
518     QuoteIdentifier(DataBase.SQLDialect, Name)) +
519     ''' ' +
520     'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';
521     Query.Prepare;
522     Query.ExecQuery;
523     if not Query.EOF then
524     begin
525     Query.Close;
526     Query.SQL.Text := 'Alter Table ' + {do not localize}
527     QuoteIdentifier(DataBase.SQLDialect, FTableName) +
528     ' Drop Constraint ' +
529     QuoteIdentifier(DataBase.SQLDialect, Name);
530     Query.Prepare;
531     Query.ExecQuery;
532     IndexDefs.Updated := False;
533     Result := True;
534     end;
535     finally
536     Query.Free;
537     end;
538     end;
539    
540     procedure DeleteByKey;
541     begin
542     Query := TIBSQL.Create(self);
543     try
544     Query.Database := DataBase;
545     Query.Transaction := Transaction;
546     Query.SQL.Text := 'Select RDB$CONSTRAINT_NAME from RDB$RELATION_CONSTRAINTS ' +
547     'where RDB$RELATION_NAME = ' +
548     '''' +
549     ExtractIdentifier(Database.SQLDialect,
550     QuoteIdentifier(DataBase.SQLDialect, FTableName)) +
551     ''' ' +
552     'AND RDB$INDEX_NAME = ' +
553     '''' +
554     ExtractIdentifier(Database.SQLDialect,
555     QuoteIdentifier(DataBase.SQLDialect, Name)) +
556     ''' ' +
557     'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';
558     Query.Prepare;
559     Query.ExecQuery;
560     if not Query.EOF then
561     begin
562     Query.Close;
563     Query.SQL.Text := 'Alter Table ' + {do not localize}
564     QuoteIdentifier(DataBase.SQLDialect, FTableName) +
565     ' Drop Constraint ' +
566     QuoteIdentifier(DataBase.SQLDialect, Query.FieldByName('RDB$CONSTRAINT_NAME').AsString);
567     Query.Prepare;
568     Query.ExecQuery;
569     IndexDefs.Updated := False;
570     end;
571     finally
572     Query.Free;
573     end;
574     end;
575    
576     begin
577     if Active then
578     CheckBrowseMode;
579     IndexDefs.Update;
580     if (Pos('RDB$PRIMARY', Name) <> 0 ) then {do not localize} {mbcs ok}
581     DeleteByKey
582     else if not DeleteByConstraint then
583     DeleteByIndex;
584     end;
585    
586     function TIBTable.GetIndexFieldNames: string;
587     begin
588     if FFieldsIndex then Result := FIndexName else Result := '';
589     end;
590    
591     function TIBTable.GetIndexName: string;
592     begin
593     if FFieldsIndex then Result := '' else Result := FIndexName;
594     end;
595    
596     procedure TIBTable.GetIndexNames(List: TStrings);
597     begin
598     IndexDefs.Update;
599     IndexDefs.GetItemNames(List);
600     end;
601    
602     procedure TIBTable.GetIndexParams(const IndexName: string;
603     FieldsIndex: Boolean; var IndexedName: string);
604     var
605     IndexStr: TIndexName;
606     begin
607     if IndexName <> '' then
608     begin
609     IndexDefs.Update;
610     IndexStr := IndexName;
611     if FieldsIndex then
612     IndexStr := IndexDefs.FindIndexForFields(IndexName).Name;
613     end;
614     IndexedName := IndexStr;
615     end;
616    
617     procedure TIBTable.SetIndexDefs(Value: TIndexDefs);
618     begin
619     IndexDefs.Assign(Value);
620     end;
621    
622     procedure TIBTable.SetIndex(const Value: string; FieldsIndex: Boolean);
623     begin
624     if Active then CheckBrowseMode;
625     if (FIndexName <> Value) or (FFieldsIndex <> FieldsIndex) then
626     begin
627     FIndexName := Value;
628     FFieldsIndex := FieldsIndex;
629     if Active then
630     begin
631     SwitchToIndex;
632     end;
633     end;
634     end;
635    
636     procedure TIBTable.SetIndexFieldNames(const Value: string);
637     begin
638     SetIndex(Value, Value <> '');
639     end;
640    
641     procedure TIBTable.SetIndexName(const Value: string);
642     begin
643     SetIndex(Value, False);
644     end;
645    
646     procedure TIBTable.UpdateIndexDefs;
647     var
648     Opts: TIndexOptions;
649     Flds: string;
650     Query, SubQuery: TIBSQL;
651     fn: string;
652     aField: TFieldDef;
653     begin
654     if not (csReading in ComponentState) then begin
655     if not Active and not FSwitchingIndex then
656     FieldDefs.Update;
657     IndexDefs.Clear;
658     Database.InternalTransaction.StartTransaction;
659     Query := TIBSQL.Create(self);
660     try
661     FPrimaryIndexFields := '';
662     Query.GoToFirstRecordOnExecute := False;
663     Query.Database := DataBase;
664     Query.Transaction := Database.InternalTransaction;
665     Query.SQL.Text :=
666     'Select I.RDB$INDEX_NAME, I.RDB$UNIQUE_FLAG, I.RDB$INDEX_TYPE, ' + {do not localize}
667     'I.RDB$SEGMENT_COUNT, S.RDB$FIELD_NAME from RDB$INDICES I, ' + {do not localize}
668     'RDB$INDEX_SEGMENTS S where I.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+ {do not localize}
669     'and I.RDB$RELATION_NAME = ' + '''' + {do not localize}
670     ExtractIdentifier(Database.SQLDialect,
671     QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';
672     Query.Prepare;
673     Query.ExecQuery;
674     while (not Query.EOF) and Query.Next do
675     begin
676     with IndexDefs.AddIndexDef do
677     begin
678     Name := TrimRight(Query.FieldByName('RDB$INDEX_NAME').AsString); {do not localize}
679     Opts := [];
680     if Pos ('RDB$PRIMARY', Name) = 1 then Include(Opts, ixPrimary); {do not localize} {mbcs ok}
681     if Query.FieldByName('RDB$UNIQUE_FLAG').AsInteger = 1 then Include(Opts, ixUnique); {do not localize}
682     if Query.FieldByName('RDB$INDEX_TYPE').AsInteger = 2 then Include(Opts, ixDescending); {do not localize}
683     Options := Opts;
684     if (Query.FieldByName('RDB$SEGMENT_COUNT').AsInteger = 1) then {do not localize}
685     begin
686     fn := Trim(Query.FieldByName('RDB$FIELD_NAME').AsString); {do not localize}
687     aField := GetFieldDefFromAlias(fn);
688     if assigned(aField) then
689     Fields := aField.Name
690     else
691     Fields := fn;
692     end
693     else begin
694     SubQuery := TIBSQL.Create(self);
695     try
696     SubQuery.GoToFirstRecordOnExecute := False;
697     SubQuery.Database := DataBase;
698     SubQuery.Transaction := Database.InternalTransaction;
699     SubQuery.SQL.Text :=
700     'Select RDB$FIELD_NAME from RDB$INDEX_SEGMENTS where RDB$INDEX_NAME = ' + {do not localize}
701     '''' +
702     ExtractIdentifier(Database.SQLDialect,
703     QuoteIdentifier(DataBase.SQLDialect, Name)) +
704     '''' + 'ORDER BY RDB$FIELD_POSITION'; {do not localize}
705     SubQuery.Prepare;
706     SubQuery.ExecQuery;
707     Flds := '';
708     while (not SubQuery.EOF) and SubQuery.Next do
709     begin
710     fn := TrimRight(SubQuery.FieldByName('RDB$FIELD_NAME').AsString); {do not localize}
711     aField := GetFieldDefFromAlias(fn);
712     if assigned(aField) then
713     fn := aField.Name;
714     if (Flds = '') then
715     Flds := fn
716     else begin
717     Query.Next;
718     Flds := Flds + ';' + fn;
719     end;
720     end;
721     Fields := Flds;
722     finally
723     SubQuery.Free;
724     end;
725     end;
726     if (ixDescending in Opts) then
727     DescFields := Fields;
728     if ixPrimary in Opts then
729     FPrimaryIndexFields := Fields;
730     end;
731     end;
732     finally
733     Query.Free;
734     Database.InternalTransaction.Commit;
735     end;
736     end;
737     end;
738    
739     function TIBTable.GetExists: Boolean;
740     var
741     Query: TIBSQL;
742     begin
743     Result := Active;
744     if Result or (TableName = '') then Exit;
745     Database.InternalTransaction.StartTransaction;
746     Query := TIBSQL.Create(self);
747     try
748     Query.Database := DataBase;
749     Query.Transaction := Database.InternalTransaction;
750     Query.SQL.Text :=
751     'Select USER from RDB$RELATIONS where RDB$RELATION_NAME = ' + {do not localize}
752     '''' +
753     ExtractIdentifier(Database.SQLDialect,
754     QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';
755     Query.Prepare;
756     Query.ExecQuery;
757     Result := not Query.EOF;
758     finally
759     Query.Free;
760     Database.InternalTransaction.Commit;
761     end;
762     end;
763    
764     procedure TIBTable.GotoCurrent(Table: TIBTable);
765     begin
766     CheckBrowseMode;
767     Table.CheckBrowseMode;
768     if (Database <> Table.Database) or
769     (CompareText(TableName, Table.TableName) <> 0) then
770     IBError(ibxeTableNameMismatch, [nil]);
771     Table.UpdateCursorPos;
772     InternalGotoDBKey(Table.CurrentDBKey);
773     DoBeforeScroll;
774     Resync([rmExact, rmCenter]);
775     DoAfterScroll;
776     end;
777    
778    
779     procedure TIBTable.CreateTable;
780     var
781     FieldList: string;
782    
783     procedure InitFieldsList;
784     var
785     I: Integer;
786     begin
787     InitFieldDefsFromFields;
788     for I := 0 to FieldDefs.Count - 1 do begin
789     if ( I > 0) then
790     FieldList := FieldList + ', ';
791     with FieldDefs[I] do
792     begin
793     case DataType of
794     ftString:
795     FieldList := FieldList +
796     QuoteIdentifier(DataBase.SQLDialect, Name) +
797     ' VARCHAR(' + IntToStr(Size) + ')'; {do not localize}
798     ftFixedChar:
799     FieldList := FieldList +
800     QuoteIdentifier(DataBase.SQLDialect, Name) +
801     ' CHAR(' + IntToStr(Size) + ')'; {do not localize}
802     ftBoolean:
803     FieldList := FieldList +
804     QuoteIdentifier(DataBase.SQLDialect, Name) +
805     ' BOOLEAN'; {do not localize}
806     ftSmallint, ftWord:
807     FieldList := FieldList +
808     QuoteIdentifier(DataBase.SQLDialect, Name) +
809     ' SMALLINT'; {do not localize}
810     ftInteger:
811     FieldList := FieldList +
812     QuoteIdentifier(DataBase.SQLDialect, Name) +
813     ' INTEGER'; {do not localize}
814     ftFloat, ftCurrency:
815     FieldList := FieldList +
816     QuoteIdentifier(DataBase.SQLDialect, Name) +
817     ' DOUBLE PRECISION'; {do not localize}
818     ftBCD: begin
819     if (Database.SQLDialect = 1) then begin
820     if (Precision > 9) then
821     IBError(ibxeFieldUnsupportedType,[nil]);
822     if (Precision <= 4) then
823     Precision := 9;
824     end;
825     if (Precision <= 4 ) then
826     FieldList := FieldList +
827     QuoteIdentifier(DataBase.SQLDialect, Name) +
828     ' Numeric(18, 4)' {do not localize}
829     else
830     FieldList := FieldList +
831     QuoteIdentifier(DataBase.SQLDialect, Name) +
832     ' Numeric(' + IntToStr(Precision) + ', 4)'; {do not localize}
833     end;
834     ftDate:
835     FieldList := FieldList +
836     QuoteIdentifier(DataBase.SQLDialect, Name) +
837     ' DATE'; {do not localize}
838     ftTime:
839     FieldList := FieldList +
840     QuoteIdentifier(DataBase.SQLDialect, Name) +
841     ' TIME'; {do not localize}
842     ftDateTime:
843     if (Database.SQLDialect = 1) then
844     FieldList := FieldList +
845     QuoteIdentifier(DataBase.SQLDialect, Name) +
846     ' DATE' {do not localize}
847     else
848     FieldList := FieldList +
849     QuoteIdentifier(DataBase.SQLDialect, Name) +
850     ' TIMESTAMP'; {do not localize}
851     ftLargeInt:
852     if (Database.SQLDialect = 1) then
853     IBError(ibxeFieldUnsupportedType,[nil])
854     else
855     FieldList := FieldList +
856     QuoteIdentifier(DataBase.SQLDialect, Name) +
857     ' Numeric(18, 0)'; {do not localize}
858     ftBlob, ftMemo:
859     FieldList := FieldList +
860     QuoteIdentifier(DataBase.SQLDialect, Name) +
861     ' BLOB SUB_TYPE 1'; {do not localize}
862     ftBytes, ftVarBytes, ftGraphic..ftTypedBinary:
863     FieldList := FieldList +
864     QuoteIdentifier(DataBase.SQLDialect, Name) +
865     ' BLOB SUB_TYPE 0'; {do not localize}
866     ftUnknown, ftADT, ftArray, ftReference, ftDataSet,
867     ftCursor, ftWideString, ftAutoInc:
868     IBError(ibxeFieldUnsupportedType,[nil]);
869     else
870     IBError(ibxeFieldUnsupportedType,[nil]);
871     end;
872     if faRequired in Attributes then
873     FieldList := FieldList + ' NOT NULL'; {do not localize}
874     end;
875     end;
876     end;
877    
878     procedure InternalCreateTable;
879     var
880     I: Integer;
881     Query: TIBSQL;
882     begin
883     if (FieldList = '') then
884     IBError(ibxeFieldUnsupportedType,[nil]);
885     Query := TIBSQL.Create(self);
886     try
887     Query.Database := Database;
888     Query.transaction := Transaction;
889     Query.SQL.Text := 'Create Table ' +
890     QuoteIdentifier(DataBase.SQLDialect, FTableName) +
891     ' (' + FieldList; {do not localize}
892     for I := 0 to IndexDefs.Count - 1 do
893     with IndexDefs[I] do
894     if ixPrimary in Options then
895     begin
896     Query.SQL.Text := Query.SQL.Text + ', CONSTRAINT ' +
897     QuoteIdentifier(DataBase.SQLDialect, Name) +
898     ' Primary Key (' +
899     FormatFieldsList(Fields) +
900     ')';
901     end;
902     Query.SQL.Text := Query.SQL.Text + ')';
903     Query.Prepare;
904     Query.ExecQuery;
905     finally
906     Query.Free;
907     end;
908     end;
909    
910     procedure InternalCreateIndex;
911     var
912     I: Integer;
913     begin
914     for I := 0 to IndexDefs.Count - 1 do
915     with IndexDefs[I] do
916     if not (ixPrimary in Options) then
917     AddIndex(Name, Fields, Options);
918     end;
919    
920     begin
921     CheckInactive;
922     InitFieldsList;
923     InternalCreateTable;
924     InternalCreateIndex;
925     end;
926    
927     procedure TIBTable.DeleteTable;
928     var
929     Query: TIBSQL;
930     begin
931     CheckInactive;
932     Query := TIBSQL.Create(self);
933     try
934     Query.Database := DataBase;
935     Query.Transaction := Transaction;
936     Query.SQL.Text := 'drop table ' + {do not localize}
937     QuoteIdentifier(DataBase.SQLDialect, FTableName);
938     Query.Prepare;
939     Query.ExecQuery;
940     finally
941     Query.Free;
942     end;
943     end;
944    
945     procedure TIBTable.EmptyTable;
946     var
947     Query: TIBSQL;
948     begin
949     if Active then
950     CheckBrowseMode;
951     Query := TIBSQL.Create(self);
952     try
953     Query.Database := DataBase;
954     Query.Transaction := Transaction;
955     Query.SQL.Text := 'delete from ' + {do not localize}
956     QuoteIdentifier(DataBase.SQLDialect, FTableName);
957     Query.Prepare;
958     Query.ExecQuery;
959     if Active then
960     begin
961     ClearBuffers;
962     DataEvent(deDataSetChange, 0);
963     end;
964     finally
965     Query.Free;
966     end;
967     end;
968    
969     procedure TIBTable.DataEvent(Event: TDataEvent; Info: Ptrint);
970     begin
971     if Event = dePropertyChange then begin
972     IndexDefs.Updated := False;
973     FRegenerateSQL := True;
974     end;
975     inherited DataEvent(Event, Info);
976     end;
977    
978     { Informational & Property }
979    
980     function TIBTable.GetCanModify: Boolean;
981     begin
982     Result := True;
983     if (FTableName = '') or FReadOnly
984     or FSystemTable or FMultiTableView then
985     Result := False;
986     end;
987    
988     function TIBTable.InternalGetUpdatable: Boolean;
989     var
990     Query : TIBSQL;
991     begin
992     Database.InternalTransaction.StartTransaction;
993     Query := TIBSQL.Create(self);
994     try
995     Query.Database := DataBase;
996     Query.Transaction := Database.InternalTransaction;
997     Query.SQL.Text := 'Select RDB$SYSTEM_FLAG, RDB$DBKEY_LENGTH ' + {do not localize}
998     'from RDB$RELATIONS where RDB$RELATION_NAME = ' + {do not localize}
999     '''' +
1000     ExtractIdentifier(Database.SQLDialect,
1001     QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';
1002     Query.Prepare;
1003     Query.ExecQuery;
1004     if (Query.Fields[0].AsInteger <> 0) or
1005     (Query.Fields[1].AsInteger <> 8) then
1006     Result := False
1007     else
1008     Result := True;
1009     finally
1010     Query.Free;
1011     Database.InternalTransaction.Commit;
1012     end;
1013     end;
1014    
1015     function TIBTable.IndexDefsStored: Boolean;
1016     begin
1017     Result := StoreDefs and (IndexDefs.Count > 0);
1018     end;
1019    
1020     procedure TIBTable.SetParams;
1021     var
1022     i: Integer;
1023     begin
1024     if (MasterSource = nil) or (MasterSource.DataSet = nil) or
1025     (not MasterSource.DataSet.Active) or (FMasterFieldsList.Count = 0) then
1026     exit;
1027     for i := 0 to FMasterFieldsList.Count - 1 do
1028     QSelect.Params.ByName(FMasterFieldsList.Strings[i]).Value :=
1029     MasterSource.DataSet.FieldByName(FMasterFieldsList.Strings[i]).Value;
1030     end;
1031    
1032     procedure TIBTable.MasterChanged(Sender: TObject);
1033     begin
1034     CheckBrowseMode;
1035     SetParams;
1036     ReQuery;
1037     end;
1038    
1039     procedure TIBTable.MasterDisabled(Sender: TObject);
1040     begin
1041     DataEvent(dePropertyChange, 0);
1042     ReQuery;
1043     end;
1044    
1045     function TIBTable.GetDataSource: TDataSource;
1046     begin
1047     Result := FMasterLink.DataSource;
1048     end;
1049    
1050     procedure TIBTable.SetDataSource(Value: TDataSource);
1051     begin
1052     if IsLinkedTo(Value) then IBError(ibxeCircularDataLink, [Self]);
1053     if FMasterLink.DataSource <> Value then
1054     DataEvent(dePropertyChange, 0);
1055     FMasterLink.DataSource := Value;
1056     end;
1057    
1058     function TIBTable.GetMasterFields: string;
1059     begin
1060     Result := FMasterLink.FieldNames;
1061     end;
1062    
1063     procedure TIBTable.SetMasterFields(const Value: string);
1064     begin
1065     if FMasterLink.FieldNames <> Value then
1066     DataEvent(dePropertyChange, 0);
1067     FMasterLink.FieldNames := Value;
1068     end;
1069    
1070     procedure TIBTable.DoOnNewRecord;
1071     var
1072     I: Integer;
1073     begin
1074     if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
1075     for I := 0 to FMasterLink.Fields.Count - 1 do
1076     IndexFields[I] := TField(FMasterLink.Fields[I]);
1077     inherited DoOnNewRecord;
1078     end;
1079    
1080     function TIBTable.FormatFieldsList(Value: string): string;
1081     var
1082     FieldName: string;
1083     i: Integer;
1084     begin
1085     if Database.SQLDialect = 1 then begin
1086     Value := QuoteIdentifier(Database.SQLDialect, Value);
1087     Result := StringReplace (Value, ';', ', ', [rfReplaceAll]);
1088     end
1089     else begin
1090     i := 1;
1091     Result := '';
1092     while i <= Length(Value) do
1093     begin
1094     FieldName := ExtractFieldName(Value, i);
1095     if Result = '' then
1096     Result := QuoteIdentifier(Database.SQLDialect, FieldName)
1097     else
1098     Result := Result + ', ' + QuoteIdentifier(Database.SQLDialect, FieldName);
1099     end;
1100     end;
1101     end;
1102    
1103     procedure TIBTable.ExtractLinkFields;
1104     var
1105     i: Integer;
1106     DetailFieldNames: String;
1107     begin
1108     FMasterFieldsList.Clear;
1109     FDetailFieldsList.Clear;
1110     i := 1;
1111     while i <= Length(MasterFields) do
1112     FMasterFieldsList.Add(ExtractFieldName(MasterFields, i));
1113     i := 1;
1114     if IndexFieldNames = '' then
1115     DetailFieldNames := FPrimaryIndexFields
1116     else
1117     DetailFieldNames := IndexFieldNames;
1118     while i <= Length(DetailFieldNames) do
1119     FDetailFieldsList.Add(ExtractFieldName(DetailFieldNames, i));
1120     end;
1121    
1122     procedure TIBTable.GetDetailLinkFields(MasterFields, DetailFields: TList);
1123     var
1124     i: Integer;
1125     Idx: TIndexDef;
1126     begin
1127     MasterFields.Clear;
1128     DetailFields.Clear;
1129     if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and
1130     (Self.MasterFields <> '') then
1131     begin
1132     Idx := nil;
1133     MasterSource.DataSet.GetFieldList(MasterFields, Self.MasterFields);
1134     UpdateIndexDefs;
1135     if IndexName <> '' then
1136     Idx := IndexDefs.Find(IndexName)
1137     else if IndexFieldNames <> '' then
1138     Idx := IndexDefs.GetIndexForFields(IndexFieldNames, False)
1139     else
1140     for i := 0 to IndexDefs.Count - 1 do
1141     if ixPrimary in IndexDefs[i].Options then
1142     begin
1143     Idx := IndexDefs[i];
1144     break;
1145     end;
1146     if Idx <> nil then
1147     GetFieldList(DetailFields, Idx.Fields);
1148     end;
1149     end;
1150    
1151     procedure TIBTable.SetReadOnly(Value: Boolean);
1152     begin
1153     CheckInactive;
1154     FReadOnly := Value;
1155     end;
1156    
1157     procedure TIBTable.SetTableName(Value: String);
1158     begin
1159     if not (csReading in ComponentState) then
1160     begin
1161     CheckInactive;
1162     if Value <> FTableName then
1163     begin
1164     ResetSQLStatements;
1165     FRegenerateSQL := True;
1166     FTableName := Value;
1167     IndexName := '';
1168     IndexFieldNames := '';
1169     FPrimaryIndexFields := '';
1170     DataEvent(dePropertyChange, 0);
1171     end;
1172     end
1173     else if Value <> FTableName then
1174     FTableName := Value;
1175     end;
1176    
1177     function TIBTable.GetIndexField(Index: Integer): TField;
1178     var
1179     I, Count: Integer;
1180     FieldNames, FieldName: String;
1181     begin
1182     Result := nil;
1183     FieldName := '';
1184     FieldNames := IndexFieldNames;
1185     if FieldNames = '' then
1186     begin
1187     for I := 0 to IndexDefs.Count - 1 do
1188     if (IndexDefs[i].Name = FIndexName) then
1189     begin
1190     FieldNames := IndexDefs[i].Fields;
1191     break;
1192     end;
1193     end;
1194     for I := 0 to Index do
1195     begin
1196     Count := Pos(';', FieldNames); {mbcs OK}
1197     if Count = 0 then
1198     FieldName := FieldNames
1199     else begin
1200     FieldName := Copy(FieldNames, 0, Count - 1);
1201     System.Delete(FieldNames, 1, Count);
1202     end;
1203     end;
1204     if FieldName <> '' then
1205     Result := FieldByName(FieldName)
1206     else
1207     IBError(ibxeIndexFieldMissing, [nil]);
1208     end;
1209    
1210    
1211     procedure TIBTable.SetIndexField(Index: Integer; Value: TField);
1212     begin
1213     GetIndexField(Index).Assign(Value);
1214     end;
1215    
1216     function TIBTable.GetIndexFieldCount: Integer;
1217     var
1218     I, Index: Integer;
1219     FieldNames: String;
1220     done: Boolean;
1221     begin
1222     FieldNames := IndexFieldNames;
1223     if FieldNames = '' then
1224     begin
1225     for I := 0 to IndexDefs.Count - 1 do
1226     if (IndexDefs[i].Name = FIndexName) then
1227     begin
1228     FieldNames := IndexDefs[i].Fields;
1229     break;
1230     end;
1231     end;
1232     if FieldNames = '' then
1233     Result := 0
1234     else
1235     begin
1236     done := False;
1237     Result := 1;
1238     while not done do
1239     begin
1240     Index := Pos(';', FieldNames); {mbcs ok}
1241     if Index <> 0 then
1242     begin
1243     System.Delete(FieldNames, 1, Index);
1244     Inc(Result);
1245     end else
1246     done := True;
1247     end;
1248     end;
1249     end;
1250    
1251     function TIBTable.GetTableNames: TStrings;
1252     begin
1253     FNameList.clear;
1254     GetTableNamesFromServer;
1255     Result := FNameList;
1256     end;
1257    
1258     procedure TIBTable.GetTableNamesFromServer;
1259     var
1260     Query : TIBSQL;
1261     begin
1262     if not (csReading in ComponentState) then begin
1263     ActivateConnection;
1264     Database.InternalTransaction.StartTransaction;
1265     Query := TIBSQL.Create(self);
1266     try
1267     Query.GoToFirstRecordOnExecute := False;
1268     Query.Database := DataBase;
1269     Query.Transaction := Database.InternalTransaction;
1270     if (TableTypes * [ttSystem, ttView] = [ttSystem, ttView]) then
1271     Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' {do not localize}
1272     else if ttSystem in TableTypes then
1273     Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1274     ' where RDB$VIEW_BLR is NULL' {do not localize}
1275     else if ttView in TableTypes then
1276     Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1277     ' where RDB$SYSTEM_FLAG = 0' {do not localize}
1278     else
1279     Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1280     ' where RDB$VIEW_BLR is NULL and RDB$SYSTEM_FLAG = 0'; {do not localize}
1281     Query.Prepare;
1282     Query.ExecQuery;
1283     while (not Query.EOF) and Query.Next do
1284     FNameList.Add (TrimRight(Query.Fields[0].AsString));
1285     finally
1286     Query.Free;
1287     Database.InternalTransaction.Commit;
1288     end;
1289     end;
1290     end;
1291    
1292     procedure TIBTable.SwitchToIndex();
1293     begin
1294     FSwitchingIndex := True;
1295     InternalTableRefresh;
1296     FSwitchingIndex := False;
1297     end;
1298    
1299     procedure TIBTable.InternalTableRefresh();
1300     var
1301     DBKey: TIBDBKey;
1302     begin
1303     CheckActive;
1304     DBKey := CurrentDBKey;
1305     FRegenerateSQL := True;
1306     Reopen;
1307     if DBKey.DBKey[0] <> 0 then
1308     InternalGotoDBKey(DBKey);
1309     end;
1310    
1311     procedure TIBTable.GenerateSQL;
1312     var
1313     i: Integer;
1314     SQL: TStrings;
1315     OrderByStr: string;
1316     bWhereClausePresent: Boolean;
1317     fn: string;
1318     aField: TFieldDef;
1319     begin
1320     bWhereClausePresent := False;
1321     Database.CheckActive;
1322     Transaction.CheckInTransaction;
1323     if IndexDefs.Updated = False then
1324     IndexDefs.Update;
1325     if IndexFieldNames <> '' then
1326     OrderByStr := FormatFieldsList(IndexFieldNames)
1327     else if IndexName <> '' then
1328     OrderByStr := FormatFieldsList(IndexDefs[IndexDefs.Indexof (IndexName)].Fields)
1329     else if FDefaultIndex and (FPrimaryIndexFields <> '') then
1330     OrderByStr := FormatFieldsList(FPrimaryIndexFields);
1331     SQL := TStringList.Create;
1332     SQL.Text := 'select ' + {do not localize}
1333     QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
1334     + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1335     + QuoteIdentifier(DataBase.SQLDialect, FTableName);
1336     if Filtered and (Filter <> '') then
1337     begin
1338     SQL.Text := SQL.Text + ' where ' + Filter; {do not localize}
1339     bWhereClausePresent := True;
1340     end;
1341     if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and (MasterFields <> '') then
1342     begin
1343     if bWhereClausePresent then
1344     SQL.Text := SQL.Text + ' AND ' {do not localize}
1345     else
1346     SQL.Text := SQL.Text + ' WHERE '; {do not localize}
1347     ExtractLinkfields;
1348     if FDetailFieldsList.Count < FMasterFieldsList.Count then
1349     IBError(ibxeUnknownError, [nil]);
1350     for i := 0 to FMasterFieldsList.Count - 1 do
1351     begin
1352     if i > 0 then
1353     SQL.Text := SQL.Text + 'AND ';
1354     aField := FieldDefs.Find(FDetailFieldsList.Strings[i]);
1355     if assigned(aField) then
1356     fn := GetDBAliasName(aField.FieldNo)
1357     else
1358     fn := FDetailFieldsList.Strings[i]; {something wrong if we get here - but should word}
1359     SQL.Text := SQL.Text +
1360     QuoteIdentifier(DataBase.SQLDialect, fn) + ' = :' + FMasterFieldsList.Strings[i];
1361     end;
1362     end;
1363     if OrderByStr <> '' then
1364     SQL.Text := SQL.Text + ' order by ' + OrderByStr; {do not localize}
1365     SelectSQL.Assign(SQL);
1366     RefreshSQL.Text := 'select ' + {do not localize}
1367     QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
1368     + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1369     + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1370     ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY'; {do not localize}
1371     WhereDBKeyRefreshSQL.Assign(RefreshSQL);
1372     InternalPrepare;
1373     SQL.Free;
1374     end;
1375    
1376     procedure TIBTable.GenerateUpdateSQL;
1377     var
1378     InsertFieldList, InsertParamList, UpdateFieldList: string;
1379     WherePrimaryFieldList, WhereAllFieldList,
1380     InsertReturningFieldList, UpdateReturningFieldList: string;
1381    
1382     procedure GenerateFieldLists;
1383     var
1384     I: Integer;
1385     AllowReturningClause: boolean;
1386     begin
1387     {Is database Firebird 2.1 or later?}
1388     AllowReturningClause := (DatabaseInfo.ODSMajorVersion > 11) or
1389     ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1));
1390     for I := 0 to FieldDefs.Count - 1 do begin
1391     with TIBFieldDef(FieldDefs[I]) do begin
1392     if AllowReturningClause then
1393     begin
1394     if (faReadOnly in Attributes) or IdentityColumn then
1395     begin
1396     if InsertReturningFieldList <> '' then
1397     InsertReturningFieldList := InsertReturningFieldList + ', ' +
1398     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1399     else
1400     InsertReturningFieldList := ' RETURNING ' +
1401     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1402     end;
1403     if (faReadOnly in Attributes) then
1404     begin
1405     if UpdateReturningFieldList <> '' then
1406     UpdateReturningFieldList := UpdateReturningFieldList + ', ' +
1407     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1408     else
1409     UpdateReturningFieldList := ' RETURNING ' +
1410     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1411     end;
1412     end;
1413     if not (InternalCalcField or (faReadOnly in Attributes) or
1414     (DataType = ftUnknown)) then
1415     begin
1416     if not IdentityColumn then
1417     begin
1418     if ( InsertFieldList <> '' ) then begin
1419     InsertFieldList := InsertFieldList + ', ';
1420     InsertParamList := InsertParamList + ', ';
1421     end;
1422     InsertFieldList := InsertFieldList +
1423     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo));
1424     InsertParamList := InsertParamList + ':' + Name;
1425     end;
1426     if (UpdateFieldList <> '') then begin
1427     UpdateFieldList := UpdateFieldList + ', ';
1428     if (DataType <> ftBlob) and (DataType <>ftMemo) then
1429     WhereAllFieldList := WhereAllFieldList + ' AND ';
1430     end;
1431     UpdateFieldList := UpdateFieldList +
1432     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo)) +
1433     ' = :' + Name;
1434     if (DataType <> ftBlob) and (DataType <>ftMemo) then
1435     WhereAllFieldList := WhereAllFieldList +
1436     QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo)) + ' = :' + Name;
1437     end;
1438     end;
1439     end;
1440     end;
1441    
1442     procedure GenerateWherePrimaryFieldList;
1443     var
1444     i: Integer;
1445     tmp, fn: String;
1446     aField: TFieldDef;
1447     begin
1448     i := 1;
1449     while i <= Length(FPrimaryIndexFields) do
1450     begin
1451     tmp := ExtractFieldName(FPrimaryIndexFields, i);
1452     aField := FieldDefs.Find(tmp);
1453     if assigned(aField) then
1454     fn := GetDBAliasName(aField.FieldNo)
1455     else
1456     fn := tmp; {something wrong if we get here - but will work in most cases}
1457     tmp :=
1458     QuoteIdentifier(DataBase.SQLDialect, fn) + ' = :' +
1459     QuoteIdentifier(DataBase.SQLDialect, tmp);{do not localize}
1460     if WherePrimaryFieldList <> '' then
1461     WherePrimaryFieldList :=
1462     WherePrimaryFieldList + ' AND ' + tmp
1463     else
1464     WherePrimaryFieldList := tmp;
1465     end;
1466     end;
1467    
1468     begin
1469     if InternalGetUpdatable = False then
1470     FReadOnly := True
1471     else
1472     begin
1473     DeleteSQL.Text := 'delete from ' + {do not localize}
1474     QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1475     ' where RDB$DB_KEY = ' + ':IBX_INTERNAL_DBKEY'; {do not localize}
1476     GenerateFieldLists;
1477     InsertSQL.Text := 'insert into ' + {do not localize}
1478     QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1479     ' (' + InsertFieldList + {do not localize}
1480     ') values (' + InsertParamList + ')' + InsertReturningFieldList; {do not localize}
1481     ModifySQL.Text := 'update ' +
1482     QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1483     ' set ' + UpdateFieldList + {do not localize}
1484     ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY' + UpdateReturningFieldList; {do not localize}
1485     WhereAllRefreshSQL.Text := 'select ' + {do not localize}
1486     QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, '
1487     + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1488     + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1489     ' where ' + WhereAllFieldList ; {do not localize}
1490     if FPrimaryIndexFields <> '' then
1491     begin
1492     GenerateWherePrimaryFieldList;
1493     WherePrimaryRefreshSQL.Text := 'select ' + {do not localize}
1494     QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
1495     + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1496     + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1497     ' where ' + WherePrimaryFieldList; {do not localize}
1498     end;
1499     try
1500     InternalPrepare;
1501     except
1502     FReadonly := True;
1503     end;
1504     end;
1505     end;
1506    
1507     procedure TIBTable.ResetSQLStatements;
1508     begin
1509     SelectSQL.Text := '';
1510     DeleteSQL.Text := '';
1511     InsertSQL.Text := '';
1512     ModifySQL.Text := '';
1513     RefreshSQL.Text := '';
1514     end;
1515    
1516     procedure TIBTable.SetTableTypes(
1517     const Value: TIBTableTypes);
1518     begin
1519     FTableTypes := Value;
1520     end;
1521    
1522     function TIBTable.InternalGotoDBKey(DBKey: TIBDBKey): Boolean;
1523    
1524     function DBKeyCompare (DBKey1, DBKey2: TIBDBKey): Boolean;
1525     var
1526     I: Integer;
1527     begin
1528     for I := 0 to 7 do
1529     if (DBKey1.DBKey[i] <> DBKey2.DBKey[i]) then begin
1530     result := False;
1531     exit;
1532     end;
1533     result := True;
1534     end;
1535     begin
1536     CheckActive;
1537     DisableControls;
1538     try
1539     result := False;
1540     First;
1541     while ((not result) and (not EOF)) do begin
1542     if (DBKeyCompare (DBKey, PRecordData(GetActiveBuf)^.rdDBKey)) then
1543     result := True
1544     else
1545     Next;
1546     end;
1547     if not result then
1548     First
1549     else
1550     CursorPosChanged;
1551     finally
1552     EnableControls;
1553     end;
1554     end;
1555    
1556     function TIBTable.GetCurrentDBKey: TIBDBKey;
1557     var
1558     Buf: pChar;
1559     begin
1560     CheckActive;
1561     buf := GetActiveBuf;
1562     if Buf <> nil then
1563     Result := PRecordData(Buf)^.rdDBKey
1564     else
1565     Result.DBKey[0] := 0;
1566     end;
1567    
1568     procedure TIBTable.Reopen;
1569     begin
1570     DisableControls;
1571     try
1572     if Active then
1573     begin
1574     SetState(dsInactive);
1575     CloseCursor;
1576     OpenCursor(false);
1577     SetState(dsBrowse);
1578     end;
1579     finally
1580     EnableControls;
1581     end;
1582     end;
1583    
1584     end.