QBasic & Borland Pascal & C/Delphi5.iso/Runimage/Delphi50/Source/Vcl/IBTABLE.PAS

Pascal/Delphi Source File | 1999-08-11 | 48.3 KB | 1,578 lines

{********************************************************}
{                                                        }
{       Borland Delphi Visual Component Library          }
{       InterBase Express core components                }
{                                                        }
{       Copyright (c) 1998-1999 Inprise Corporation      }
{                                                        }
{    InterBase Express is based in part on the product   }
{    Free IB Components, written by Gregory H. Deatz for }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.     }
{    Free IB Components is used under license.           }
{                                                        }
{********************************************************}

unit IBTable;

interface

uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
     IB, IBDatabase, IBCustomDataSet, IBHeader, IBSQL, IBUtils;

type

{ TIBTable }

  TBatchMode = (batAppend, batUpdate, batAppendUpdate, batDelete, batCopy);
  TIBTableType = (ttSystem, ttView);
  TIBTableTypes = set of TIBTableType;
  TIndexName = String;

  TIBTable = class;

  TIBTable = class(TIBCustomDataSet)
  private
    FSystemTable: Boolean;
    FMultiTableView: Boolean;
    FMasterLink: TMasterDataLink;
    FMasterFieldsList: TStringList;
    FDetailFieldsList: TStringList;
    FStoreDefs: Boolean;
    FIndexDefs: TIndexDefs;
    FDefaultIndex: Boolean;
    FReadOnly: Boolean;
    FFieldsIndex: Boolean;
    FTableName: String;
    FIndexName: TIndexName;
    FRegenerateSQL: Boolean;
    FNameList: TStrings;
    FSwitchingIndex: Boolean;
    FPrimaryIndexFields: string;
    FTableTypes: TIBTableTypes;
    WhereAllRefreshSQL: TStrings;
    WhereDBKeyRefreshSQL: TStrings;
    WherePrimaryRefreshSQL: TStrings;

    function GetIndexFieldCount: Integer;
    function GetIndexField(Index: Integer): TField;
    procedure MasterChanged(Sender: TObject);
    procedure MasterDisabled(Sender: TObject);
    procedure SetDataSource(Value: TDataSource);
    procedure SetIndexField(Index: Integer; Value: TField);
    procedure SetIndexFieldNames(const Value: string);
    procedure GenerateSQL;
    procedure GenerateUpdateSQL;
    procedure SwitchToIndex();
    procedure InternalTableRefresh();
    function GetTableNames: TStrings;
    procedure GetTableNamesFromServer;
    procedure SetTableTypes(
    const Value: TIBTableTypes);
    function InternalGotoDBKey(DBKey: TIBDBKey): Boolean;
    function FormatFieldsList(Value: string): string;
    function GetCurrentDBKey: TIBDBKey;
    function InternalGetUpdatable: Boolean;
    function GetExists: Boolean;
    procedure SetIndexDefs(Value: TIndexDefs);
    procedure ExtractLinkFields;
    function FieldDefsStored: Boolean;
    function IndexDefsStored: Boolean;
    function GetMasterFields: string;
    procedure SetMasterFields(const Value: string);
    function GetIndexFieldNames: string;
    function GetIndexName: string;
    procedure SetIndexName(const Value: string);
    procedure SetParams;
    procedure SetReadOnly(Value: Boolean);
    procedure SetTableName(Value: String);
    procedure SetIndex(const Value: string; FieldsIndex: Boolean);
    procedure ResetSQLStatements;
    procedure Reopen;

  protected
    { IProviderSupport }
    function PSGetDefaultOrder: TIndexDef; override;
    function PSGetKeyFields: string; override;
    function PSGetTableName: string; override;
    function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;

    procedure DoOnNewRecord; override;
    procedure GetIndexParams(const IndexName: string; FieldsIndex: Boolean;
      var IndexedName: string);
    function GetCanModify: Boolean; override;
    procedure UpdateIndexDefs; override;
    procedure DataEvent(Event: TDataEvent; Info: Longint); override;
    procedure DefChanged(Sender: TObject); override;
    function GetDataSource: TDataSource; override;
    procedure InitFieldDefs; override;
    procedure InternalClose; override;
    procedure InternalOpen; override;
    procedure SetFiltered(Value: Boolean); override;
    procedure SetFilterText(const Value: string); override;
    procedure SetFilterOptions(Value: TFilterOptions); override;
    procedure InternalRefreshRow; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddIndex(const Name, Fields: string; Options: TIndexOptions;
      const DescFields: string = '');
    procedure CreateTable;
    procedure DeleteIndex(const Name: string);
    procedure DeleteTable;
    procedure EmptyTable;
    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
    procedure GetIndexNames(List: TStrings);
    procedure GotoCurrent(Table: TIBTable);
    property CurrentDBKey: TIBDBKey read GetCurrentDBKey;
    property Exists: Boolean read GetExists;
    property IndexFieldCount: Integer read GetIndexFieldCount;
    property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
    property TableNames: TStrings read GetTableNames;
    property BufferChunks;
    property UniDirectional;

  published
    property CachedUpdates;
    property Constraints stored ConstraintsStored;
    property DefaultIndex: Boolean read FDefaultIndex write FDefaultIndex default True;
    property FieldDefs stored FieldDefsStored;
    property Filter;
    property Filtered;
    property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs stored IndexDefsStored;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property IndexName: string read GetIndexName write SetIndexName;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
    property TableName: String read FTableName write SetTableName;
    property UpdateObject;
    property TableTypes: TIBTableTypes read FTableTypes write SetTableTypes default [];
  end;

implementation

{ TIBTable }

constructor TIBTable.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FNameList := TStringList.Create;
  FSwitchingIndex := False;
  FIndexDefs := TIndexDefs.Create(Self);
  WhereAllRefreshSQL := TStringList.Create;
  WhereDBKeyRefreshSQL := TStringList.Create;
  WherePrimaryRefreshSQL := TStringList.Create;
  FDefaultIndex := True;
  FRegenerateSQL := True;
  FMasterFieldsList := TStringList.Create;
  FDetailFieldsList := TStringList.Create;
  FMasterLink := TMasterDataLink.Create(Self);
  FMasterLink.OnMasterChange := MasterChanged;
  FMasterLink.OnMasterDisable := MasterDisabled;
  QRefresh.OnSQLChanging := nil;
  QDelete.OnSQLChanging := nil;
  QInsert.OnSQLChanging := nil;
  QModify.OnSQLChanging := nil;
