ibextract.pas

这是不可多得的源代码

    begin
      Constraint := '';
      FMetaData.Strings[FMetaData.Count - 1] := FMetaData.Strings[FMetaData.Count - 1]  + ',';  {do not localize}
      { If the name of the constraint is not INTEG..., print it }
      if Pos('INTEG', qryRelConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsTrimString) <> 1 then  {do not localize}
        Constraint := Constraint + 'CONSTRAINT ' +   {do not localize}
          QuoteIdentifier(FDatabase.SQLDialect,
          qryRelConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsTrimString);  {do not localize}


      if Pos('PRIMARY', qryRelConstraints.FieldByName('RDB$CONSTRAINT_TYPE').AsTrimString) = 1 then {do not localize}
      begin
        FMetaData.Add(Constraint + Format(' PRIMARY KEY (%s)',  {do not localize}
           [GetIndexSegments(qryRelConstraints.FieldByName('RDB$INDEX_NAME').AsTrimString)])); {do not localize}
      end
      else
        if Pos('UNIQUE', qryRelConstraints.FieldByName('RDB$CONSTRAINT_TYPE').AsTrimString) = 1 then  {do not localize}
        begin
          FMetaData.Add(Constraint + Format(' UNIQUE (%s)',   {do not localize}
             [GetIndexSegments(qryRelConstraints.FieldByName('RDB$INDEX_NAME').AsTrimString)]));  {do not localize}
        end;
      qryRelConstraints.Next;
    end;
    if ValidRelation then
      FMetaData.Add(')' + Term);
  finally
    qryTables.Free;
    qryPrecision.Free;
    qryConstraints.Free;
    qryRelConstraints.Free;
  end;
end;

{	           ExtractListView
  Functional description
   	Show text of the specified view.
   	Use a SQL query to get the info and print it.
 	  Note: This should also contain check option }

procedure TIBExtract.ExtractListView(ViewName: String);
const
  ViewsSQL = 'SELECT * FROM RDB$RELATIONS REL ' +   {do not localize}
             ' WHERE ' +   {do not localize}
             '  (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +  {do not localize}
             '  NOT REL.RDB$VIEW_BLR IS NULL AND ' +  {do not localize}
             '  REL.RDB$RELATION_NAME = :VIEWNAME AND ' +  {do not localize}
             '  REL.RDB$FLAGS = 1 ' + {do not localize}
             'ORDER BY REL.RDB$RELATION_ID ';  {do not localize}

  ColumnsSQL = 'SELECT * FROM RDB$RELATION_FIELDS RFR ' + {do not localize}
               'WHERE ' +  {do not localize}
               '  RFR.RDB$RELATION_NAME = :RELATIONNAME ' +   {do not localize}
               'ORDER BY RFR.RDB$FIELD_POSITION ';  {do not localize}

var
  qryViews, qryColumns : TIBSQL;
  RelationName, ColList : String;
begin
  qryViews := CreateIBSQL;
  qryColumns := CreateIBSQL;
  try
    qryViews.SQL.Add(ViewsSQL);
    qryViews.Params.ByName('viewname').AsTrimString := ViewName; {do not localize}
    qryViews.ExecQuery;
    while not qryViews.Eof do
    begin
      FMetaData.Add('');
      RelationName := QuoteIdentifier(FDatabase.SQLDialect,
          qryViews.FieldByName('RDB$RELATION_NAME').AsTrimString);  {do not localize}
      FMetaData.Add(Format('%s/* View: %s, Owner: %s */%s', [  {do not localize}
        RelationName,
        Trim(qryViews.FieldByName('RDB$OWNER_NAME').AsTrimString)]));  {do not localize}
      FMetaData.Add('');
      FMetaData.Add(Format('CREATE VIEW %s (', [RelationName]));  {do not localize}

      { Get Column List}
      qryColumns.SQL.Add(ColumnsSQL);
      qryColumns.Params.ByName('relationname').AsTrimString := RelationName;  {do not localize}
      qryColumns.ExecQuery;
      while not qryColumns.Eof do
      begin
        ColList := ColList + QuoteIdentifier(FDatabase.SQLDialect,
              qryColumns.FieldByName('RDB$FIELD_NAME').AsTrimString);    {do not localize}
        qryColumns.Next;
        if not qryColumns.Eof then
          ColList := ColList + ', ';     {do not localize}
      end;
      FMetaData.Add(ColList + ') AS');   {do not localize}
      FMetaData.Add(qryViews.FieldByName('RDB$VIEW_SOURCE').AsTrimString + Term);  {do not localize}
      qryViews.Next;
    end;
  finally
    qryViews.Free;
    qryColumns.Free;
  end;
