ibextract.pas

这是不可多得的源代码

  qryDB : TIBSQL;
  FileFlags, FileLength, FileSequence, FileStart : Integer;

  function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
  var
    local_buffer: array[0..IBLocalBufferLength - 1] of Char;
    length: Integer;
    _DatabaseInfoCommand: Char;
  begin
    _DatabaseInfoCommand := Char(DatabaseInfoCommand);
    FDatabaseInfo.Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
                           IBLocalBufferLength, local_buffer), True);
    length := isc_vax_integer(@local_buffer[1], 2);
    result := isc_vax_integer(@local_buffer[3], length);
  end;

begin
	NoDb := FALSE;
  First := TRUE;
  FirstFile := TRUE;
  HasWal := FALSE;
  SetUsed := FALSE;
  Buffer := '';  {do not localize}
  if TargetDb = '' then   {do not localize}
  begin
    Buffer := '/* '; {do not localize}
    TargetDb := FDatabase.DatabaseName;
    NoDb := true;
  end;
  Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +  {do not localize}
    IntToStr(FDatabaseInfo.PageSize) + NEWLINE;
  FMetaData.Add(Buffer);
  Buffer := '';

  qryDB := CreateIBSQL;
  try
    qryDB.SQL.Text := CharInfoSQL;
    qryDB.ExecQuery;

    Buffer := Format(' DEFAULT CHARACTER SET %s',   {do not localize}
      [qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsTrimString]);  {do not localize}
    if NoDB then
      Buffer := Buffer + ' */'  {do not localize}
    else
      Buffer := Buffer + Term;
    FMetaData.Add(Buffer);
    qryDB.Close;
    {List secondary files and shadows as
      alter db and create shadow in comment}
    qryDB.SQL.Text := FilesSQL;
    qryDB.ExecQuery;
    while not qryDB.Eof do
    begin
      if First then
      begin
        FMetaData.Add(NEWLINE + '/* Add secondary files in comments ');  {do not localize}
        First := false;
      end; //end_if

      if qryDB.FieldByName('RDB$FILE_FLAGS').IsNull then  {do not localize}
        FileFlags := 0
      else
        FileFlags := qryDB.FieldByName('RDB$FILE_FLAGS').AsInteger; {do not localize}
      if qryDB.FieldByName('RDB$FILE_LENGTH').IsNull then   {do not localize}
        FileLength := 0
      else
        FileLength := qryDB.FieldByName('RDB$FILE_LENGTH').AsInteger; {do not localize}
      if qryDB.FieldByName('RDB$FILE_SEQUENCE').IsNull then     {do not localize}
        FileSequence := 0
      else
        FileSequence := qryDB.FieldByName('RDB$FILE_SEQUENCE').AsInteger; {do not localize}
      if qryDB.FieldByName('RDB$FILE_START').IsNull then   {do not localize}
        FileStart := 0
      else
        FileStart := qryDB.FieldByName('RDB$FILE_START').AsInteger; {do not localize}

      { Pure secondary files }
      if FileFlags = 0 then
      begin
        Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',  {do not localize}
          [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsTrimString]);  {do not localize}
        if FileStart <> 0 then
          Buffer := Buffer + Format(' STARTING %d', [FileStart]);  {do not localize}
        if FileLength <> 0 then
          Buffer := Buffer + Format(' LENGTH %d', [FileLength]);  {do not localize}
        FMetaData.Add(Buffer);
      end; //end_if
      if (FileFlags and FILE_cache) <> 0 then
        FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',  {do not localize}
          [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsTrimString, FileLength]));  {do not localize}

      Buffer := '';
      if (FileFlags and FILE_shadow) <> 0 then
      begin
        if FileSequence <> 0 then
          Buffer := Format('%sFILE ''%s''',    {do not localize}
            [TAB, qryDB.FieldByName('RDB$FILE_NAME').AsTrimString]) {do not localize}
        else
        begin
          Buffer := Format('%sCREATE SHADOW %d ''%s'' ',  {do not localize}
            [NEWLINE, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,  {do not localize}
             qryDB.FieldByName('RDB$FILE_NAME').AsTrimString]);  {do not localize}
          if (FileFlags and FILE_inactive) <> 0 then
            Buffer := Buffer + 'INACTIVE ';         {do not localize}
          if (FileFlags and FILE_manual) <> 0 then
            Buffer := Buffer + 'MANUAL '       {do not localize}
          else
            Buffer := Buffer + 'AUTO ';           {do not localize}
          if (FileFlags and FILE_conditional) <> 0 then
            Buffer := Buffer + 'CONDITIONAL ';     {do not localize}
        end; //end_else
        if FileLength <> 0 then
          Buffer := Buffer + Format('LENGTH %d ', [FileLength]);   {do not localize}
        if FileStart <> 0 then
          Buffer := Buffer + Format('STARTING %d ', [FileStart]);   {do not localize}
        FMetaData.Add(Buffer);
      end; //end_if
      qryDB.Next;
    end;
    qryDB.Close;

    qryDB.SQL.Text := LogsSQL;
    qryDB.ExecQuery;
    while not qryDB.Eof do
    begin

      if qryDB.FieldByName('RDB$FILE_FLAGS').IsNull then  {do not localize}
        FileFlags := 0
      else
        FileFlags := qryDB.FieldByName('RDB$FILE_FLAGS').AsInteger; {do not localize}
      if qryDB.FieldByName('RDB$FILE_LENGTH').IsNull then     {do not localize}
        FileLength := 0
      else
        FileLength := qryDB.FieldByName('RDB$FILE_LENGTH').AsInteger;  {do not localize}

      Buffer := '';
      HasWal := true;
      if First then
      begin
        if NoDB then
          Buffer := '/* ';  {do not localize}
        Buffer := Buffer + NEWLINE + 'ALTER DATABASE ADD ';   {do not localize}
        First := false;
      end; //end_if
      if FirstFile then
        Buffer := Buffer + 'LOGFILE '; {do not localize}
      { Overflow files also have the serial bit set }
      if (FileFlags and LOG_default) = 0 then
      begin
        if (FileFlags and LOG_overflow) <> 0 then
          Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',  {do not localize}
            [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsTrimString]) {do not localize}
        else
          if (FileFlags and LOG_serial) <> 0 then
            Buffer := Buffer + Format('%s  BASE_NAME ''%s''',     {do not localize}
              [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsTrimString])  {do not localize}
          { Since we are fetching order by FILE_FLAGS, the LOG_0verflow will
             be last.  It will only appear if there were named round robin,
             so we must close the parens first }

          { We have round robin and overflow file specifications }
          else
          begin
            if FirstFile then
              Buffer := Buffer + '('       {do not localize}
            else
              Buffer := Buffer + Format(',%s  ', [NEWLINE]);  {do not localize}
            FirstFile := false;

            Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsTrimString]);  {do not localize}
          end; //end_else
      end;
      { Any file can have a length }
      if FileLength <> 0 then
        Buffer := Buffer + Format(' SIZE %d ', [FileLength]);    {do not localize}
      FMetaData.Add(Buffer);
      qryDB.Next;
    end;
    qryDB.Close;
    Buffer := '';
    if HasWal then
    begin
      Buffer := Buffer + PrintSet(SetUsed);
      Buffer := Buffer + Format('NUM_LOG_BUFFERS = %d',  {do not localize}
          [GetLongDatabaseInfo(isc_info_num_wal_buffers)]);
      Buffer := Buffer + PrintSet(SetUsed);
      Buffer := Buffer + Format('LOG_BUFFER_SIZE = %d',    {do not localize}
          [GetLongDatabaseInfo(isc_info_wal_buffer_size)]);
      Buffer := Buffer + PrintSet(SetUsed);
      Buffer := Buffer + Format('GROUP_COMMIT_WAIT_TIME = %d',   {do not localize}
          [GetLongDatabaseInfo(isc_info_wal_grpc_wait_usecs)]);
      Buffer := Buffer + PrintSet(SetUsed);
      Buffer := Buffer + Format('CHECK_POINT_LENGTH = %d',  {do not localize}
          [GetLongDatabaseInfo(isc_info_wal_ckpt_length)]);
      FMetaData.Add(Buffer);

    end;
    if not First then
    begin
      if NoDB then
        FMetaData.Add(Format('%s */%s', [NEWLINE, NEWLINE]))  {do not localize}
      else
        FMetaData.Add(Format('%s%s%s', [Term, NEWLINE, NEWLINE]));   {do not localize}
    end;
  finally
    qryDB.Free;
  end;