end;

destructor TIBTable.Destroy;
begin
  FNameList.Free;
  FIndexDefs.Free;
  FMasterFieldsList.Free;
  FDetailFieldsList.Free;
  FMasterLink.Free;
  WhereAllRefreshSQL.Free;
  WhereDBKeyRefreshSQL.Free;
  WherePrimaryRefreshSQL.Free;
  inherited Destroy;
end;

procedure TIBTable.InternalClose;
begin
  DataEvent(dePropertyChange, 0);
  inherited InternalClose;
end;

procedure TIBTable.InternalOpen;
begin
  if FTableName = '' then IBError(ibxeNoTableName, [nil]);
  ActivateConnection;
  ActivateTransaction;
  if FRegenerateSQL then
  begin
    InternalUnprepare;
    GenerateSQL;
    if not FReadOnly then
      GenerateUpdateSQL;
    FRegenerateSQL := False;
  end;
  SetParams;
  inherited InternalOpen;
end;

procedure TIBTable.SetFiltered(Value: Boolean);
begin
  if(Filtered <> Value) then
  begin
    inherited SetFiltered(value);
    if Active then
      InternalTableRefresh;
  end
  else
    inherited SetFiltered(value);
end;

procedure TIBTable.SetFilterText(const Value: string);
begin
  if Filtered and (Value <> Filter) then
  begin
    inherited SetFilterText(value);
    InternalTableRefresh;
  end
  else
    inherited SetFilterText(value);
end;

procedure TIBTable.SetFilterOptions(Value: TFilterOptions);
begin
  if Value <> [] then
    IBError(ibxeNotSupported, [nil]);
end;

procedure TIBTable.InternalRefreshRow;
begin
  if CurrentDBKey.DBKey[0] <> 0 then
    QRefresh.SQL.Assign(WhereDBKeyRefreshSQL)
  else if WherePrimaryRefreshSQL.Text <> '' then
    QRefresh.SQL.Assign(WherePrimaryRefreshSQL)
  else
    QRefresh.SQL.Assign(WhereAllRefreshSQL);
  inherited;

end;

procedure TIBTable.DefChanged(Sender: TObject);
begin
  StoreDefs := True;
end;

procedure TIBTable.InitFieldDefs;
var
  sqlscale: Integer;
  Query: TIBSQL;
begin
  if FTableName = '' then IBError(ibxeNoTableName, [nil]);
  if (InternalPrepared) then InternalInitFieldDefs else
  begin
    Database.InternalTransaction.StartTransaction;
    Query := TIBSQL.Create(self);
    try
      Query.GoToFirstRecordOnExecute := False;
      Query.Database := DataBase;
      Query.Transaction := Database.InternalTransaction;
      Query.SQL.Text := 'Select R.RDB$FIELD_NAME, R.RDB$FIELD_POSITION, ' + {do not localize}
                        'F.RDB$COMPUTED_BLR, F.RDB$DEFAULT_VALUE, ' + {do not localize}
                        'F.RDB$NULL_FLAG, ' + {do not localize}
                        'F.RDB$FIELD_LENGTH, F.RDB$FIELD_SCALE, ' + {do not localize}
                        'F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE, ' + {do not localize}
                        'F.RDB$EXTERNAL_LENGTH, F.RDB$EXTERNAL_SCALE, F.RDB$EXTERNAL_TYPE ' + {do not localize}
                        'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
                        'where R.RDB$RELATION_NAME = ' + {do not localize}
                        '''' +
                        FormatIdentifierValue(Database.SQLDialect, FTableName) +
                        ''' ' +
                        'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '+ {do not localize}
                        'order by R.RDB$FIELD_POSITION'; {do not localize}

      Query.Prepare;
      Query.ExecQuery;
      FieldDefs.BeginUpdate;
      FieldDefs.Clear;
      while (not Query.EOF) and (Query.Next <> nil) do
      begin
          with FieldDefs.AddFieldDef do
          begin
            FieldNo := Query.Current.ByName('RDB$FIELD_POSITION').AsInteger; {do not localize}
            Name := TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString); {do not localize}
            case Query.Current.ByName('RDB$FIELD_TYPE').AsInteger of {do not localize}
              blr_varying, blr_text: begin
                DataType := ftString;
                Size := Query.Current.ByName('RDB$FIELD_LENGTH').AsInteger; {do not localize}
              end;
              blr_float, blr_double, blr_d_float: DataType := ftFloat;
              blr_short: begin
                sqlscale := Query.Current.ByName('RDB$FIELD_SCALE').AsInteger; {do not localize}
                if (sqlscale = 0) then
                  DataType := ftSmallInt
                else begin
                  DataType := ftBCD;
                  Precision := 4;
                end;
              end;
              blr_long: begin
                sqlscale := Query.Current.ByName('RDB$FIELD_SCALE').AsInteger; {do not localize}
                if (sqlscale = 0) then
                  DataType := ftInteger
                else if (sqlscale >= (-4)) then begin
                  DataType := ftBCD;
                  Precision := 9;
                end else
                  DataType := ftFloat;
              end;
              blr_int64: begin
                sqlscale := Query.Current.ByName('RDB$FIELD_SCALE').AsInteger; {do not localize}
                if (sqlscale = 0) then
                  DataType := ftLargeInt
                else if (sqlscale >= (-4)) then begin
                  DataType := ftBCD;
                  Precision := 18;
                end else
                  DataType := ftFloat;
              end;
              blr_timestamp: DataType := ftDateTime;
              blr_sql_time: DataType := ftTime;
              blr_sql_date: DataType := ftDate;
              blr_blob:
                if (Query.Current.ByName('RDB$FIELD_SUB_TYPE').AsInteger = 1) then {do not localize}
                  DataType := ftMemo
                else
                  DataType := ftBlob;
              blr_quad: begin
                DataType := ftUnknown;
                Size := sizeof (TISC_QUAD);
              end;
              else
                DataType := ftUnknown;
            end;
            if not (Query.Current.ByName('RDB$COMPUTED_BLR').IsNull) then {do not localize}
            begin
              Attributes := [faReadOnly];
              InternalCalcField := True
            end
            else
              InternalCalcField := False;
            if ((not InternalCalcField) and
                 Query.Current.ByName('RDB$DEFAULT_VALUE').IsNull and {do not localize}
                 (Query.Current.ByName('RDB$NULL_FLAG').AsInteger = 1) )then begin {do not localize}
              Attributes := [faRequired];
              Required := True;
            end;
          end;
      end;
      FieldDefs.EndUpdate;
    finally
      Query.free;
      Database.InternalTransaction.Commit;
    end;
  end;
end;

{ Index / Ranges / Keys }

procedure TIBTable.AddIndex(const Name, Fields: string; Options: TIndexOptions;
  const DescFields: string);
var
  Query: TIBSQL;
  FieldList: string;
begin
  FieldDefs.Update;
  if Active then begin
    CheckBrowseMode;
    CursorPosChanged;
  end;
  Query := TIBSQL.Create(self);
  try
    Query.Database := DataBase;
    Query.Transaction := Transaction;
    FieldList := FormatFieldsList(Fields);
    if (ixPrimary in Options) then
    begin
     Query.SQL.Text := 'Alter Table ' + {do not localize}
       FormatIdentifier(Database.SQLDialect, FTableName) +
       ' Add CONSTRAINT ' +   {do not localize}
       FormatIdentifier(Database.SQLDialect, Name)
       + ' Primary Key (' + {do not localize}
       FormatFieldsList(Fields) +
       ')';
    end
    else if ([ixUnique, ixDescending] * Options = [ixUnique, ixDescending]) then
      Query.SQL.Text := 'Create unique Descending Index ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')'
    else if (ixUnique in Options) then
      Query.SQL.Text := 'Create unique Index ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')'
    else if (ixDescending in Options) then
      Query.SQL.Text := 'Create Descending Index ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')'
    else
      Query.SQL.Text := 'Create Index ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        FormatIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')';
    Query.Prepare;
    Query.ExecQuery;
    IndexDefs.Updated := False;
  finally
    Query.free
  end;
end;

procedure TIBTable.DeleteIndex(const Name: string);
var
  Query: TIBSQL;

  procedure DeleteByIndex;
  begin
    Query := TIBSQL.Create(self);
    try
      Query.Database := DataBase;
      Query.Transaction := Transaction;
      Query.SQL.Text := 'Drop index ' +  {do not localize}
                         FormatIdentifier(Database.SQLDialect, Name);
      Query.Prepare;
      Query.ExecQuery;
      IndexDefs.Updated := False;
    finally
      Query.Free;
    end;
  end;

  function DeleteByConstraint: Boolean;
  begin
    Result := False;
    Query := TIBSQL.Create(self);
    try
      Query.Database := DataBase;
      Query.Transaction := Transaction;
      Query.SQL.Text := 'Select ''foo'' from RDB$RELATION_CONSTRAINTS ' +
        'where RDB$RELATION_NAME = ' +
        '''' +
        FormatIdentifierValue(Database.SQLDialect, FTableName) +
        ''' ' +
        ' AND RDB$CONSTRAINT_NAME = ' +
        '''' +
        FormatIdentifierValue(Database.SQLDialect, Name) +
        ''' ' +
        'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';
      Query.Prepare;
      Query.ExecQuery;
      if not Query.EOF then
      begin
        Query.Close;
        Query.SQL.Text := 'Alter Table ' +  {do not localize}
          FormatIdentifier(Database.SQLDialect, FTableName) +
          ' Drop Constraint ' +
          FormatIdentifier(Database.SQLDialect, Name);
        Query.Prepare;
        Query.ExecQuery;
        IndexDefs.Updated := False;
        Result := True;
      end;
    finally
      Query.Free;
    end;
  end;

  procedure DeleteByKey;
  begin
    Query := TIBSQL.Create(self);
    try
      Query.Database := DataBase;
      Query.Transaction := Transaction;
      Query.SQL.Text := 'Select RDB$CONSTRAINT_NAME from RDB$RELATION_CONSTRAINTS ' +
        'where RDB$RELATION_NAME = ' +
        '''' +
        FormatIdentifierValue(Database.SQLDialect, FTableName) +
        ''' ' +
        'AND RDB$INDEX_NAME = ' +
        '''' +
        FormatIdentifierValue(Database.SQLDialect, Name) +
        ''' ' +
        'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';
      Query.Prepare;
      Query.ExecQuery;
      if not Query.EOF then
      begin
        Query.Close;
        Query.SQL.Text := 'Alter Table ' +  {do not localize}
          FormatIdentifier(Database.SQLDialect, FTableName) +
          ' Drop Constraint ' +
          FormatIdentifier(Database.SQLDialect, Query.Current.ByName('RDB$CONSTRAINT_NAME').AsString);
        Query.Prepare;
        Query.ExecQuery;
        IndexDefs.Updated := False;
      end;
    finally
      Query.Free;
    end;
  end;

begin
  if Active then
    CheckBrowseMode;
  IndexDefs.Update;
  if (Pos('RDB$PRIMARY', Name) <> 0 ) then {do not localize} {mbcs ok}
    DeleteByKey
  else if not DeleteByConstraint then
    DeleteByIndex;
end;

function TIBTable.GetIndexFieldNames: string;
begin
  if FFieldsIndex then Result := FIndexName else Result := '';
end;

function TIBTable.GetIndexName: string;
begin
  if FFieldsIndex then Result := '' else Result := FIndexName;
end;

procedure TIBTable.GetIndexNames(List: TStrings);
begin
  IndexDefs.Update;
  IndexDefs.GetItemNames(List);
end;

procedure TIBTable.GetIndexParams(const IndexName: string;
  FieldsIndex: Boolean; var IndexedName: string);
var
  IndexStr: TIndexName;
begin
  if IndexName <> '' then
  begin
    IndexDefs.Update;
    IndexStr := IndexName;
    if FieldsIndex then
      IndexStr := IndexDefs.FindIndexForFields(IndexName).Name;
  end;
  IndexedName := IndexStr;
end;

procedure TIBTable.SetIndexDefs(Value: TIndexDefs);
begin
  IndexDefs.Assign(Value);
end;

procedure TIBTable.SetIndex(const Value: string; FieldsIndex: Boolean);
begin
  if Active then CheckBrowseMode;
  if (FIndexName <> Value) or (FFieldsIndex <> FieldsIndex) then
  begin
    FIndexName := Value;
    FFieldsIndex := FieldsIndex;
    if Active then
    begin
      SwitchToIndex;
    end;
  end;
end;

procedure TIBTable.SetIndexFieldNames(const Value: string);
begin
  SetIndex(Value, Value <> '');
end;

procedure TIBTable.SetIndexName(const Value: string);
begin
  SetIndex(Value, False);
end;

procedure TIBTable.UpdateIndexDefs;
var
  Opts: TIndexOptions;
  Flds: string;
  Query, SubQuery: TIBSQL;
begin
  if not (csReading in ComponentState) then begin
  if not Active and not FSwitchingIndex  then
    FieldDefs.Update;
  IndexDefs.Clear;
  Database.InternalTransaction.StartTransaction;
  Query := TIBSQL.Create(self);
  try
    FPrimaryIndexFields := '';
    Query.GoToFirstRecordOnExecute := False;
    Query.Database := DataBase;
    Query.Transaction := Database.InternalTransaction;
    Query.SQL.Text :=
    'Select I.RDB$INDEX_NAME, I.RDB$UNIQUE_FLAG, I.RDB$INDEX_TYPE, ' + {do not localize}
    'I.RDB$SEGMENT_COUNT, S.RDB$FIELD_NAME from RDB$INDICES I, ' + {do not localize}
    'RDB$INDEX_SEGMENTS S where I.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+ {do not localize}
    'and I.RDB$RELATION_NAME = ' + '''' + {do not localize}
     FormatIdentifierValue(Database.SQLDialect, FTableName) + '''';
    Query.Prepare;
    Query.ExecQuery;
    while (not Query.EOF) and (Query.Next <> nil) do
    begin
      with IndexDefs.AddIndexDef do
      begin
        Name := TrimRight(Query.Current.ByName('RDB$INDEX_NAME').AsString); {do not localize}
        Opts := [];
        if Pos ('RDB$PRIMARY', Name) = 1 then Include(Opts, ixPrimary); {do not localize} {mbcs ok}
        if Query.Current.ByName('RDB$UNIQUE_FLAG').AsInteger = 1 then Include(Opts, ixUnique); {do not localize}
        if Query.Current.ByName('RDB$INDEX_TYPE').AsInteger = 2  then Include(Opts, ixDescending); {do not localize}
        Options := Opts;
        if (Query.Current.ByName('RDB$SEGMENT_COUNT').AsInteger = 1) then {do not localize}
          Fields := Trim(Query.Current.ByName('RDB$FIELD_NAME').AsString) {do not localize}
        else begin
          SubQuery := TIBSQL.Create(self);
        try
          SubQuery.GoToFirstRecordOnExecute := False;
          SubQuery.Database := DataBase;
          SubQuery.Transaction := Database.InternalTransaction;
          SubQuery.SQL.Text :=
         'Select RDB$FIELD_NAME from RDB$INDEX_SEGMENTS where RDB$INDEX_NAME = ' + {do not localize}
          '''' +
          FormatIdentifierValue(Database.SQLDialect, Name) +
          '''' + 'ORDER BY RDB$FIELD_POSITION'; {do not localize}
          SubQuery.Prepare;
          SubQuery.ExecQuery;
          Flds := '';
          while (not SubQuery.EOF) and (SubQuery.Next <> nil) do
          begin
            if (Flds = '') then
              Flds := TrimRight(SubQuery.Current.ByName('RDB$FIELD_NAME').AsString) {do not localize}
            else begin
              Query.Next;
              Flds := Flds + ';' + TrimRight(SubQuery.Current[0].AsString);
            end;
          end;
          Fields := Flds;
        finally
          SubQuery.Free;
        end;
        end;
        if (ixDescending in Opts) then
          DescFields := Fields;
        if ixPrimary in Opts then
          FPrimaryIndexFields := Fields;
      end;
    end;
  finally
    Query.Free;
    Database.InternalTransaction.Commit;
  end;
  end;
end;

function TIBTable.GetExists: Boolean;
var
  Query: TIBSQL;
begin
  Result := Active;
  if Result or (TableName = '') then Exit;
  Database.InternalTransaction.StartTransaction;
  Query := TIBSQL.Create(self);
  try
    Query.Database := DataBase;
    Query.Transaction := Database.InternalTransaction;
    Query.SQL.Text :=
    'Select USER from RDB$RELATIONS where RDB$RELATION_NAME = ' + {do not localize}
    '''' +
    FormatIdentifierValue(Database.SQLDialect, FTableName) + '''';
    Query.Prepare;
    Query.ExecQuery;
    Result := not Query.EOF;
  finally
    Query.Free;
    Database.InternalTransaction.Commit;
  end;
end;

procedure TIBTable.GotoCurrent(Table: TIBTable);
begin
  CheckBrowseMode;
  Table.CheckBrowseMode;
  if (Database <> Table.Database) or
    (CompareText(TableName, Table.TableName) <> 0) then
    IBError(ibxeTableNameMismatch, [nil]);
  Table.UpdateCursorPos;
  InternalGotoDBKey(Table.CurrentDBKey);
  DoBeforeScroll;
  Resync([rmExact, rmCenter]);
  DoAfterScroll;
end;


