ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 23
Committed: Fri Mar 13 10:26:52 2015 UTC (9 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 46283 byte(s)
Log Message:
Committing updates for Release R1-2-1

File Contents

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