ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 33
Committed: Sat Jul 18 12:30:52 2015 UTC (8 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 44843 byte(s)
Log Message:
Committing updates for Release R1-3-1

File Contents

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