procedure TIBTable.CreateTable;
var
  FieldList: string;

  procedure InitFieldsList;
  var
    I: Integer;
  begin
    InitFieldDefsFromFields;
    for I := 0 to FieldDefs.Count - 1 do begin
      if ( I > 0) then
        FieldList := FieldList + ', ';
      with FieldDefs[I] do
      begin
        case DataType of
          ftString:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' VARCHAR(' + IntToStr(Size) + ')'; {do not localize}
          ftFixedChar:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' CHAR(' + IntToStr(Size) + ')'; {do not localize}
          ftBoolean, ftSmallint, ftWord:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' SMALLINT'; {do not localize}
          ftInteger:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' INTEGER'; {do not localize}
          ftFloat, ftCurrency:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' DOUBLE PRECISION'; {do not localize}
          ftBCD: begin
            if (Database.SQLDialect = 1) then begin
              if (Precision > 9) then
                IBError(ibxeFieldUnsupportedType,[nil]);
              if (Precision <= 4) then
                Precision := 9;
            end;
            if (Precision <= 4 ) then
              FieldList := FieldList +
                FormatIdentifier(Database.SQLDialect, Name) +
                ' Numeric(18, 4)' {do not localize}
            else
              FieldList := FieldList +
                FormatIdentifier(Database.SQLDialect, Name) +
                ' Numeric(' + IntToStr(Precision) + ', 4)'; {do not localize}
          end;
          ftDate:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' DATE'; {do not localize}
          ftTime:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' TIME'; {do not localize}
          ftDateTime:
            if (Database.SQLDialect = 1) then
              FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' DATE' {do not localize}
            else
              FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' TIMESTAMP'; {do not localize}
          ftLargeInt:
            if (Database.SQLDialect = 1) then
              IBError(ibxeFieldUnsupportedType,[nil])
            else
              FieldList := FieldList +
                FormatIdentifier(Database.SQLDialect, Name) +
                ' Numeric(18, 0)'; {do not localize}
          ftBlob, ftMemo:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' BLOB SUB_TYPE 1'; {do not localize}
          ftBytes, ftVarBytes, ftGraphic..ftTypedBinary:
            FieldList := FieldList +
              FormatIdentifier(Database.SQLDialect, Name) +
              ' BLOB SUB_TYPE 0'; {do not localize}
          ftUnknown, ftADT, ftArray, ftReference, ftDataSet,
          ftCursor, ftWideString, ftAutoInc:
            IBError(ibxeFieldUnsupportedType,[nil]);
          else
            IBError(ibxeFieldUnsupportedType,[nil]);
        end;
        if faRequired in Attributes then
          FieldList := FieldList + ' NOT NULL'; {do not localize}
      end;
    end;
  end;

  procedure InternalCreateTable;
  var
    I: Integer;
    Query: TIBSQL;
  begin
    if (FieldList = '') then
      IBError(ibxeFieldUnsupportedType,[nil]);
    Query := TIBSQL.Create(self);
    try
      Query.Database := Database;
      Query.transaction := Transaction;
      Query.SQL.Text := 'Create Table ' +
        FormatIdentifier(Database.SQLDialect, FTableName) +
        ' (' + FieldList; {do not localize}
      for I := 0 to IndexDefs.Count - 1 do
      with IndexDefs[I] do
        if ixPrimary in Options then
        begin
          Query.SQL.Text := Query.SQL.Text + ', CONSTRAINT ' +
            FormatIdentifier(Database.SQLDialect, Name) +
            ' Primary Key (' +
            FormatFieldsList(Fields) +
            ')';
        end;
      Query.SQL.Text := Query.SQL.Text + ')';
      Query.Prepare;
      Query.ExecQuery;
    finally
      Query.Free;
    end;
  end;

  procedure InternalCreateIndex;
  var
    I: Integer;
  begin
    for I := 0 to IndexDefs.Count - 1 do
    with IndexDefs[I] do
      if not (ixPrimary in Options) then
        AddIndex(Name, Fields, Options);
  end;

begin
  CheckInactive;
  InitFieldsList;
  InternalCreateTable;
  InternalCreateIndex;
end;

procedure TIBTable.DeleteTable;
var
  Query: TIBSQL;
begin
  CheckInactive;
  Query := TIBSQL.Create(self);
  try
    Query.Database := DataBase;
    Query.Transaction := Transaction;
    Query.SQL.Text := 'drop table ' +  {do not localize}
      FormatIdentifier(Database.SQLDialect, FTableName);
    Query.Prepare;
    Query.ExecQuery;
  finally
    Query.Free;
  end;
end;

procedure TIBTable.EmptyTable;
var
  Query: TIBSQL;
begin
  if Active then
    CheckBrowseMode;
  Query := TIBSQL.Create(self);
  try
    Query.Database := DataBase;
    Query.Transaction := Transaction;
    Query.SQL.Text := 'delete from ' + {do not localize}
      FormatIdentifier(Database.SQLDialect, FTableName);
    Query.Prepare;
    Query.ExecQuery;
    if Active then
    begin
      ClearBuffers;
      DataEvent(deDataSetChange, 0);
    end;
  finally
    Query.Free;
  end;
end;

procedure TIBTable.DataEvent(Event: TDataEvent; Info: Longint);
begin
  if Event = dePropertyChange then begin
    IndexDefs.Updated := False;
    FRegenerateSQL := True;
  end;
  inherited DataEvent(Event, Info);
end;

{ Informational & Property }

function TIBTable.GetCanModify: Boolean;
begin
  Result := True;
  if (FTableName = '') or FReadOnly
    or FSystemTable or FMultiTableView then
    Result := False;
end;

function TIBTable.InternalGetUpdatable: Boolean;
var
  Query : TIBSQL;
begin
  Database.InternalTransaction.StartTransaction;
  Query := TIBSQL.Create(self);
  try
    Query.Database := DataBase;
    Query.Transaction := Database.InternalTransaction;
    Query.SQL.Text := 'Select RDB$SYSTEM_FLAG, RDB$DBKEY_LENGTH ' + {do not localize}
                    'from RDB$RELATIONS where RDB$RELATION_NAME = ' + {do not localize}
                    '''' +
                    FormatIdentifierValue(Database.SQLDialect, FTableName) + '''';
    Query.Prepare;
    Query.ExecQuery;
    if (Query.Current[0].AsInteger <> 0) or
       (Query.Current[1].AsInteger <> 8) then
      Result := False
    else
      Result := True;
  finally
    Query.Free;
    Database.InternalTransaction.Commit;
  end;
end;

function TIBTable.FieldDefsStored: Boolean;
begin
  Result := StoreDefs and (FieldDefs.Count > 0);
end;

function TIBTable.IndexDefsStored: Boolean;
begin
  Result := StoreDefs and (IndexDefs.Count > 0);
end;

procedure TIBTable.SetParams;
var
  i: Integer;