end;

{	             ListDomainTable
  Functional description
  	List domains as identified by fields with any constraints on them
  	for the named table

  	Parameters:  table_name == only extract domains for this table }

procedure TIBExtract.ListDomains(ObjectName: String; ExtractType : TExtractType);
const
  DomainSQL =
    'SELECT distinct fld.* FROM RDB$FIELDS FLD JOIN RDB$RELATION_FIELDS RFR ON ' +  {do not localize}
    '  RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +   {do not localize}
    'WHERE RFR.RDB$RELATION_NAME = :TABLE_NAME ' +     {do not localize}
    'ORDER BY FLD.RDB$FIELD_NAME';                  {do not localize}

  DomainByNameSQL =
    'SELECT * FROM RDB$FIELDS FLD ' +   {do not localize}
    'WHERE FLD.RDB$FIELD_NAME = :DomainName ' +   {do not localize}
    'ORDER BY FLD.RDB$FIELD_NAME';  {do not localize}

  AllDomainSQL =
    'select * from RDB$FIELDS ' +   {do not localize}
    'where RDB$SYSTEM_FLAG <> 1 ' +   {do not localize}
    'order BY RDB$FIELD_NAME';    {do not localize}

var
  First : Boolean;
  qryDomains : TIBSQL;
  FieldName, Line : String;

  function FormatDomainStr : String;
  var
    i, SubType : Integer;
    PrecisionKnown : Boolean;
  begin
    Result := '';  {do not localize}
    for i := Low(ColumnTypes) to High(ColumnTypes) do
      if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = ColumnTypes[i].SQLType then    {do not localize}
      begin
        PrecisionKnown := FALSE;
        if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
        begin
          if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_short, blr_long, blr_int64] then  {do not localize}
          begin
            { We are ODS >= 10 and could be any Dialect }
            if (FDatabaseInfo.DBSQLDialect >= 3) and
               (not qryDomains.FieldByName('RDB$FIELD_PRECISION').IsNull) and  {do not localize}
               (qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and  {do not localize}
               (qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then  {do not localize}
            begin
              Result := Result + Format('%s(%d, %d)', [  {do not localize}
                IntegralSubtypes [qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],  {do not localize}
                qryDomains.FieldByName('RDB$FIELD_PRECISION').AsInteger, {do not localize}
                -1 * qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger]);  {do not localize}
              PrecisionKnown := true;
            end;
          end;
        end;
        if PrecisionKnown = false then
        begin
          { Take a stab at numerics and decimals }
          if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_short) and  {do not localize}
              (qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then {do not localize}
            Result := Result + Format('NUMERIC(4, %d)',     {do not localize}
              [-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )  {do not localize}
          else
            if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_long) and {do not localize}
                (qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then  {do not localize}
              Result := Result + Format('NUMERIC(9, %d)',                   {do not localize}
                [-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )    {do not localize}
            else
              if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_double) and    {do not localize}
                  (qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger  < 0) then  {do not localize}
                Result := Result + Format('NUMERIC(15, %d)',             {do not localize}
                  [-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] ) {do not localize}
              else
                Result := Result + ColumnTypes[i].TypeName;
        end;
        break;
      end;

    if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_blob then {do not localize}
    begin
      subtype := qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger;  {do not localize}
      Result := Result + ' SUB_TYPE ';   {do not localize}
      if (subtype > 0) and (subtype <= MAXSUBTYPES) then
        Result := Result + SubTypes[subtype]
      else
        Result := Result + Format('%d', [subtype]);  {do not localize}
      Result := Result + Format(' SEGMENT SIZE %d', [qryDomains.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);  {do not localize}
    end //end_if
    else
      if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying] then   {do not localize}
        Result := Result + Format('(%d)', [GetFieldLength(qryDomains)]);  {do not localize}

    { since the character set is part of the field type, display that
     information now. }
    if not qryDomains.FieldByName('RDB$CHARACTER_SET_ID').IsNull then  {do not localize}
      Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger, {do not localize}
         0, FALS