ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBTable.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines