ibextract.pas

这是不可多得的源代码

        end;
        ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsTrimString);  {do not localize}
        FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
           ProcName)]));
        GetProcedureArgs(ProcName);
        FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, NEWLINE]));
        qryProcedures.Next;
      end;
      qryProcedures.Close;
    end;

    qryProcedures.ExecQuery;
    while not qryProcedures.Eof do
    begin
      SList.Clear;
      ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsTrimString); {do not localize}
      FMetaData.Add(Format('%sALTER PROCEDURE %s ', [NEWLINE,  {do not localize}
         QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
      GetProcedureArgs(ProcName);

      FMetaData.AddStrings(SList);
      SList.Clear;
      if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then  {do not localize}
      begin
        SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsTrimString; {do not localize}
        while (Slist.Count > 0) and (Trim(SList[0]) = '') do  {do not localize}
          SList.Delete(0);
      end;
      if not AlterOnly then
        SList.Add(Format(' %s%s', [ProcTerm, NEWLINE]));   {do not localize}
      FMetaData.AddStrings(SList);
      qryProcedures.Next;
    end;

{ This query gets the procedure name and the source.  We then nest a query
   to retrieve the parameters. Alter is used, because the procedures are
   already there}

    if not Header then
    begin
      FMetaData.Add(Format('SET TERM %s %s', [Term, ProcTerm]));  {do not localize}
      FMetaData.Add('COMMIT WORK;');   {do not localize}
      FMetaData.Add('SET AUTODDL ON;');  {do not localize}
    end;
  finally
    qryProcedures.Free;
    SList.Free;
  end;
end;

{            	  ListAllTables
  Functional description
  	Extract the names of all user tables from
 	 rdb$relations.  Filter SQL tables by
  	security class after we fetch them
  	Parameters:  flag -- 0, get all tables }

procedure TIBExtract.ListAllTables(flag: Boolean);
const
  TableSQL =
    '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$VIEW_BLR IS NULL ' +  {do not localize}
    'ORDER BY RDB$RELATION_NAME';  {do not localize}

var
  qryTables : TIBSQL;
begin
{ This version of cursor gets only sql tables identified by security class
   and misses views, getting only null view_source }

   qryTables := CreateIBSQL;
   try
     qryTables.SQL.Text := TableSQL;
     qryTables.ExecQuery;
     while not qryTables.Eof do
     begin
       if ((qryTables.FieldByName('RDB$FLAGS').AsInteger <> 1) and  {do not localize}
           (not Flag)) then
         continue;
       if flag or (Pos('SQL$', qryTables.FieldByName('RDB$SECURITY_CLASS').AsTrimString) <> 1) then {do not localize}
	       ExtractListTable(qryTables.FieldByName('RDB$RELATION_NAME').AsTrimString, {do not localize}
           '', false);    {do not localize}

       qryTables.Next;
     end;
   finally
     qryTables.Free;
   end;
end;

{	 ListAllTriggers
  Functional description
  	Lists triggers in general on non-system
  	tables with sql source only. }

procedure TIBExtract.ListTriggers(ObjectName : String; ExtractType : TExtractType);
const
{ Query gets the trigger info for non-system triggers with
   source that are not part of an SQL constraint }

  TriggerSQL =
    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +  {do not localize}
    '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +     {do not localize}
    'WHERE ' +
    ' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +  {do not localize}
    '  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' + {do not localize}
    '     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +  {do not localize}
    'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +  {do not localize}
    '    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';  {do not localize}

  TriggerNameSQL =
    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +  {do not localize}
    '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +   {do not localize}
    'WHERE ' +                                    {do not localize}
    ' REL.RDB$RELATION_NAME = :TableName AND ' +    {do not localize}
    ' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +  {do not localize}
    '  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +  {do not localize}
    '     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +  {do not localize}
    'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +    {do not localize}
    '    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';  {do not localize}

  TriggerByNameSQL =
    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +    {do not localize}
    '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +     {do not localize}
    'WHERE ' +      {do not localize}
    ' TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +  {do not localize}
    ' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +  {do not localize}
    '  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +  {do not localize}
    '     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +   {do not localize}
    'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +  {do not localize}
    '    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';   {do not localize}

var
  Header : Boolean;
  TriggerName, RelationName, InActive: String;
  qryTriggers : TIBSQL;
  SList : TStrings;
begin
  Header := true;
  SList := TStringList.Create;
  qryTriggers := CreateIBSQL;
  try
    if ObjectName = '' then    {do not localize}
      qryTriggers.SQL.Text := TriggerSQL
    else
    begin
      if ExtractType = etTable then
      begin
        qryTriggers.SQL.Text := TriggerNameSQL;
        qryTriggers.Params.ByName('TableName').AsTrimString := ObjectName;  {do not localize}
      end
      else
      begin
        qryTriggers.SQL.Text := TriggerByNameSQL;
        qryTriggers.Params.ByName('TriggerName').AsTrimString := ObjectName;  {do not localize}
      end;
    end;
    qryTriggers.ExecQuery;
    while not qryTriggers.Eof do
    begin
      SList.Clear;
      if Header then
      begin
        FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, NEWLINE]));  {do not localize}
        FMetaData.Add(Format('%s/* Triggers only will work for SQL triggers */%s', {do not localize}
		       [NEWLINE, NEWLINE]));
        Header := false;
      end;
      TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsTrimString;  {do not localize}
      RelationName := qryTriggers.FieldByName('RDB$RELATION_NAME').AsTrimString; {do not localize}
      if qryTriggers.FieldByName('RDB$TRIGGER_INACTIVE').IsNull then   {do not localize}
        InActive := 'INACTIVE'    {do not localize}
      else
        if qryTriggers.FieldByName('RDB$TRIGGER_INACTIVE').AsInteger = 1 then  {do not localize}
          InActive := 'INACTIVE'  {do not localize}
        else
          InActive := 'ACTIVE';   {do not localize}

      if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then  {do not localize}
        SList.Add('/* ');   {do not localize}

      SList.Add(Format('CREATE TRIGGER %s FOR %s %s%s %s POSITION %d',  {do not localize}
	        [QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
           QuoteIdentifier(FDatabase.SQLDialect, RelationName),
           NEWLINE, InActive,
           TriggerTypes[qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger], {do not localize}
           qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger])); {do not localize}
      if not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then   {do not localize}
        SList.Text := SList.Text +
              qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsTrimString;  {do not localize}
      SList.Add(' ' + ProcTerm + NEWLINE);
      if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then  {do not localize}
        SList.Add(' */');         {do not localize}
      FMetaData.AddStrings(SList);
      qryTriggers.Next;
    end;
    if not Header then
    begin
      FMetaData.Add('COMMIT WORK ' + ProcTerm);     {do not localize}
      FMetaData.Add('SET TERM ' + Term + ProcTerm);  {do not localize}
    end;
  finally
    qryTriggers.Free;
    SList.Free;
  end;
end;

{	               ListCheck
  Functional description
 	  List check constraints for all objects to allow forward references }

procedure TIBExtract.ListCheck(ObjectName : String; ExtractType : TExtractType);
const
{ Query gets the check clauses for triggers stored for check constraints }
  CheckSQL =
    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +   {do not localize}
    '  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +   {do not localize}
    'WHERE ' +   {do not localize}
    '  TRG.RDB$TRIGGER_TYPE = 1 AND ' +   {do not localize}
    '  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +    {do not localize}
    '    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +    {do not localize}
    'ORDER BY CHK.RDB$CONSTRAINT_NAME';  {do not localize}

  CheckNameSQL =
    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +  {do not localize}
    '  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +  {do not localize}
    'WHERE ' +      {do not localize}
    '  TRG.RDB$RELATION_NAME = :TableName AND ' +   {do not localize}
    '  TRG.RDB$TRIGGER_TYPE = 1 AND ' +    {do not localize}
    '  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +  {do not localize}
    '    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +  {do not localize}
    'ORDER BY CHK.RDB$CONSTRAINT_NAME';   {do not localize}

  CheckByNameSQL =
    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +  {do not localize}
    '  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +   {do not localize}
    'WHERE ' +     {do not localize}
    '  TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +   {do not localize}
    '  TRG.RDB$TRIGGER_TYPE = 1 AND ' +   {do not localize}
    '  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +  {do not localize}
    '    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +    {do not localize}
    'ORDER BY CHK.RDB$CONSTRAINT_NAME';    {do not localize}

var
  qryChecks : TIBSQL;
  SList : TStrings;
  RelationName : String;
begin
  qryChecks := CreateIBSQL;
  SList := TStringList.Create;
  try
    if ObjectName = '' then     {do not localize}
      qryChecks.SQL.Text := CheckSQL
    else
      if ExtractType = etTable then
      begin
        qryChecks.SQL.Text := CheckNameSQL;
        qryChecks.Params.ByName('TableName').AsTrimString := ObjectName;   {do not localize}
      end
      else
      begin
        qryChecks.SQL.Text := CheckByNameSQL;
        qryChecks.Params.ByName('TriggerName').AsTrimString := ObjectName; {do not localize}
      end;
    qryChecks.ExecQuery;
    while not qryChecks.Eof do
    begin
      SList.Clear;
      RelationName := qryChecks.FieldByName('RDB$RELATION_NAME').AsTrimString;  {do not localize}
      SList.Add(Format('ALTER TABLE %s ADD',   {do not localize}
		    [QuoteIdentifier(FDatabase.SQLDialect, RelationName)]));
      if Pos('INTEG', qryChecks.FieldByName('RDB$CONSTRAINT_NAME').AsTrimString) <> 1 then    {do not localize}
        SList.Add(Format('%sCONSTRAINT %s ', [TAB,        {do not localize}
          QuoteIdentifier(FDatabase.SQLDialect, qryChecks.FieldByName('RDB$CONSTRAINT_NAME').AsTrimString)]));  {do not localize}

      if not qryChecks.FieldByName('RDB$TRIGGER_SOURCE').IsNull then    {do not localize}
        SList.Text := SList.Text + qryChecks.FieldByName('RDB$TRIGGER_SOURCE').AsTrimString;   {do not localize}

      SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + NEWLINE;
      FMetaData.AddStrings(SList);
      qryChecks.Next;
    end;
  finally
    qryChecks.Free;
    SList.Free;
  end;
end;

{             ListCreateDb
  Functional description
    Print the create database command if requested.  At least put
    the page size in a comment with the extracted db name }

procedure TIBExtract.ListCreateDb(TargetDb : String);
const
  CharInfoSQL =
    'SELECT * FROM RDB$DATABASE DBP ' +   {do not localize}
    'WHERE NOT DBP.RDB$CHARACTER_SET_NAME IS NULL ' +  {do not localize}
    '  AND DBP.RDB$CHARACTER_SET_NAME != '' ''';   {do not localize}

  FilesSQL =
    'select * from RDB$FILES ' +   {do not localize}
    'order BY RDB$SHADOW_NUMBER, RDB$FILE_SEQUENCE'; {do not localize}

  LogsSQL =
    'SELECT * FROM RDB$LOG_FILES ' +  {do not localize}
    'ORDER BY RDB$FILE_FLAGS, RDB$FILE_SEQUENCE';   {do not localize}

var
  NoDb, First, FirstFile, HasWal, SetUsed : Boolean;
  Buffer : String;