ibextract.pas

这是不可多得的源代码

  DidStart := false;

  if not FDatabase.Connected then
  begin
    FDatabase.Connected := true;
    didConnect := true;
  end;

  FMetaData.Add(Format('SET SQL DIALECT %d;', [FDatabase.SQLDialect]));  {do not localize}
  FMetaData.Add('');

  if not FTransaction.Active then
  begin
    FTransaction.StartTransaction;
    DidStart := true;
  end;

  if TableName <> '' then
  begin
    if not ExtractListTable(TableName, '', true) then
      Result := false;
  end
  else
  begin
    ListCreateDb;
    ListFilters;
    ListFunctions;
    ListDomains;
    ListAllTables(flag);
    ListIndex;
    ListForeign;
    ListGenerators;
    ListViews;
    ListCheck;
    ListException;
    ListProcs;
    ListTriggers;
    ListGrants;
  end;

  if DidStart then
    FTransaction.Commit;

  if DidConnect then
    FDatabase.Connected := false;
end;

{                   ExtractListTable
  Functional description
  	Shows columns, types, info for a given table name
  	and text of views.
  	If a new_name is passed, substitute it for relation_name

  	relation_name -- Name of table to investigate
  	new_name -- Name of a new name for a replacement table
  	domain_flag -- extract needed domains before the table }

function TIBExtract.ExtractListTable(RelationName, NewName: String;
  DomainFlag: Boolean) : Boolean;
const
  TableListSQL =
    'SELECT * FROM RDB$RELATIONS REL JOIN RDB$RELATION_FIELDS RFR ON ' + {Do Not Localize}
    '  RFR.RDB$RELATION_NAME = REL.RDB$RELATION_NAME JOIN RDB$FIELDS FLD ON ' +  {do not localize}
    '  RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +  {do not localize}
    'WHERE REL.RDB$RELATION_NAME = :RelationName ' +  {do not localize}
    'ORDER BY RFR.RDB$FIELD_POSITION, RFR.RDB$FIELD_NAME';  {do not localize}

  ConstraintSQL =
    'SELECT RCO.RDB$CONSTRAINT_NAME, RDB$CONSTRAINT_TYPE, RDB$RELATION_NAME, ' +  {do not localize}
    'RDB$DEFERRABLE, RDB$INITIALLY_DEFERRED, RDB$INDEX_NAME, RDB$TRIGGER_NAME ' +   {do not localize}
    'FROM RDB$RELATION_CONSTRAINTS RCO, RDB$CHECK_CONSTRAINTS CON ' + {do not localize}
    'WHERE ' +  {do not localize}
    '  CON.RDB$TRIGGER_NAME = :FIELDNAME AND ' +  {do not localize}
    '  CON.RDB$CONSTRAINT_NAME = RCO.RDB$CONSTRAINT_NAME AND ' +  {do not localize}
    '  RCO.RDB$CONSTRAINT_TYPE = ''NOT NULL'' AND ' +  {do not localize}
    '  RCO.RDB$RELATION_NAME = :RELATIONNAME';   {do not localize}

  RelConstraintsSQL =
    'SELECT * FROM RDB$RELATION_CONSTRAINTS RELC ' +  {do not localize}
    'WHERE ' +   {do not localize}
    '  (RELC.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR ' +  {do not localize}
    '  RELC.RDB$CONSTRAINT_TYPE = ''UNIQUE'') AND ' +  {do not localize}
    '  RELC.RDB$RELATION_NAME = :RELATIONNAME ' +  {do not localize}
    'ORDER BY RELC.RDB$CONSTRAINT_NAME';  {do not localize}

var
  Collation, CharSetId : Short;
	i : Short;
  ColList, Column, Constraint : String;
  SubType : Short;
  IntChar : Short;
  qryTables, qryPrecision, qryConstraints, qryRelConstraints : TIBSQL;
  PrecisionKnown, ValidRelation : Boolean;
  FieldScale, FieldType : Integer;
