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