begin
  if (MasterSource = nil) or (MasterSource.DataSet = nil) or
  (not MasterSource.DataSet.Active) or (FMasterFieldsList.Count = 0) then
    exit;
  for i := 0 to FMasterFieldsList.Count - 1 do
    QSelect.Params.ByName(FMasterFieldsList.Strings[i]).Value :=
    MasterSource.DataSet.FieldByName(FMasterFieldsList.Strings[i]).Value;
end;

procedure TIBTable.MasterChanged(Sender: TObject);
begin
  CheckBrowseMode;
  SetParams;
  ReQuery;
end;

procedure TIBTable.MasterDisabled(Sender: TObject);
begin
  DataEvent(dePropertyChange, 0);
  ReQuery;
end;

function TIBTable.GetDataSource: TDataSource;
begin
  Result := FMasterLink.DataSource;
end;

procedure TIBTable.SetDataSource(Value: TDataSource);
begin
  if IsLinkedTo(Value) then IBError(ibxeCircularDataLink, [Self]);
  if FMasterLink.DataSource <> Value then
    DataEvent(dePropertyChange, 0);
  FMasterLink.DataSource := Value;
end;

function TIBTable.GetMasterFields: string;
begin
  Result := FMasterLink.FieldNames;
end;

procedure TIBTable.SetMasterFields(const Value: string);
begin
  if FMasterLink.FieldNames <> Value then
    DataEvent(dePropertyChange, 0);
  FMasterLink.FieldNames := Value;
end;

procedure TIBTable.DoOnNewRecord;
var
  I: Integer;
begin
  if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
    for I := 0 to FMasterLink.Fields.Count - 1 do
      IndexFields[I] := TField(FMasterLink.Fields[I]);
  inherited DoOnNewRecord;
end;

function TIBTable.FormatFieldsList(Value: String): String;
var
  FieldName: string;
  i: Integer;
begin
  if Database.SQLDialect = 1 then begin
    Value := FormatIdentifier(Database.SQLDialect, Value);
    Result := StringReplace (Value, ';', ', ', [rfReplaceAll]);
  end
  else begin
    i := 1;
    Result := '';
    while i <= Length(Value) do
    begin
      FieldName := ExtractFieldName(Value, i);
      if Result = '' then
        Result := FormatIdentifier(Database.SQLDialect, FieldName)
      else
        Result := Result + ', ' + FormatIdentifier(Database.SQLDialect, FieldName);
    end;
  end;
end;

procedure TIBTable.ExtractLinkFields;
var
  i: Integer;
  DetailFieldNames: String;
begin
  FMasterFieldsList.Clear;
  FDetailFieldsList.Clear;
  i := 1;
  while i <= Length(MasterFields) do
    FMasterFieldsList.Add(ExtractFieldName(MasterFields, i));
  i := 1;
  if IndexFieldNames = '' then
    DetailFieldNames := FPrimaryIndexFields
  else
    DetailFieldNames := IndexFieldNames;
  while i <= Length(DetailFieldNames) do
    FDetailFieldsList.Add(ExtractFieldName(DetailFieldNames, i));
end;

procedure TIBTable.GetDetailLinkFields(MasterFields, DetailFields: TList);
var
  i: Integer;
  Idx: TIndexDef;
begin
  MasterFields.Clear;
  DetailFields.Clear;
  if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and
     (Self.MasterFields <> '') then
  begin
    Idx := nil;
    MasterSource.DataSet.GetFieldList(MasterFields, Self.MasterFields);
    UpdateIndexDefs;
    if IndexName <> '' then
      Idx := IndexDefs.Find(IndexName)
    else if IndexFieldNames <> '' then
      Idx := IndexDefs.GetIndexForFields(IndexFieldNames, False)
    else
      for i := 0 to IndexDefs.Count - 1 do
        if ixPrimary in IndexDefs[i].Options then
        begin
          Idx := IndexDefs[i];
          break;
        end;
    if Idx <> nil then
      GetFieldList(DetailFields, Idx.Fields);
  end;
end;

procedure TIBTable.SetReadOnly(Value: Boolean);
begin
  CheckInactive;
  FReadOnly := Value;
end;

procedure TIBTable.SetTableName(Value: String);
begin
  if not (csReading in ComponentState) then
  begin
    CheckInactive;
    if Value <> FTableName then
    begin
      ResetSQLStatements;
      FRegenerateSQL := True;
      FTableName := Value;
      IndexName := '';
      IndexFieldNames := '';
      FPrimaryIndexFields := '';
      DataEvent(dePropertyChange, 0);
    end;
  end
  else if Value <> FTableName then
    FTableName := Value;
end;

function TIBTable.GetIndexField(Index: Integer): TField;
var
  I, Count: Integer;
  FieldNames, FieldName: String;
begin
  Result := nil;
  FieldName := '';
  FieldNames := IndexFieldNames;
  if FieldNames = '' then
  begin
    for I := 0 to IndexDefs.Count - 1 do
      if (IndexDefs[i].Name = FIndexName) then
      begin
        FieldNames := IndexDefs[i].Fields;
        break;
      end;
  end;
  for I := 0 to Index do
  begin
    Count := Pos(';', FieldNames); {mbcs OK}
    if Count = 0 then
      FieldName := FieldNames
    else begin
      FieldName := Copy(FieldNames, 0, Count - 1);
      System.Delete(FieldNames, 1, Count);
    end;
  end;
  if FieldName <> '' then
    Result := FieldByName(FieldName)
  else
    IBError(ibxeIndexFieldMissing, [nil]);
end;


procedure TIBTable.SetIndexField(Index: Integer; Value: TField);
begin
  GetIndexField(Index).Assign(Value);
end;

function TIBTable.GetIndexFieldCount: Integer;
var
  I, Index: Integer;
  FieldNames: String;
  done: Boolean;
begin
  FieldNames := IndexFieldNames;
  if FieldNames = '' then
  begin
    for I := 0 to IndexDefs.Count - 1 do
      if (IndexDefs[i].Name = FIndexName) then
      begin
        FieldNames := IndexDefs[i].Fields;
        break;
      end;
  end;
  if FieldNames = '' then
    Result := 0
  else
  begin
    done := False;
    Result := 1;
    while not done do
    begin
      Index := Pos(';', FieldNames); {mbcs ok}
      if Index <> 0 then
      begin
        System.Delete(FieldNames, 1, Index);
        Inc(Result);
      end else
        done := True;
    end;
  end;
