ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (8 years ago) by tony
Content type: text/x-pascal
File size: 44829 byte(s)
Log Message:
Committing updates for Release R2-0-0

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