ibextract.pas

这是不可多得的源代码

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2001 Borland Software Corporation             }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You may obtain }
{    a copy of the License at http://www.borland.com/interbase/IPL.html  }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Borland Software Corporation are Copyright      }
{       (C) Borland Software Corporation. All Rights Reserved.           }
{    IBX Version 4.2 or higher required                                  }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{************************************************************************}

unit IBExtract;

interface

uses
  SysUtils, Classes, IBDatabase, IBDatabaseInfo, IBSQL, IBUtils, IBHeader, IB,
  IBIntf, IBExternals;

type
  TExtractObjectTypes =
    (eoDatabase, eoDomain, eoTable, eoView, eoProcedure, eoFunction,
     eoGenerator, eoException, eoBLOBFilter, eoRole, eoTrigger, eoForeign,
     eoIndexes, eoChecks, eoData);

  TExtractType =
    (etDomain, etTable, etRole, etTrigger, etForeign,
     etIndex, etData, etGrant, etCheck, etAlterProc);

  TExtractTypes = Set of TExtractType;

  TIBExtract = class(TComponent)
  private
    FDatabase : TIBDatabase;
    FTransaction : TIBTransaction;
    FMetaData: TStrings;
    FDatabaseInfo: TIBDatabaseInfo;
    FShowSystem: Boolean;
    { Private declarations }
    function GetDatabase: TIBDatabase;
    function GetIndexSegments ( indexname : String) : String;
    function GetTransaction: TIBTransaction;
    procedure SetDatabase(const Value: TIBDatabase);
    procedure SetTransaction(const Value: TIBTransaction);
    function PrintValidation(ToValidate : String;	flag : Boolean) : String;
    procedure ShowGrants(MetaObject: String; Terminator : String);
    procedure ShowGrantRoles(Terminator : String);
    procedure GetProcedureArgs(Proc : String);
    function GetFieldLength(sql : TIBSQL) : Integer;
    function CreateIBSQL : TIBSQL;
  protected
    function ExtractDDL(Flag : Boolean; TableName : String) : Boolean;
    function ExtractListTable(RelationName, NewName : String; DomainFlag : Boolean) : Boolean;
    procedure ExtractListView (ViewName : String);
    procedure ListData(ObjectName : String);
    procedure ListRoles(ObjectName : String = '');  {do not localize}
    procedure ListGrants;
    procedure ListProcs(ProcedureName : String = ''; AlterOnly : Boolean = false);  {do not localize}
    procedure ListAllTables(flag : Boolean);
    procedure ListTriggers(ObjectName : String = ''; ExtractType : TExtractType = etTrigger); {do not localize}
    procedure ListCheck(ObjectName : String = ''; ExtractType : TExtractType = etCheck);  {do not localize}
    function PrintSet(var Used : Boolean) : String;
    procedure ListCreateDb(TargetDb : String = ''); {do not localize}
    procedure ListDomains(ObjectName : String = ''; ExtractType : TExtractType = etDomain);  {do not localize}
    procedure ListException(ExceptionName : String = ''); {do not localize}
    procedure ListFilters(FilterName : String = ''); {do not localize}
    procedure ListForeign(ObjectName : String = ''; ExtractType : TExtractType = etForeign); {do not localize}
    procedure ListFunctions(FunctionName : String = ''); {do not localize}
    procedure ListGenerators(GeneratorName : String = '');  {do not localize}
    procedure ListIndex(ObjectName : String = ''; ExtractType : TExtractType = etIndex);  {do not localize}
    procedure ListViews(ViewName : String = '');  {do not localize}

    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function GetArrayField(FieldName : String) : String;
    function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
      FieldPrec, FieldLen : Integer) : String;
    function GetCharacterSets(CharSetId, Collation : Short;	CollateOnly : Boolean) : String;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';  {do not localize}
      ExtractTypes : TExtractTypes = []);
    property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
    property Items : TStrings read FMetaData;

  published
    { Published declarations }
    property Database : TIBDatabase read GetDatabase write SetDatabase;
    property Transaction : TIBTransaction read GetTransaction write SetTransaction;
    property ShowSystem: Boolean read FShowSystem write FShowSystem;
  end;

  TSQLType = record
    SqlType : Integer;
    TypeName : String;
  end;

  TPrivTypes = record
    PrivFlag : Integer;
    PrivString : String;
  end;

  TSQLTypes = Array[0..13] of TSQLType;

