ibtable.pas

这是不可多得的源代码

    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}
       QuoteIdentifier(Database.SQLDialect, FTableName) +
       ' Add CONSTRAINT ' +   {do not localize}
       QuoteIdentifier(Database.SQLDialect, Name)
       + ' Primary Key (' + {do not localize}
       FormatFieldsList(Fields) +
       ')';   {do not localize}
    end
    else if ([ixUnique, ixDescending] * Options = [ixUnique, ixDescending]) then
      Query.SQL.Text := 'Create unique Descending Index ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')' {do not localize}
    else if (ixUnique in Options) then
      Query.SQL.Text := 'Create unique Index ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')' {do not localize}
    else if (ixDescending in Options) then
      Query.SQL.Text := 'Create Descending Index ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')'  {do not localize}
    else
      Query.SQL.Text := 'Create Index ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, Name) +
                        ' on ' + {do not localize}
                        QuoteIdentifier(Database.SQLDialect, FTableName) +
                        ' (' + FieldList + ')'; {do not localize}
    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}
                         QuoteIdentifier(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 ' +  {do not localize}
        'where RDB$RELATION_NAME = ' +   {do not localize}
        '''' +  {do not localize}
        FormatIdentifierValue(Database.SQLDialect,
          QuoteIdentifier(DataBase.SQLDialect, FTableName)) +
        ''' ' +      {do not localize}
        ' AND RDB$CONSTRAINT_NAME = ' +  {do not localize}
        '''' +     {do not localize}
        FormatIdentifierValue(Database.SQLDialect,
          QuoteIdentifier(DataBase.SQLDialect, Name)) +
        ''' ' +    {do not localize}
        'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';   {do not localize}
      Query.Prepare;
      Query.ExecQuery;
      if not Query.EOF then
      begin
        Query.Close;
        Query.SQL.Text := 'Alter Table ' +  {do not localize}
          QuoteIdentifier(DataBase.SQLDialect, FTableName) +
          ' Drop Constraint ' +   {do not localize}
          QuoteIdentifier(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 ' +   {do not localize}
        'where RDB$RELATION_NAME = ' +  {do not localize}
        '''' +  {do not localize}
        FormatIdentifierValue(Database.SQLDialect,
          QuoteIdentifier(DataBase.SQLDialect, FTableName)) +
        ''' ' +  {do not localize}
        'AND RDB$INDEX_NAME = ' +  {do not localize}
        '''' +  {do not localize}
        FormatIdentifierValue(Database.SQLDialect,
          QuoteIdentifier(DataBase.SQLDialect, Name)) +
        ''' ' +    {do not localize}
        'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'''; {do not localize}
      Query.Prepare;
      Query.ExecQuery;
      if not Query.EOF then
      begin
        Query.Close;
        Query.SQL.Text := 'Alter Table ' +  {do not localize}
          QuoteIdentifier(DataBase.SQLDialect, FTableName) +
          ' Drop Constraint ' +  {do not localize}
          QuoteIdentifier(DataBase.SQLDialect, Query.Current.ByName('RDB$CONSTRAINT_NAME').AsString); {do not localize}
        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 := '';  {do not localize}
end;

function TIBTable.GetIndexName: string;
begin
  if FFieldsIndex then Result := '' else Result := FIndexName;  {do not localize}
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   {do not localize}
  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 <> '');  {do not localize}
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,
       QuoteIdentifier(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 = 1  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}
          '''' +  {do not localize}
          FormatIdentifierValue(Database.SQLDialect,
            QuoteIdentifier(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}
    '''' +    {do not localize}
    FormatIdentifierValue(Database.SQLDialect,
      QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';  {do not localize}
    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 + ', ';   {do not localize}
      with FieldDefs[I] do
      begin
        case DataType of
          ftString:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' VARCHAR(' + IntToStr(Size) + ')'; {do not localize}
          ftFixedChar:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' CHAR(' + IntToStr(Size) + ')'; {do not localize}
          ftBoolean, ftSmallint, ftWord:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' SMALLINT'; {do not localize}
          ftInteger:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' INTEGER'; {do not localize}
          ftFloat, ftCurrency:
            FieldList := FieldList +
              QuoteIdentifier(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 +
                QuoteIdentifier(DataBase.SQLDialect, Name) +
                ' Numeric(18, 4)' {do not localize}
            else
              FieldList := FieldList +
                QuoteIdentifier(DataBase.SQLDialect, Name) +
                ' Numeric(' + IntToStr(Precision) + ', 4)'; {do not localize}
          end;
          ftDate:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' DATE'; {do not localize}
          ftTime:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' TIME'; {do not localize}
          ftDateTime:
            if (Database.SQLDialect = 1) then
              FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' DATE' {do not localize}
            else
              FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' TIMESTAMP'; {do not localize}
          ftLargeInt:
            if (Database.SQLDialect = 1) then
              IBError(ibxeFieldUnsupportedType,[nil])
            else
              FieldList := FieldList +
                QuoteIdentifier(DataBase.SQLDialect, Name) +
                ' Numeric(18, 0)'; {do not localize}
          ftBlob, ftMemo:
            FieldList := FieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) +
              ' BLOB SUB_TYPE 1'; {do not localize}
          ftBytes, ftVarBytes, ftGraphic..ftTypedBinary:
            FieldList := FieldList +
              QuoteIdentifier(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