ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 1
Committed: Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 49475 byte(s)
Log Message:
Borland IBX Open Source Release

File Contents

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