end;

function TIBExtract.GetCharacterSets(CharSetId, Collation: Short;
  CollateOnly: Boolean): String;
var
  CharSetSQL : TIBSQL;
  DidActivate : Boolean;
begin
  if not FTransaction.Active then
  begin
    FTransaction.StartTransaction;
    DidActivate := true;
  end
  else
    DidActivate := false;
  CharSetSQL := CreateIBSQL;
  try
    if Collation <> 0 then
    begin
      CharSetSQL.SQL.Add(CollationSQL);
      CharSetSQL.Params.ByName('Char_Set_Id').AsInteger := CharSetId;  {do not localize}
      CharSetSQL.Params.ByName('Collation').AsInteger := Collation;  {do not localize}
      CharSetSQL.ExecQuery;

      { Is specified collation the default collation for character set? }
      if (Trim(CharSetSQL.FieldByName('RDB$DEFAULT_COLLATE_NAME').AsTrimString) =  {do not localize}
         Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsTrimString)) then   {do not localize}
      begin
        if not CollateOnly then
          Result := ' CHARACTER SET ' + Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsTrimString); {do not localize}
      end
      else
        if CollateOnly then
          Result := ' COLLATE ' + Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsTrimString)  {do not localize}
        else
          Result := ' CHARACTER SET ' +  {do not localize}
            Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsTrimString) +  {do not localize}
            ' COLLATE ' +     {do not localize}
            Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsTrimString);  {do not localize}
    end
    else
      if CharSetId <> 0 then
      begin
        CharSetSQL.SQL.Add(NonCollationSQL);
        CharSetSQL.Params.ByName('CharSetId').AsShort := CharSetId; {do not localize}
        CharSetSQL.ExecQuery;
        Result := ' CHARACTER SET ' + Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsTrimString); {do not localize}
      end;
  finally
    CharSetSQL.Free;
  end;
  if DidActivate then
    FTransaction.Commit;
end;

function TIBExtract.GetDatabase: TIBDatabase;
begin
  result := FDatabase;
end;

 {	          GetIndexSegments
   Functional description
  	returns the list of columns in an index. }

function TIBExtract.GetIndexSegments(IndexName: String): String;
const
  IndexNamesSQL =
    'SELECT * FROM RDB$INDEX_SEGMENTS SEG ' +  {do not localize}
    'WHERE SEG.RDB$INDEX_NAME = :INDEXNAME ' +  {do not localize}
    'ORDER BY SEG.RDB$FIELD_POSITION';   {do not localize}

var
  qryColNames : TIBSQL;
begin
{ Query to get column names }
  Result := '';
  qryColNames := CreateIBSQL;
  try
    qryColNames.SQL.Add(IndexNamesSQL);
    qryColNames.Params.ByName('IndexName').AsTrimString := IndexName;  {do not localize}
    qryColNames.ExecQuery;
    while not qryColNames.Eof do
    begin
      { Place a comma and a blank between each segment column name }

      Result := Result + QuoteIdentifier(FDatabase.SQLDialect,
        qryColNames.FieldByName('RDB$FIELD_NAME').AsTrimString);  {do not localize}
      qryColNames.Next;
      if not qryColNames.Eof then
        Result := Result + ', ';   {do not localize}
    end;
  finally
    qryColNames.Free;
  end;
end;