const

  priv_UNKNOWN = 1;
  priv_SELECT = 2;
  priv_INSERT = 4;
  priv_UPDATE = 8;
  priv_DELETE = 16;
  priv_EXECUTE = 32;
  priv_REFERENCES = 64;

 PrivTypes : Array[0..5] of TPrivTypes = (
  (PrivFlag : priv_DELETE; PrivString : 'DELETE' ),  {do not localize}
  (PrivFlag : priv_EXECUTE; PrivString : 'EXECUTE' ), {do not localize}
  (PrivFlag : priv_INSERT; PrivString : 'INSERT' ),   {do not localize}
  (PrivFlag : priv_SELECT; PrivString : 'SELECT' ),    {do not localize}
  (PrivFlag : priv_UPDATE; PrivString : 'UPDATE' ),    {do not localize}
  (PrivFlag : priv_REFERENCES; PrivString : 'REFERENCES')); {do not localize}

 	ColumnTypes : TSQLTypes = (
    (SqlType : blr_short; TypeName :	'SMALLINT'),		 {do not localize}
    (SqlType : blr_long; TypeName : 'INTEGER'),		   {do not localize}
    (SqlType : blr_quad; TypeName : 'QUAD'),		   {do not localize}
    (SqlType : blr_float; TypeName : 'FLOAT'),		    {do not localize}
    (SqlType : blr_text; TypeName : 'CHAR'),		    {do not localize}
    (SqlType : blr_double; TypeName : 'DOUBLE PRECISION'),	  {do not localize}
    (SqlType : blr_varying; TypeName : 'VARCHAR'),		  {do not localize}
    (SqlType : blr_cstring; TypeName : 'CSTRING'),		  {do not localize}
    (SqlType : blr_blob_id; TypeName : 'BLOB_ID'),		  {do not localize}
    (SqlType : blr_blob; TypeName : 'BLOB'),		  {do not localize}
    (SqlType : blr_sql_time; TypeName : 'TIME'),		 {do not localize}
    (SqlType : blr_sql_date; TypeName : 'DATE'),		 {do not localize}
    (SqlType : blr_timestamp; TypeName : 'TIMESTAMP'),		  {do not localize}
    (SqlType : blr_int64; TypeName : 'INT64'));              {do not localize}

  SubTypes : Array[0..8] of String = (
    'UNKNOWN',			    {do not localize}
    'TEXT',				 {do not localize}
    'BLR',				  {do not localize}
    'ACL',				  {do not localize}
    'RANGES',			   {do not localize}
    'SUMMARY',			   {do not localize}
    'FORMAT',			   {do not localize}
    'TRANSACTION_DESCRIPTION',	   {do not localize}
    'EXTERNAL_FILE_DESCRIPTION');	 {do not localize}

  TriggerTypes : Array[0..6] of String = (
    '',       {do not localize}
    'BEFORE INSERT', {do not localize}
    'AFTER INSERT',  {do not localize}
    'BEFORE UPDATE',			  {do not localize}
    'AFTER UPDATE',				 {do not localize}
    'BEFORE DELETE',			   {do not localize}
    'AFTER DELETE');			  {do not localize}

  IntegralSubtypes : Array[0..2] of String = (
    'UNKNOWN',   {do not localize}
    'NUMERIC',   {do not localize}
    'DECIMAL');  {do not localize}

  ODS_VERSION6 = 6;	{ on-disk structure as of v3.0 }
  ODS_VERSION7 = 7;	{ new on disk structure for fixing index bug }
  ODS_VERSION8 =	8;	{ new btree structure to support pc semantics }
  ODS_VERSION9 =	9;	{ btree leaf pages are always propogated up }
  ODS_VERSION10 = 10; { V6.0 features. SQL delimited idetifier,
                                        SQLDATE, and 64-bit exact numeric
                                        type }

  { flags for RDB$FILE_FLAGS }
  FILE_shadow = 1;
  FILE_inactive = 2;
  FILE_manual = 4;
  FILE_cache = 8;
  FILE_conditional = 16;

  { flags for RDB$LOG_FILES }
  LOG_serial = 1;
  LOG_default = 2;
  LOG_raw = 4;
  LOG_overflow = 8;



  MAX_INTSUBTYPES = 2;
  MAXSUBTYPES = 8;     { Top of subtypes array }