end;

function TIBTable.GetTableNames: TStrings;
begin
  FNameList.clear;
  GetTableNamesFromServer;
  Result := FNameList;
end;

procedure TIBTable.GetTableNamesFromServer;
var
  Query : TIBSQL;
begin
  if not (csReading in ComponentState) then begin
    ActivateConnection;
    Database.InternalTransaction.StartTransaction;
    Query := TIBSQL.Create(self);
    try
      Query.GoToFirstRecordOnExecute := False;
      Query.Database := DataBase;
      Query.Transaction := Database.InternalTransaction;
      if (TableTypes * [ttSystem, ttView] = [ttSystem, ttView]) then
        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' {do not localize}
      else if ttSystem in TableTypes then
        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
                          ' where RDB$VIEW_BLR is NULL' {do not localize}
      else if ttView in TableTypes then
        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
                          ' where RDB$SYSTEM_FLAG = 0' {do not localize}
      else
        Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
                          ' where RDB$VIEW_BLR is NULL and RDB$SYSTEM_FLAG = 0'; {do not localize}
      Query.Prepare;
      Query.ExecQuery;
      while (not Query.EOF) and (Query.Next <> nil) do
        FNameList.Add (TrimRight(Query.Current[0].AsString));
    finally
      Query.Free;
      Database.InternalTransaction.Commit;
    end;
  end;
end;

procedure TIBTable.SwitchToIndex();
begin
  FSwitchingIndex := True;
  InternalTableRefresh;
  FSwitchingIndex := False;
end;

procedure TIBTable.InternalTableRefresh();
var
  DBKey: TIBDBKey;
begin
  CheckActive;
  DBKey := CurrentDBKey;
  FRegenerateSQL := True;
  Reopen;
  if DBKey.DBKey[0] <> 0 then
    InternalGotoDBKey(DBKey);
end;

procedure TIBTable.GenerateSQL;
var
  i: Integer;
  SQL: TStrings;
  OrderByStr: string;
  bWhereClausePresent: Boolean;
begin
  bWhereClausePresent := False;
  Database.CheckActive;
  Transaction.CheckInTransaction;
  if IndexDefs.Updated = False then
    IndexDefs.Update;
  if IndexFieldNames <> '' then
    OrderByStr := FormatFieldsList(IndexFieldNames)
  else if IndexName <> '' then
    OrderByStr := FormatFieldsList(IndexDefs[IndexDefs.Indexof (IndexName)].Fields)
  else if FDefaultIndex and (FPrimaryIndexFields <> '') then
    OrderByStr := FormatFieldsList(FPrimaryIndexFields);
  SQL := TStringList.Create;
  SQL.Text := 'select ' + {do not localize}
    FormatIdentifier(Database.SQLDialect, FTableName) + '.*, '
    + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
    + FormatIdentifier(Database.SQLDialect, FTableName);
  if Filtered and (Filter <> '') then
  begin
    SQL.Text := SQL.Text + ' where ' + Filter; {do not localize}
    bWhereClausePresent := True;
  end;
  if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and (MasterFields <> '') then
  begin
    if bWhereClausePresent then
      SQL.Text := SQL.Text + ' AND ' {do not localize}
    else
      SQL.Text := SQL.Text + ' WHERE '; {do not localize}
    ExtractLinkfields;
    if FDetailFieldsList.Count < FMasterFieldsList.Count then
      IBError(ibxeUnknownError, [nil]);
    for i := 0 to FMasterFieldsList.Count - 1 do
    begin
      if i > 0 then
        SQL.Text := SQL.Text + 'AND ';
      SQL.Text := SQL.Text +
        FormatIdentifier(Database.SQLDialect, FDetailFieldsList.Strings[i]) +
        ' = :' +
        FormatIdentifier(Database.SQLDialect, FMasterFieldsList.Strings[i]);
    end;
  end;
  if OrderByStr <> '' then
    SQL.Text := SQL.Text + ' order by ' + OrderByStr; {do not localize}
  SelectSQL.Assign(SQL);
  RefreshSQL.Text := 'select ' + {do not localize}
    FormatIdentifier(Database.SQLDialect, FTableName) + '.*, '
    + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
    + FormatIdentifier(Database.SQLDialect, FTableName) +
    ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY'; {do not localize}
  WhereDBKeyRefreshSQL.Assign(RefreshSQL);
  InternalPrepare;
  SQL.Free;
end;

procedure TIBTable.GenerateUpdateSQL;
var
  InsertFieldList, InsertParamList, UpdateFieldList: string;
  WherePrimaryFieldList, WhereAllFieldList: string;

  procedure GenerateFieldLists;
  var
    I: Integer;
  begin
    for I := 0 to FieldDefs.Count - 1 do begin
      with FieldDefs[I] do begin
        if not (InternalCalcField or (faReadOnly in Attributes) or
          (DataType = ftUnknown)) then
        begin
          if ( InsertFieldList <> '' ) then begin
            InsertFieldList := InsertFieldList + ', ';
            InsertParamList := InsertParamList + ', ';
            UpdateFieldList := UpdateFieldList + ', ';
            if (DataType <> ftBlob) and (DataType <>ftMemo) then
              WhereAllFieldList := WhereAllFieldList + ' AND ';
          end;
          InsertFieldList := InsertFieldList +
            FormatIdentifier(Database.SQLDialect, Name);
          InsertParamList := InsertParamList + ':' +
            FormatIdentifier(Database.SQLDialect, Name);
          UpdateFieldList := UpdateFieldList +
            FormatIdentifier(Database.SQLDialect, Name) +
            ' = :' +
            FormatIdentifier(Database.SQLDialect, Name);
          if (DataType <> ftBlob) and (DataType <>ftMemo) then
            WhereAllFieldList := WhereAllFieldList +
              FormatIdentifier(Database.SQLDialect, Name) + ' = :' +
              FormatIdentifier(Database.SQLDialect, Name);{do not localize}
        end;
      end;
    end;
  end;

  procedure GenerateWherePrimaryFieldList;
  var
    i: Integer;
    tmp: String;
  begin
    i := 1;
    while i <= Length(FPrimaryIndexFields) do
    begin
      tmp := ExtractFieldName(FPrimaryIndexFields, i);
      tmp :=
        FormatIdentifier(Database.SQLDialect, tmp) +  ' = :' +
        FormatIdentifier(Database.SQLDialect, tmp);{do not localize}
      if WherePrimaryFieldList <> '' then
        WherePrimaryFieldList :=
          WherePrimaryFieldList + ' AND ' + tmp
      else
        WherePrimaryFieldList := tmp;
    end;
  end;

