ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 19
Committed: Mon Jul 7 13:00:15 2014 UTC (10 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 46112 byte(s)
Log Message:
Committing updates for Release R1-1-0

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