{ Object types used in RDB$DEPENDENCIES and RDB$USER_PRIVILEGES }

  obj_relation = 0;
  obj_view = 1;
  obj_trigger = 2;
  obj_computed = 3;
  obj_validation = 4;
  obj_procedure = 5;
  obj_expression_index = 6;
  obj_exception = 7;
  obj_user = 8;
  obj_field = 9;
  obj_index = 10;
  obj_count = 11;
  obj_user_group = 12;
  obj_sql_role = 13;

implementation

const
  NEWLINE = #13#10;  {do not localize}
  TERM = ';';   {do not localize}
  ProcTerm = '^';  {do not localize}

  CollationSQL =
    'SELECT CST.RDB$CHARACTER_SET_NAME, COL.RDB$COLLATION_NAME, CST.RDB$DEFAULT_COLLATE_NAME ' + {do not localize}
    'FROM RDB$COLLATIONS COL JOIN RDB$CHARACTER_SETS CST ON ' +   {do not localize}
    '  COL.RDB$CHARACTER_SET_ID = CST.RDB$CHARACTER_SET_ID ' +    {do not localize}
    'WHERE ' +  {do not localize}
    '  COL.RDB$COLLATION_ID = :COLLATION AND ' +  {do not localize}
    '  CST.RDB$CHARACTER_SET_ID = :CHAR_SET_ID ' +   {do not localize}
    'ORDER BY COL.RDB$COLLATION_NAME, CST.RDB$CHARACTER_SET_NAME'; {do not localize}

  NonCollationSQL =
    'SELECT CST.RDB$CHARACTER_SET_NAME ' +   {do not localize}
    'FROM RDB$CHARACTER_SETS CST ' +      {do not localize}
    'WHERE CST.RDB$CHARACTER_SET_ID = :CHARSETID ' +  {do not localize}
    'ORDER BY CST.RDB$CHARACTER_SET_NAME';   {do not localize}

  PrecisionSQL =
    'SELECT * FROM RDB$FIELDS ' +   {do not localize}
    'WHERE RDB$FIELD_NAME = :FIELDNAME';  {do not localize}

  ArraySQL =
    'SELECT * FROM RDB$FIELD_DIMENSIONS FDIM ' + {do not localize}
    'WHERE ' +  {do not localize}
    '  FDIM.RDB$FIELD_NAME = :FIELDNAME ' + {do not localize}
    'ORDER BY FDIM.RDB$DIMENSION';  {do not localize}

{ TIBExtract }

{	                ArrayDimensions
   Functional description
   Retrieves the dimensions of arrays and prints them.

  	Parameters:  fieldname -- the actual name of the array field }

function TIBExtract.GetArrayField(FieldName: String): String;
var
  qryArray : TIBSQL;
begin
  qryArray := CreateIBSQL;
  Result := '[';   {do not localize}
  qryArray.SQL.Add(ArraySQL);
  qryArray.Params.ByName('FieldName').AsTrimString := FieldName;  {do not localize}
  qryArray.ExecQuery;

    {  Format is [lower:upper, lower:upper,..]  }

  while not qryArray.Eof do
  begin
    if (qryArray.FieldByName('RDB$DIMENSION').AsInteger > 0) then  {do not localize}
      Result := Result + ', ';      {do not localize}
    Result := Result + qryArray.FieldByName('RDB$LOWER_BOUND').AsTrimString + ':' +  {do not localize}
           qryArray.FieldByName('RDB$UPPER_BOUND').AsTrimString;   {do not localize}
    qryArray.Next;
  end;

  Result := Result + '] '; {do not localize}
  qryArray.Free;
  
end;

constructor TIBExtract.Create(AOwner: TComponent);
begin
  inherited;
  FMetaData := TStringList.Create;
  FDatabaseInfo := TIBDatabaseInfo.Create(nil);
  FDatabaseInfo.Database := FDatabase;
  if AOwner is TIBDatabase then
    Database := TIBDatabase(AOwner);
  if AOwner is TIBTransaction then
    Transaction := TIBTransaction(AOwner);
end;

destructor TIBExtract.Destroy;
begin
  FMetaData.Free;
  FDatabasEInfo.Free;
  inherited;
end;

function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String) : Boolean;
var
	DidConnect : Boolean;
	DidStart : Boolean;
begin
  Result := true;
  DidConnect := false;