function TIBExtract.GetTransaction: TIBTransaction;
begin
  Result := FTransaction;
end;

{	   ListAllGrants
  Functional description
 	 Print the permissions on all user tables.
 	 Get separate permissions on table/views and then procedures }

procedure TIBExtract.ListGrants;
const
  SecuritySQL = 'SELECT * FROM RDB$RELATIONS ' +   {do not localize}
                'WHERE ' +     {do not localize}
                '  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +  {do not localize}
                '  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +   {do not localize}
                'ORDER BY RDB$RELATION_NAME';   {do not localize}

  ProcedureSQL = 'select * from RDB$PROCEDURES ' +   {do not localize}
                 'Order BY RDB$PROCEDURE_NAME'; {do not localize}

var
  qryRoles : TIBSQL;
  RelationName : String;
begin
  ListRoles;
  qryRoles := CreateIBSQL;
  try
  { This version of cursor gets only sql tables identified by security class
     and misses views, getting only null view_source }

    FMetaData.Add('');   {do not localize}
    FMetaData.Add('/* Grant permissions for this database */');   {do not localize}
    FMetaData.Add('');   {do not localize}

    try
      qryRoles.SQL.Text := SecuritySQL;
      qryRoles.ExecQuery;
      while not qryRoles.Eof do
      begin
        RelationName := Trim(qryRoles.FieldByName('rdb$relation_Name').AsTrimString);  {do not localize}
        ShowGrants(RelationName, Term);
        qryRoles.Next;
      end;
    finally
     qryRoles.Close;
    end;

    ShowGrantRoles(Term);

    qryRoles.SQL.Text := ProcedureSQL;
    qryRoles.ExecQuery;
    try
      while not qryRoles.Eof do
      begin
        ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsTrimString), Term); {do not localize}
        qryRoles.Next;
      end;
    finally
      qryRoles.Close;
    end;
  finally
    qryRoles.Free;
  end;
end;

{	  ListAllProcs
  Functional description
  	Shows text of a stored procedure given a name.
  	or lists procedures if no argument.
 	 Since procedures may reference each other, we will create all
  	dummy procedures of the correct name, then alter these to their
  	correct form.
       Add the parameter names when these procedures are created.

 	 procname -- Name of procedure to investigate }

procedure TIBExtract.ListProcs(ProcedureName : String; AlterOnly : Boolean);
const
  CreateProcedureStr1 = 'CREATE PROCEDURE %s ';  {do not localize}
  CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';  {do not localize}
  ProcedureSQL =
    'SELECT * FROM RDB$PROCEDURES ' +  {do not localize}
    'ORDER BY RDB$PROCEDURE_NAME';     {do not localize}

  ProcedureNameSQL =
    'SELECT * FROM RDB$PROCEDURES ' +    {do not localize}
    'WHERE RDB$PROCEDURE_NAME = :ProcedureName ' + {do not localize}
    'ORDER BY RDB$PROCEDURE_NAME';  {do not localize}

var
  qryProcedures : TIBSQL;
  ProcName : String;
  SList : TStrings;
  Header : Boolean;
begin

  Header := true;
  qryProcedures := CreateIBSQL;
  SList := TStringList.Create;
  try
{  First the dummy procedures
    create the procedures with their parameters }
    if ProcedureName = '' then
      qryProcedures.SQL.Text := ProcedureSQL
    else
    begin
      qryProcedures.SQL.Text := ProcedureNameSQL;
      qryProcedures.Params.ByName('ProcedureName').AsTrimString := ProcedureName; {do not localize}
    end;
    if not AlterOnly then
    begin
      qryProcedures.ExecQuery;
      while not qryProcedures.Eof do
      begin
        if Header then
        begin
          FMetaData.Add('COMMIT WORK;');  {do not localize}
          FMetaData.Add('SET AUTODDL OFF;');  {do not localize}
          FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term])); {do not localize}
          FMetaData.Add(Format('%s/* Stored procedures */%s', [NEWLINE, NEWLINE])); {do not localize}
          Header := false;