begin
  if InternalGetUpdatable = False  then
    FReadOnly := True
  else begin
    DeleteSQL.Text := 'delete from ' + {do not localize}
      FormatIdentifier(Database.SQLDialect, FTableName) +
      ' where RDB$DB_KEY = ' + ':IBX_INTERNAL_DBKEY'; {do not localize}
    GenerateFieldLists;
    InsertSQL.Text := 'insert into ' + {do not localize}
      FormatIdentifier(Database.SQLDialect, FTableName) +
    ' (' + InsertFieldList + {do not localize}
      ') values (' + InsertParamList + ')'; {do not localize}
    ModifySQL.Text := 'update ' +
      FormatIdentifier(Database.SQLDialect, FTableName) +
      ' set ' + UpdateFieldList + {do not localize}
      ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY'; {do not localize}
    WhereAllRefreshSQL.Text := 'select ' +  {do not localize}
      FormatIdentifier(Database.SQLDialect, FTableName) + '.*, '
      + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
      + FormatIdentifier(Database.SQLDialect, FTableName) +
      ' where ' + WhereAllFieldList; {do not localize}
    if FPrimaryIndexFields <> '' then
    begin
      GenerateWherePrimaryFieldList;
      WherePrimaryRefreshSQL.Text := 'select ' + {do not localize}
        FormatIdentifier(Database.SQLDialect, FTableName) + '.*, ' {do not localize}
        + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
        + FormatIdentifier(Database.SQLDialect, FTableName) +
        ' where ' + WherePrimaryFieldList; {do not localize}
    end;
    try
      InternalPrepare;
    except
      FReadonly := True;
    end;
  end;
end;

procedure TIBTable.ResetSQLStatements;
begin
  SelectSQL.Text := '';
  DeleteSQL.Text := '';
  InsertSQL.Text := '';
  ModifySQL.Text := '';
  RefreshSQL.Text := '';
end;

procedure TIBTable.SetTableTypes(
  const Value: TIBTableTypes);
begin
  FTableTypes := Value;
end;

function TIBTable.InternalGotoDBKey(DBKey: TIBDBKey): Boolean;

  function DBKeyCompare (DBKey1, DBKey2: TIBDBKey): Boolean;
  var
  I: Integer;
  begin
    for I := 0 to 7 do
      if (DBKey1.DBKey[i] <> DBKey2.DBKey[i]) then begin
        result := False;
        exit;
      end;
    result := True;
  end;
begin
  CheckActive;
  DisableControls;
 try
    result := False;
    First;
    while ((not result) and (not EOF)) do begin
      if (DBKeyCompare (DBKey, PRecordData(GetActiveBuf)^.rdDBKey)) then
        result := True
      else
        Next;
    end;
    if not result then
      First
    else
      CursorPosChanged;
  finally
    EnableControls;
  end;
end;

function TIBTable.GetCurrentDBKey: TIBDBKey;
var
  Buf: pChar;
begin
  CheckActive;
  buf := GetActiveBuf;
  if Buf <> nil then
    Result := PRecordData(Buf)^.rdDBKey
  else
    Result.DBKey[0] := 0;
end;

procedure TIBTable.Reopen;
begin
  DisableControls;
  try
    if Active then
    begin
      SetState(dsInactive);
      CloseCursor;
      OpenCursor;
      SetState(dsBrowse);
    end;
  finally
    EnableControls;
  end;
end;

{ TIBTable IProviderSupport }

function TIBTable.PSGetDefaultOrder: TIndexDef;

  function GetIdx(IdxType: TIndexOption): TIndexDef;
  var
    i: Integer;
  begin
    Result := nil;
    for i := 0 to IndexDefs.Count - 1 do
      if IdxType in IndexDefs[i].Options then
      try
        Result := IndexDefs[i];
        GetFieldList(nil, Result.Fields);
        break;
      except
        Result := nil;
      end;
  end;

var
  DefIdx: TIndexDef;
begin
  DefIdx := nil;
  IndexDefs.Update;
  try
    if IndexName <> '' then
      DefIdx := IndexDefs.Find(IndexName)
    else if IndexFieldNames <> '' then
      DefIdx := IndexDefs.FindIndexForFields(IndexFieldNames);
    if Assigned(DefIdx) then
      GetFieldList(nil, DefIdx.Fields);
  except
    DefIdx := nil;
  end;
  if not Assigned(DefIdx) then
    DefIdx := GetIdx(ixPrimary);
  if not Assigned(DefIdx) then
    DefIdx := GetIdx(ixUnique);
  if Assigned(DefIdx) then
  begin
    Result := TIndexDef.Create(nil);
    Result.Assign(DefIdx);
  end else
    Result := nil;
end;

function TIBTable.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs;
begin
  Result := GetIndexDefs(IndexDefs, IndexTypes);
end;

function TIBTable.PSGeTTableName: string;
begin
  Result := FTableName;
end;

procedure TIBTable.PSSetParams(AParams: TParams);
begin
  if AParams.Count > 0 then
    Open;
  PSReset;
end;

procedure TIBTable.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then
    TableName := CommandText;
end;

function TIBTable.PSGetKeyFields: string;
var
  i, Idx: Integer;
  IndexFound: Boolean;
begin
  Result := inherited PSGetKeyFields;
  if Result = '' then
  begin
    if not Exists then Exit;
    IndexFound := False;
    IndexDefs.Update;
    FieldDefs.Update;
    for i := 0 to IndexDefs.Count - 1 do
      if ixUnique in IndexDefs[I].Options then
      begin
        Idx := 1;
        Result := IndexDefs[I].Fields;
        IndexFound := False;
        while Idx <= Length(Result) do
        begin
          IndexFound := FindField(ExtractFieldName(Result, Idx)) <> nil;
          if not IndexFound then Break;
        end;
        if IndexFound then Break;
      end;
    if not IndexFound then
      Result := '';
  end;
end;

end.