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