begin
  Result := true;
  ColList := '';  {do not localize}
  IntChar := 0;
  ValidRelation := false;

  if DomainFlag then
    ListDomains(RelationName);
  qryTables := CreateIBSQL;
  qryPrecision := CreateIBSQL;
  qryConstraints := CreateIBSQL;
  qryRelConstraints := CreateIBSQL;
  try
    qryTables.SQL.Add(TableListSQL);
    qryTables.Params.ByName('RelationName').AsTrimString := RelationName;  {do not localize}
    qryTables.ExecQuery;
    qryPrecision.SQL.Add(PrecisionSQL);
    qryConstraints.SQL.Add(ConstraintSQL);
    qryRelConstraints.SQL.Add(RelConstraintsSQL);
    if not qryTables.Eof then
    begin
      ValidRelation := true;
      if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and  {do not localize}
         (Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsTrimString) <> '') then  {do not localize}
        FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',  {do not localize}
          [NEWLINE, RelationName,
           qryTables.FieldByName('RDB$OWNER_NAME').AsTrimString, NEWLINE]));  {do not localize}
      if NewName <> '' then  {do not localize}
        FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,NewName)])) {do not localize}
      else
        FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));  {do not localize}
      if not qryTables.FieldByName('RDB$EXTERNAL_FILE').IsNull then  {do not localize}
        FMetaData.Add(Format('EXTERNAL FILE %s ', {do not localize}
          [QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsTrimString)])); {do not localize}
      FMetaData.Add('(');
    end;

    while not qryTables.Eof do
    begin
      Column := '  ' + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME').AsTrimString) + TAB; {do not localize}

    {  Check first for computed fields, then domains.
       If this is a known domain, then just print the domain rather than type
       Domains won't have length, array, or blob definitions, but they
       may have not null, default and check overriding their definitions }

      if not qryTables.FieldByName('rdb$computed_blr').IsNull then  {do not localize}
      begin
        Column := Column + ' COMPUTED BY '; {do not localize}
       if not qryTables.FieldByName('RDB$COMPUTED_SOURCE').IsNull then {do not localize}
         Column := Column + PrintValidation(qryTables.FieldByName('RDB$COMPUTED_SOURCE').AsTrimString, true); {do not localize}
      end
      else
      begin
        FieldType := qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger;   {do not localize}
        FieldScale := qryTables.FieldByName('RDB$FIELD_SCALE').AsInteger;  {do not localize}
        if not ((Copy(qryTables.FieldByName('RDB$FIELD_NAME1').AsTrimString, 1, 4) = 'RDB$') and {do not localize}
          (qryTables.FieldByName('RDB$FIELD_NAME1').AsTrimString[5] in ['0'..'9'])) and {do not localize}
          (qryTables.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then   {do not localize}
        begin
          Column := Column + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME1').AsTrimString); {do not localize}
          { International character sets }
          if (qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying])  {do not localize}
              and (not qryTables.FieldByName('RDB$COLLATION_ID').IsNull)  {do not localize}
              and (qryTables.FieldByName('RDB$COLLATION_ID').AsShort <> 0) then {do not localize}
            intchar := 1;
        end
        else
        begin
  	      { Look through types array }
          for i := Low(Columntypes) to High(ColumnTypes) do
          begin
            PrecisionKnown := false;
            if qryTables.FieldByname('RDB$FIELD_TYPE').AsShort = ColumnTypes[i].SQLType then {do not localize}
            begin

              if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
              begin
                { Handle Integral subtypes NUMERIC and DECIMAL }
                if qryTables.FieldByName('RDB$FIELD_TYPE').AsShort in   {do not localize}
                        [blr_short, blr_long, blr_int64] then
                begin
                  qryPrecision.Params.ByName('FIELDNAME').AsTrimString :=   {do not localize}
                    qryTables.FieldByName('RDB$FIELD_NAME1').AsTrimString;  {do not localize}
                  qryPrecision.ExecQuery;

                  { We are ODS >= 10 and could be any Dialect }
                  if not qryPrecision.FieldByName('RDB$FIELD_PRECISION').IsNull then  {do not localize}
                  begin
                  { We are Dialect >=3 since FIELD_PRECISION is non-NULL }
                    if (qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and  {do not localize}
                       (qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then {do not localize}
                    begin
                      Column := column + Format('%s(%d, %d)',  {do not localize}
                         [IntegralSubtypes[qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],  {do not localize}
                         qryPrecision.FieldByName('RDB$FIELD_PRECISION').AsInteger, {do not localize}
                        -qryPrecision.FieldByName('RDB$FIELD_SCALE').AsInteger]); {do not localize}
                      PrecisionKnown := TRUE;
                    end;
                  end;
                  qryPrecision.Close;
                end;
              end;

              if PrecisionKnown = FALSE then
              begin
                { Take a stab at numerics and decimals }
                if (FieldType = blr_short) and (FieldScale < 0) then
                  Column := Column + Format('NUMERIC(4, %d)', [-FieldScale])  {do not localize}
                else
                  if (FieldType = blr_long) and (FieldScale < 0) then
                    Column := Column + Format('NUMERIC(9, %d)', [-FieldScale]) {do not localize}
                  else
                    if (FieldType = blr_double) and (FieldScale < 0) then
                      Column := Column + Format('NUMERIC(15, %d)', [-FieldScale]) {do not localize}
                    else
                      Column := Column + ColumnTypes[i].TypeName;
              end;
            end;
          end;
          if FieldType in [blr_text, blr_varying] then
            Column := Column + Format('(%d)', [GetFieldLength(qryTables)]);  {do not localize}

          { Catch arrays after printing the type  }

          if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull then   {do not localize}
            Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_NAME1').AsTrimString); {do not localize}

          if FieldType = blr_blob then
          begin
            subtype := qryTables.FieldByName('RDB$FIELD_SUB_TYPE').AsShort; {do not localize}
            Column := Column + ' SUB_TYPE ';    {do not localize}
            if (subtype > 0) and (subtype <= MAXSUBTYPES) then
              Column := Column + SubTypes[subtype]
            else
              Column := Column + IntToStr(subtype);
            column := Column + Format(' SEGMENT SIZE %d',  {do not localize}
                [qryTables.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]); {do not localize}
          end;

          { International character sets }
          if ((FieldType in [blr_text, blr_varying]) or
              (FieldType = blr_blob)) and
             (not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull) and  {do not localize}
             (qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) then  {do not localize}
          begin
            { Override rdb$fields id with relation_fields if present }

            CharSetId := 0;
            if not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull then  {do not localize}
              CharSetId := qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger; {do not localize}

            Column := Column + GetCharacterSets(CharSetId, 0, false);
            intchar := 1;
          end;
        end;

        { Handle defaults for columns }
        { Originally This called PrintMetadataTextBlob,
            should no longer need }
        if not qryTables.FieldByName('RDB$DEFAULT_SOURCE').IsNull then  {do not localize}
          Column := Column + ' ' + qryTables.FieldByName('RDB$DEFAULT_SOURCE').AsTrimString; {do not localize}


        { The null flag is either 1 or null (for nullable) .  if there is
          a constraint name, print that too.  Domains cannot have named
          constraints.  The column name is in rdb$trigger_name in
          rdb$check_constraints.  We hope we get at most one row back. }

        if qryTables.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then  {do not localize}
        begin
          qryConstraints.Params.ByName('FIELDNAME').AsTrimString := qryTables.FieldByName('RDB$FIELD_NAME').AsTrimString; {do not localize}
          qryConstraints.Params.ByName('RELATIONNAME').AsTrimString := qryTables.FieldByName('RDB$RELATION_NAME').AsTrimString; {do not localize}
          qryConstraints.ExecQuery;

          while not qryConstraints.Eof do
          begin
            if Pos('INTEG', qryConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsTrimString) <> 1 then {do not localize}
              Column := Column + Format(' CONSTRAINT %s',  {do not localize}
                [ QuoteIdentifier( FDatabase.SQLDialect,
                      qryConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsTrimString)]); {do not localize}
            qryConstraints.Next;
          end;
          qryConstraints.Close;
          Column := Column + ' NOT NULL'; {do not localize}
        end;

        if ((FieldType in [blr_text, blr_varying]) or
            (FieldType = blr_blob)) and
           (not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull) and  {do not localize}
           (qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) and  {do not localize}
           (intchar <> 0) then
        begin
          Collation := 0;
          if not qryTables.FieldByName('RDB$COLLATION_ID1').IsNull then {do not localize}
            Collation := qryTables.FieldByName('RDB$COLLATION_ID1').AsInteger {do not localize}
          else
            if not qryTables.FieldByName('RDB$COLLATION_ID').IsNull then {do not localize}
              Collation := qryTables.FieldByName('RDB$COLLATION_ID').AsInteger; {do not localize}

          CharSetId := 0;
          if not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull then  {do not localize}
            CharSetId := qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger; {do not localize}

          if Collation <> 0 then
            Column := Column + GetCharacterSets(CharSetId, Collation, true);
        end;
      end;
      qryTables.Next;
      if not qryTables.Eof then
        Column := Column + ','; {do not localize}
      FMetaData.Add(Column);
    end;

    { Do primary and unique keys only. references come later }

    qryRelConstraints.Params.ByName('relationname').AsTrimString := RelationName; {do not localize}
    qryRelConstraints.ExecQuery;
    while not qryRelConstraints.Eof do