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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines