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

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