ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBExtract.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBExtract.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 16 | Line 16
16   {    IBX Version 4.2 or higher required                                  }
17   {    Contributor(s): Jeff Overcash                                       }
18   {                                                                        }
19 + {    IBX For Lazarus (Firebird Express)                                  }
20 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
21 + {    Portions created by MWA Software are copyright McCallum Whyman      }
22 + {    Associates Ltd 2011 - 2018                                               }
23 + {                                                                        }
24   {************************************************************************}
25  
26 + { Syntax Enhancements Supported (by Firebird Version no.):
27 +
28 + Multi-action triggers (1.5)
29 + CREATE SEQUENCE (2.0)
30 + Database Triggers (2.1)
31 + Global Temporary Tables (2.1)
32 + Boolean Type (3.0)
33 + Identity Column Type (3.0)
34 + DDL Triggers (3.0)
35 + }
36 +
37   unit IBExtract;
38  
39   {$Mode Delphi}
40 + {$codepage UTF8}
41  
42   interface
43  
44   uses
45 < {$IFDEF LINUX }
29 <  unix,
30 < {$ELSE}
45 > {$IFDEF WINDOWS }
46    Windows,
47 + {$ELSE}
48 +  unix,
49   {$ENDIF}
50 <  Messages, SysUtils, Classes, IBDatabase, IBDatabaseInfo,
51 <  IBSQL, IBUtils, IBHeader, IB, IBIntf;
50 >  SysUtils, Classes, IBDatabase, IBDatabaseInfo,
51 >  IBSQL, IBUtils, IBHeader, IB;
52  
53   type
54    TExtractObjectTypes =
# Line 41 | Line 58 | type
58  
59    TExtractType =
60      (etDomain, etTable, etRole, etTrigger, etForeign,
61 <     etIndex, etData, etGrant, etCheck);
61 >     etIndex, etData, etGrant, etCheck, etGrantsToUser);
62  
63    TExtractTypes = Set of TExtractType;
64  
65 +  TProcDDLType = (pdCreateProc,pdCreateStub,pdAlterProc);
66 +
67 +  { TIBExtract }
68 +
69    TIBExtract = class(TComponent)
70    private
71      FDatabase : TIBDatabase;
# Line 53 | Line 74 | type
74      FDatabaseInfo: TIBDatabaseInfo;
75      FShowSystem: Boolean;
76      { Private declarations }
77 +    procedure Add2MetaData(const Msg: string; IsError: boolean=true);
78      function GetDatabase: TIBDatabase;
79      function GetIndexSegments ( indexname : String) : String;
80      function GetTransaction: TIBTransaction;
81 +    function GetTriggerType(TypeID: Int64): string;
82      procedure SetDatabase(const Value: TIBDatabase);
83      procedure SetTransaction(const Value: TIBTransaction);
84      function PrintValidation(ToValidate : String;       flag : Boolean) : String;
85 <    procedure ShowGrants(MetaObject: String; Terminator : String);
85 >    procedure ShowGrants(MetaObject: String; Terminator : String; NoUserGrants: boolean=false);
86 >    procedure ShowGrantsTo(MetaObject: String; ObjectType: integer;
87 >      Terminator: String);
88      procedure ShowGrantRoles(Terminator : String);
89      procedure GetProcedureArgs(Proc : String);
90    protected
91 <    function ExtractDDL(Flag : Boolean; TableName : String) : Boolean;
92 <    function ExtractListTable(RelationName, NewName : String; DomainFlag : Boolean) : Boolean;
91 >    function ExtractDDL(Flag: Boolean; TableName: String; ExtractTypes: TExtractTypes =
92 >      []): Boolean;
93 >    function ExtractListTable(RelationName, NewName: String; DomainFlag: Boolean): Boolean;
94      procedure ExtractListView (ViewName : String);
95      procedure ListData(ObjectName : String);
96 <    procedure ListRoles(ObjectName : String = '');
97 <    procedure ListGrants;
98 <    procedure ListProcs(ProcedureName : String = '');
96 >    procedure ListRoles(ObjectName : String = ''; IncludeGrants:boolean=false);
97 >    procedure ListGrants(ExtractTypes : TExtractTypes = []);
98 >    procedure ListProcs(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
99 >      IncludeGrants:boolean=false);
100      procedure ListAllTables(flag : Boolean);
101 <    procedure ListTriggers(ObjectName : String = ''; ExtractType : TExtractType = etTrigger);
101 >    procedure ListTriggers(ObjectName: String=''; ExtractTypes: TExtractTypes = [etTrigger]);
102      procedure ListCheck(ObjectName : String = ''; ExtractType : TExtractType = etCheck);
103      function PrintSet(var Used : Boolean) : String;
104      procedure ListCreateDb(TargetDb : String = '');
# Line 80 | Line 107 | type
107      procedure ListFilters(FilterName : String = '');
108      procedure ListForeign(ObjectName : String = ''; ExtractType : TExtractType = etForeign);
109      procedure ListFunctions(FunctionName : String = '');
110 <    procedure ListGenerators(GeneratorName : String = '');
110 >    procedure ListGenerators(GeneratorName : String = ''; ExtractTypes: TExtractTypes=[]);
111      procedure ListIndex(ObjectName : String = ''; ExtractType : TExtractType = etIndex);
112      procedure ListViews(ViewName : String = '');
113 +    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
114  
115      { Protected declarations }
116    public
# Line 93 | Line 121 | type
121      function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
122        FieldPrec, FieldLen : Integer) : String;
123      function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
96    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
124      procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
125        ExtractTypes : TExtractTypes = []);
126      property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
# Line 116 | Line 143 | type
143      PrivString : String;
144    end;
145  
146 <  TSQLTypes = Array[0..13] of TSQLType;
146 >  TSQLTypes = Array[0..14] of TSQLType;
147  
148   const
149  
# Line 127 | Line 154 | const
154    priv_DELETE = 16;
155    priv_EXECUTE = 32;
156    priv_REFERENCES = 64;
157 +  priv_USAGE = 128;
158  
159 < PrivTypes : Array[0..5] of TPrivTypes = (
159 > PrivTypes : Array[0..6] of TPrivTypes = (
160    (PrivFlag : priv_DELETE; PrivString : 'DELETE' ),
161    (PrivFlag : priv_EXECUTE; PrivString : 'EXECUTE' ),
162    (PrivFlag : priv_INSERT; PrivString : 'INSERT' ),
163    (PrivFlag : priv_SELECT; PrivString : 'SELECT' ),
164    (PrivFlag : priv_UPDATE; PrivString : 'UPDATE' ),
165 <  (PrivFlag : priv_REFERENCES; PrivString : 'REFERENCES'));
165 >  (PrivFlag : priv_REFERENCES; PrivString : 'REFERENCES'),
166 >  (PrivFlag : priv_USAGE; PrivString : 'USAGE' ));
167  
168          ColumnTypes : TSQLTypes = (
169      (SqlType : blr_short; TypeName :    'SMALLINT'),            { NTX: keyword }
# Line 150 | Line 179 | const
179      (SqlType : blr_sql_time; TypeName : 'TIME'),                { NTX: keyword }
180      (SqlType : blr_sql_date; TypeName : 'DATE'),                { NTX: keyword }
181      (SqlType : blr_timestamp; TypeName : 'TIMESTAMP'),          { NTX: keyword }
182 <    (SqlType : blr_int64; TypeName : 'INT64'));
182 >    (SqlType : blr_int64; TypeName : 'INT64'),
183 >    (SqlType : blr_bool; TypeName : 'BOOLEAN'));
184  
185    SubTypes : Array[0..8] of String = (
186      'UNKNOWN',                  { NTX: keyword }
# Line 163 | Line 193 | const
193      'TRANSACTION_DESCRIPTION',  { NTX: keyword }
194      'EXTERNAL_FILE_DESCRIPTION');       { NTX: keyword }
195  
166  TriggerTypes : Array[0..6] of String = (
167    '',
168    'BEFORE INSERT',                    { NTX: keyword }
169    'AFTER INSERT',                             { NTX: keyword }
170    'BEFORE UPDATE',                    { NTX: keyword }
171    'AFTER UPDATE',                             { NTX: keyword }
172    'BEFORE DELETE',                    { NTX: keyword }
173    'AFTER DELETE');                    { NTX: keyword }
174
196    IntegralSubtypes : Array[0..2] of String = (
197      'UNKNOWN',                  { Defined type, NTX: keyword }
198      'NUMERIC',                  { NUMERIC, NTX: keyword }
# Line 184 | Line 205 | const
205    ODS_VERSION10 = 10; { V6.0 features. SQL delimited idetifier,
206                                          SQLDATE, and 64-bit exact numeric
207                                          type }
208 +  ODS_VERSION12 = 12; {Firebird 3}
209  
210    { flags for RDB$FILE_FLAGS }
211    FILE_shadow = 1;
# Line 222 | Line 244 | const
244  
245   implementation
246  
247 + uses FBMessages, IBDataOutput;
248 +
249   const
226  NEWLINE = #13#10;
250    TERM = ';';
251    ProcTerm = '^';
252  
# Line 252 | Line 275 | const
275      '  FDIM.RDB$FIELD_NAME = :FIELDNAME ' +
276      'ORDER BY FDIM.RDB$DIMENSION';
277  
278 + type
279 +  TTriggerPhase = (tpNone,tpCreate,tpAlter,tpDrop);
280 +
281 +  TDDLTriggerMap = record
282 +    ObjectName: string;
283 +    Bits: integer;
284 +    Bit1: TTriggerPhase;
285 +    Bit2: TTriggerPhase;
286 +    Bit3: TTriggerPhase;
287 +  end;
288 +
289 + const
290 +  DDLTriggers : array [0..15] of TDDLTriggerMap = (
291 +  (ObjectName: 'TABLE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
292 +  (ObjectName: 'PROCEDURE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
293 +  (ObjectName: 'FUNCTION'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
294 +  (ObjectName: 'TRIGGER'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
295 +  (ObjectName: 'Empty slot'; Bits: 3; Bit1: tpNone; Bit2: tpNone; Bit3: tpNone),
296 +  (ObjectName: 'EXCEPTION'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
297 +  (ObjectName: 'VIEW'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
298 +  (ObjectName: 'DOMAIN'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
299 +  (ObjectName: 'ROLE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
300 +  (ObjectName: 'INDEX'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
301 +  (ObjectName: 'SEQUENCE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
302 +  (ObjectName: 'USER'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
303 +  (ObjectName: 'COLLATION'; Bits: 2; Bit1: tpCreate; Bit2: tpDrop; Bit3: tpNone),
304 +  (ObjectName: 'CHARACTER SET'; Bits: 1; Bit1: tpAlter; Bit2: tpNone; Bit3: tpNone),
305 +  (ObjectName: 'PACKAGE'; Bits: 3; Bit1: tpCreate; Bit2: tpAlter; Bit3: tpDrop),
306 +  (ObjectName: 'PACKAGE BODY'; Bits: 2; Bit1: tpCreate; Bit2: tpDrop; Bit3: tpNone)
307 + );
308 +
309   { TIBExtract }
310  
311   {                       ArrayDimensions
# Line 265 | Line 319 | var
319    qryArray : TIBSQL;
320   begin
321    qryArray := TIBSQL.Create(FDatabase);
322 <  Result := '[';
322 >  Result := '';
323    qryArray.SQL.Add(ArraySQL);
324    qryArray.Params.ByName('FieldName').AsString := FieldName;
325    qryArray.ExecQuery;
326  
327      {  Format is [lower:upper, lower:upper,..]  }
328  
329 <  while not qryArray.Eof do
329 >  if not qryArray.Eof then
330    begin
331 <    if (qryArray.FieldByName('RDB$DIMENSION').AsInteger > 0) then
332 <      Result := Result + ', ';
333 <    Result := Result + qryArray.FieldByName('RDB$LOWER_BOUND').AsString + ':' +
334 <           qryArray.FieldByName('RDB$UPPER_BOUND').AsString;
335 <    qryArray.Next;
331 >    Result := '[';
332 >    while not qryArray.Eof do
333 >    begin
334 >      if (qryArray.FieldByName('RDB$DIMENSION').AsInteger > 0) then
335 >        Result := Result + ', ';
336 >      Result := Result + qryArray.FieldByName('RDB$LOWER_BOUND').AsString + ':' +
337 >             qryArray.FieldByName('RDB$UPPER_BOUND').AsString;
338 >      qryArray.Next;
339 >    end;
340 >    Result := Result + '] ';
341    end;
342  
284  Result := Result + '] ';
343    qryArray.Free;
344    
345   end;
# Line 305 | Line 363 | begin
363    inherited;
364   end;
365  
366 < function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String) : Boolean;
366 > function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String;
367 >  ExtractTypes: TExtractTypes): Boolean;
368   var
369          DidConnect : Boolean;
370          DidStart : Boolean;
# Line 321 | Line 380 | begin
380    end;
381  
382    FMetaData.Add(Format('SET SQL DIALECT %d;', [FDatabase.SQLDialect]));
383 +  FMetaData.Add('SET AUTODDL ON;');
384    FMetaData.Add('');
385  
386    if not FTransaction.Active then
# Line 341 | Line 401 | begin
401      ListFunctions;
402      ListDomains;
403      ListAllTables(flag);
404 +    if etData in ExtractTypes then
405 +      ListData('');
406      ListIndex;
407      ListForeign;
408 <    ListGenerators;
408 >    if etData in ExtractTypes then
409 >      ListGenerators('',[etData])
410 >    else
411 >      ListGenerators;
412      ListViews;
413      ListCheck;
414      ListException;
415 <    ListProcs;
415 >    ListProcs(pdCreateStub);
416      ListTriggers;
417 <    ListGrants;
417 >    ListProcs(pdAlterProc);
418 >    ListGrants(ExtractTypes);
419    end;
420  
421    if DidStart then
# Line 370 | Line 436 | end;
436          domain_flag -- extract needed domains before the table }
437  
438   function TIBExtract.ExtractListTable(RelationName, NewName: String;
439 <  DomainFlag: Boolean) : Boolean;
439 >  DomainFlag: Boolean): Boolean;
440   const
441    TableListSQL =
442      'SELECT * FROM RDB$RELATIONS REL JOIN RDB$RELATION_FIELDS RFR ON ' + {Do Not Localize}
# Line 395 | Line 461 | const
461      '  (RELC.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR ' +
462      '  RELC.RDB$CONSTRAINT_TYPE = ''UNIQUE'') AND ' +
463      '  RELC.RDB$RELATION_NAME = :RELATIONNAME ' +
464 <    'ORDER BY RELC.RDB$CONSTRAINT_NAME';
464 >    'ORDER BY RELC.RDB$CONSTRAINT_TYPE desc, RELC.RDB$CONSTRAINT_NAME';
465 >
466 >  GetGeneratorSQL =
467 >    'SELECT * FROM RDB$GENERATORS WHERE RDB$GENERATOR_NAME = :GENERATOR';
468  
469   var
470    Collation, CharSetId : integer;
471          i : integer;
472 <  ColList, Column, Constraint : String;
472 >  Column, Constraint : String;
473    SubType : integer;
474    IntChar : integer;
475 <  qryTables, qryPrecision, qryConstraints, qryRelConstraints : TIBSQL;
475 >  qryTables, qryPrecision, qryConstraints, qryRelConstraints, qryGenerators : TIBSQL;
476    PrecisionKnown, ValidRelation : Boolean;
477    FieldScale, FieldType : Integer;
478 +  CreateTable: string;
479 +  TableType: integer;
480   begin
481    Result := true;
411  ColList := '';
482    IntChar := 0;
483    ValidRelation := false;
484  
# Line 418 | Line 488 | begin
488    qryPrecision := TIBSQL.Create(FDatabase);
489    qryConstraints := TIBSQL.Create(FDatabase);
490    qryRelConstraints := TIBSQL.Create(FDatabase);
491 +  qryGenerators := TIBSQL.Create(FDatabase);
492    try
493      qryTables.SQL.Add(TableListSQL);
494 +    RelationName := trim(RelationName);
495      qryTables.Params.ByName('RelationName').AsString := RelationName;
496      qryTables.ExecQuery;
497      qryPrecision.SQL.Add(PrecisionSQL);
498      qryConstraints.SQL.Add(ConstraintSQL);
499      qryRelConstraints.SQL.Add(RelConstraintsSQL);
500 +    qryGenerators.SQL.Add(GetGeneratorSQL);
501      if not qryTables.Eof then
502      begin
503        ValidRelation := true;
504 +      TableType := qryTables.FieldByName('RDB$RELATION_TYPE').AsInteger;
505        if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and
506           (Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsString) <> '') then
507          FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',
508 <          [NEWLINE, RelationName,
509 <           qryTables.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
508 >          [LineEnding, RelationName,
509 >           qryTables.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
510 >      if TableType > 3 then
511 >       CreateTable := 'CREATE GLOBAL TEMPORARY TABLE'
512 >      else
513 >        CreateTable := 'CREATE TABLE';
514        if NewName <> '' then
515 <        FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
515 >        FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
516        else
517 <        FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
517 >        FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
518        if not qryTables.FieldByName('RDB$EXTERNAL_FILE').IsNull then
519          FMetaData.Add(Format('EXTERNAL FILE %s ',
520            [QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsString)]));
# Line 466 | Line 544 | begin
544            (qryTables.FieldByName('RDB$FIELD_NAME1').AsString[5] in ['0'..'9'])) and
545            (qryTables.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
546          begin
547 <          Column := Column + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME1').AsString);
547 >          Column := Column + QuoteIdentifier(FDatabase.SQLDialect, trim(qryTables.FieldByName('RDB$FIELD_NAME1').AsString));
548            { International character sets }
549            if (qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying])
550                and (not qryTables.FieldByName('RDB$COLLATION_ID').IsNull)
# Line 538 | Line 616 | begin
616  
617            { Catch arrays after printing the type  }
618  
619 <          if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull then
620 <            Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_NAME').AsString);
619 >          if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull and (qryTables.FieldByName('RDB$DIMENSIONS').AsInteger > 0) then
620 >            Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_SOURCE').AsString);
621  
622            if FieldType = blr_blob then
623            begin
# Line 570 | Line 648 | begin
648            end;
649          end;
650  
651 +        {Firebird 3 introduces IDENTITY columns. We need to check for them here}
652 +        if qryTables.HasField('RDB$GENERATOR_NAME') and not qryTables.FieldByName('RDB$GENERATOR_NAME').IsNull then
653 +        begin
654 +          qryGenerators.ParamByName('GENERATOR').AsString :=  qryTables.FieldByName('RDB$GENERATOR_NAME').AsString;
655 +          qryGenerators.ExecQuery;
656 +          if not qryGenerators.Eof then
657 +          begin
658 +            Column := Column + Format(' GENERATED BY DEFAULT AS IDENTITY START WITH %d',
659 +                     [qryGenerators.FieldByName('RDB$INITIAL_VALUE').AsInteger]);
660 +          end;
661 +          qryGenerators.Close;
662 +        end;
663 +
664          { Handle defaults for columns }
665          { Originally This called PrintMetadataTextBlob,
666              should no longer need }
# Line 656 | Line 747 | begin
747        qryRelConstraints.Next;
748      end;
749      if ValidRelation then
750 <      FMetaData.Add(')' + Term);
750 >    begin
751 >      if TableType = 4 then
752 >        FMetaData.Add(' ) ON COMMIT PRESERVE ROWS ' + TERM)
753 >      else
754 >       FMetaData.Add(')' + TERM);
755 >    end;
756    finally
757      qryTables.Free;
758      qryPrecision.Free;
759      qryConstraints.Free;
760      qryRelConstraints.Free;
761 +    qryGenerators.Free;
762    end;
763   end;
764  
# Line 690 | Line 787 | var
787    qryViews, qryColumns : TIBSQL;
788    RelationName, ColList : String;
789   begin
790 +  ColList := '';
791    qryViews := TIBSQL.Create(FDatabase);
792    qryColumns := TIBSQL.Create(FDatabase);
793    try
# Line 735 | Line 833 | var
833    CharSetSQL : TIBSQL;
834    DidActivate : Boolean;
835   begin
836 +  Result := '';
837    if not FTransaction.Active then
838    begin
839      FTransaction.StartTransaction;
# Line 782 | Line 881 | begin
881      FTransaction.Commit;
882   end;
883  
884 + procedure TIBExtract.Add2MetaData(const Msg: string; IsError: boolean);
885 + begin
886 +  FMetaData.Add(Msg);
887 + end;
888 +
889   function TIBExtract.GetDatabase: TIBDatabase;
890   begin
891    result := FDatabase;
# Line 791 | Line 895 | end;
895     Functional description
896          returns the list of columns in an index. }
897  
898 < function TIBExtract.GetIndexSegments(IndexName: String): String;
898 > function TIBExtract.GetIndexSegments(indexname: String): String;
899   const
900    IndexNamesSQL =
901      'SELECT * FROM RDB$INDEX_SEGMENTS SEG ' +
# Line 828 | Line 932 | begin
932    Result := FTransaction;
933   end;
934  
935 + function TIBExtract.GetTriggerType(TypeID: Int64): string;
936 + const
937 +  AllDDLTriggers = $7FFFFFFFFFFFDFFF shr 1;
938 + var separator: string;
939 +    i: integer;
940 +
941 +  function GetDDLEvent(Phase: TTriggerPhase; ObjectName: string): string;
942 +  begin
943 +    Result := '';
944 +    case Phase of
945 +    tpCreate:
946 +     Result := separator + 'CREATE ' + ObjectName;
947 +    tpAlter:
948 +     Result := separator + 'ALTER ' + ObjectName;
949 +    tpDrop:
950 +     Result := separator + 'Drop ' + ObjectName;
951 +    end;
952 +    if Result <> '' then
953 +      separator := ' OR ';
954 +  end;
955 +
956 + begin
957 +  if TypeID and $2000 <> 0 then
958 +  {database trigger}
959 +  begin
960 +    Result := 'ON ';
961 +    case TypeID of
962 +    $2000:
963 +      Result += 'CONNECT';
964 +    $2001:
965 +      Result += 'DISCONNECT';
966 +    $2002:
967 +      Result +='TRANSACTION START';
968 +    $2003:
969 +      Result += 'TRANSACTION COMMIT';
970 +    $2004:
971 +      Result += 'TRANSACTION ROLLBACK';
972 +    end;
973 +  end
974 +  else
975 +  if TypeID and $4000 <> 0 then
976 +  {DDL Trigger}
977 +  begin
978 +    if TypeID and $01 <> 0 then
979 +      Result := 'AFTER '
980 +    else
981 +      Result := 'BEFORE ';
982 +    TypeID := TypeID shr 1;
983 +    separator := '';
984 +    i := 0;
985 +    if TypeID = AllDDLTriggers then
986 +      Result += 'ANY DDL STATEMENT'
987 +    else
988 +      repeat
989 +        if (DDLTriggers[i].Bits > 0) and (TypeID and $01 <> 0) then
990 +         Result += GetDDLEvent(DDLTriggers[i].Bit1,DDLTriggers[i].ObjectName);
991 +
992 +        if (DDLTriggers[i].Bits > 1) and (TypeID and $02 <> 0) then
993 +          Result += GetDDLEvent(DDLTriggers[i].Bit2,DDLTriggers[i].ObjectName);
994 +
995 +        if (DDLTriggers[i].Bits > 2) and (TypeID and $04 <> 0) then
996 +          Result += GetDDLEvent(DDLTriggers[i].Bit3,DDLTriggers[i].ObjectName);
997 +        TypeID := TypeID shr DDLTriggers[i].Bits;
998 +        Inc(i);
999 +      until TypeID = 0;
1000 +  end
1001 +  else
1002 +  {Normal Trigger}
1003 +  begin
1004 +    Inc(TypeID);
1005 +    if TypeID and $01 <> 0 then
1006 +      Result := 'AFTER '
1007 +    else
1008 +      Result := 'BEFORE ';
1009 +    TypeID := TypeID shr 1;
1010 +    separator := '';
1011 +    repeat
1012 +      Result += separator;
1013 +      separator := ' or ';
1014 +      case TypeID and $03 of
1015 +      1:
1016 +        Result += 'INSERT';
1017 +      2:
1018 +        Result += 'UPDATE';
1019 +      3:
1020 +        Result += 'DELETE';
1021 +      end;
1022 +      TypeID := TypeID shr 2;
1023 +    until TypeID = 0
1024 +  end
1025 + end;
1026 +
1027   {          ListAllGrants
1028    Functional description
1029           Print the permissions on all user tables.
1030           Get separate permissions on table/views and then procedures }
1031  
1032 < procedure TIBExtract.ListGrants;
1032 > procedure TIBExtract.ListGrants(ExtractTypes: TExtractTypes);
1033   const
1034    SecuritySQL = 'SELECT * FROM RDB$RELATIONS ' +
1035                  'WHERE ' +
# Line 841 | Line 1037 | const
1037                  '  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
1038                  'ORDER BY RDB$RELATION_NAME';
1039  
1040 <  ProcedureSQL = 'select * from RDB$PROCEDURES ' +
1040 >  DomainSQL  = 'select RDB$FIELD_NAME from RDB$FIELDS '+
1041 >    'where RDB$SYSTEM_FLAG <> 1 and RDB$FIELD_NAME not Similar to ''RDB$%|SEC$%|MON$%|SQL$%'' '+
1042 >    'order BY RDB$FIELD_NAME';
1043 >
1044 >  CharacterSetSQL = 'Select * From RDB$CHARACTER_SETS  '+
1045 >                    'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1046 >                    'Order by RDB$CHARACTER_SET_NAME';
1047 >
1048 >  CollationsSQL = 'Select * From RDB$COLLATIONS  '+
1049 >                    'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1050 >                    'Order by RDB$COLLATION_NAME';
1051 >
1052 >  ProcedureSQL = 'select * from RDB$PROCEDURES '+
1053 >                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1054                   'Order BY RDB$PROCEDURE_NAME';
1055  
1056 +  ExceptionSQL = 'select * from RDB$EXCEPTIONS '+
1057 +                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1058 +                 'Order BY RDB$EXCEPTION_NAME';
1059 +
1060 +  GeneratorSQL = 'select * from RDB$GENERATORS '+
1061 +                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1062 +                 'Order BY RDB$GENERATOR_NAME';
1063 +
1064 +  MetadataGrantsSQL =
1065 +  'Select PR.RDB$USER, PR.RDB$USER_TYPE, '+
1066 +  'T.RDB$TYPE_NAME as USER_TYPE_NAME, '+
1067 +  'Case PR.RDB$PRIVILEGE '+
1068 +  '  When ''C'' then ''CREATE'' '+
1069 +  '  When ''O'' then ''DROP ANY'' '+
1070 +  '  When ''L'' then ''ALTER ANY''  End as Privilege, '+
1071 +  'Case PR.RDB$RELATION_NAME '+
1072 +  '  When ''SQL$COLLATIONS'' then ''COLLATION'' '+
1073 +  '  When ''SQL$CHARSETS'' then ''CHARACTER SET'' '+
1074 +  '  When ''SQL$DATABASE'' then ''DATABASE'' '+
1075 +  '  When ''SQL$DOMAINS'' then ''DOMAIN'' '+
1076 +  '  When ''SQL$EXCEPTIONS'' then ''EXCEPTION'' '+
1077 +  '  When ''SQL$FILTERS'' then ''FILTER'' '+
1078 +  '  When ''SQL$FUNCTIONS'' then ''FUNCTION'' '+
1079 +  '  When ''SQL$GENERATORS'' then ''GENERATOR'' '+
1080 +  '  When ''SQL$PACKAGES'' then ''PACKAGE'' '+
1081 +  '  When ''SQL$PROCEDURES'' then ''PROCEDURE'' '+
1082 +  '  When ''SQL$ROLES'' then ''ROLE'' '+
1083 +  '  When ''SQL$VIEWS'' then ''VIEW'' '+
1084 +  '  When ''SQL$TABLES'' then ''TABLE'' End as METAOBJECTNAME,'+
1085 +
1086 +  'case when coalesce(RDB$GRANT_OPTION,0) <> 0 then '' WITH GRANT OPTION'' '+
1087 +  'ELSE '''' End as GRANTOPTION '+
1088 +  'FROM RDB$USER_PRIVILEGES PR '+
1089 +  'JOIN RDB$TYPES T On T.RDB$TYPE = PR.RDB$USER_TYPE and T.RDB$FIELD_NAME = ''RDB$OBJECT_TYPE'' '+
1090 +  'Where PR.RDB$RELATION_NAME like ''SQL$%'' and PR.RDB$PRIVILEGE in (''L'',''C'',''O'')';
1091 +
1092   var
1093    qryRoles : TIBSQL;
1094    RelationName : String;
# Line 864 | Line 1109 | begin
1109        while not qryRoles.Eof do
1110        begin
1111          RelationName := Trim(qryRoles.FieldByName('rdb$relation_Name').AsString);
1112 <        ShowGrants(RelationName, Term);
1112 >        ShowGrants(RelationName, Term, not (etGrantsToUser in ExtractTypes));
1113          qryRoles.Next;
1114        end;
1115      finally
# Line 873 | Line 1118 | begin
1118  
1119      ShowGrantRoles(Term);
1120  
1121 +    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
1122 +    begin
1123 +      qryRoles.SQL.Text := DomainSQL;
1124 +      qryRoles.ExecQuery;
1125 +      try
1126 +        while not qryRoles.Eof do
1127 +        begin
1128 +          ShowGrants(Trim(qryRoles.FieldByName('RDB$FIELD_NAME').AsString), Term,
1129 +                  not (etGrantsToUser in ExtractTypes));
1130 +          qryRoles.Next;
1131 +        end;
1132 +      finally
1133 +        qryRoles.Close;
1134 +      end;
1135 +
1136 +      qryRoles.SQL.Text := CharacterSetSQL;
1137 +      qryRoles.ExecQuery;
1138 +      try
1139 +        while not qryRoles.Eof do
1140 +        begin
1141 +          ShowGrants(Trim(qryRoles.FieldByName('RDB$CHARACTER_SET_NAME').AsString), Term,
1142 +              not (etGrantsToUser in ExtractTypes));
1143 +          qryRoles.Next;
1144 +        end;
1145 +      finally
1146 +        qryRoles.Close;
1147 +      end;
1148 +
1149 +      qryRoles.SQL.Text := CollationsSQL;
1150 +      qryRoles.ExecQuery;
1151 +      try
1152 +        while not qryRoles.Eof do
1153 +        begin
1154 +          ShowGrants(Trim(qryRoles.FieldByName('RDB$COLLATION_NAME').AsString), Term,
1155 +                 not (etGrantsToUser in ExtractTypes));
1156 +          qryRoles.Next;
1157 +        end;
1158 +      finally
1159 +        qryRoles.Close;
1160 +      end;
1161 +
1162 +      qryRoles.SQL.Text := ExceptionSQL;
1163 +      qryRoles.ExecQuery;
1164 +      try
1165 +        while not qryRoles.Eof do
1166 +        begin
1167 +          ShowGrants(Trim(qryRoles.FieldByName('RDB$EXCEPTION_NAME').AsString), Term,
1168 +                     not (etGrantsToUser in ExtractTypes));
1169 +          qryRoles.Next;
1170 +        end;
1171 +      finally
1172 +        qryRoles.Close;
1173 +      end;
1174 +
1175 +      qryRoles.SQL.Text := GeneratorSQL;
1176 +      qryRoles.ExecQuery;
1177 +      try
1178 +        while not qryRoles.Eof do
1179 +        begin
1180 +          ShowGrants(Trim(qryRoles.FieldByName('RDB$GENERATOR_NAME').AsString), Term,
1181 +                 not (etGrantsToUser in ExtractTypes));
1182 +          qryRoles.Next;
1183 +        end;
1184 +      finally
1185 +        qryRoles.Close;
1186 +      end;
1187 +    end;
1188 +
1189      qryRoles.SQL.Text := ProcedureSQL;
1190      qryRoles.ExecQuery;
1191      try
1192        while not qryRoles.Eof do
1193        begin
1194 <        ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsString), Term);
1194 >        ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsString), Term,
1195 >                not (etGrantsToUser in ExtractTypes));
1196          qryRoles.Next;
1197        end;
1198      finally
1199        qryRoles.Close;
1200      end;
1201 +
1202 +    {Metadata Grants}
1203 +    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
1204 +    begin
1205 +      qryRoles.SQL.Text := MetadataGrantsSQL;
1206 +      qryRoles.ExecQuery;
1207 +      while not qryRoles.Eof do
1208 +      begin
1209 +        if (etGrantsToUser in ExtractTypes) or
1210 +           (qryRoles.FieldByName('RDB$USER_TYPE').AsInteger <> obj_user) or
1211 +           (qryRoles.FieldByName('RDB$USER').AsString = 'PUBLIC') then
1212 +        FMetaData.Add(Format('GRANT %s %s TO %s "%s" %s%s', [
1213 +                              qryRoles.FieldByName('Privilege').AsString,
1214 +                              qryRoles.FieldByName('METAOBJECTNAME').AsString,
1215 +                              qryRoles.FieldByName('USER_TYPE_NAME').AsString,
1216 +                              qryRoles.FieldByName('RDB$USER').AsString,
1217 +                              qryRoles.FieldByName('GRANTOPTION').AsString,
1218 +                              Term]));
1219 +        qryRoles.Next;
1220 +      end;
1221 +      qryRoles.Close;
1222 +    end;
1223    finally
1224      qryRoles.Free;
1225    end;
# Line 900 | Line 1236 | end;
1236  
1237           procname -- Name of procedure to investigate }
1238  
1239 < procedure TIBExtract.ListProcs(ProcedureName : String);
1239 > procedure TIBExtract.ListProcs(ProcDDLType: TProcDDLType;
1240 >  ProcedureName: String; IncludeGrants: boolean);
1241   const
1242    CreateProcedureStr1 = 'CREATE PROCEDURE %s ';
1243    CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';
1244 <  ProcedureSQL =
1245 <    'SELECT * FROM RDB$PROCEDURES ' +
1246 <    'ORDER BY RDB$PROCEDURE_NAME';
1244 >  ProcedureSQL =  {Order procedures by dependency order and then procedure name}
1245 >                  'with recursive Procs as ( ' +
1246 >                  'Select RDB$PROCEDURE_NAME, 1 as ProcLevel from RDB$PROCEDURES ' +
1247 >                  'UNION ALL ' +
1248 >                  'Select D.RDB$DEPENDED_ON_NAME, ProcLevel + 1 From RDB$DEPENDENCIES D ' +
1249 >                  'JOIN Procs on Procs.RDB$PROCEDURE_NAME = D.RDB$DEPENDENT_NAME ' +
1250 >                  '  and Procs.RDB$PROCEDURE_NAME <> D.RDB$DEPENDED_ON_NAME ' +
1251 >                  'JOIN RDB$PROCEDURES P On P.RDB$PROCEDURE_NAME = D.RDB$DEPENDED_ON_NAME ' +
1252 >                  '  ) ' +
1253 >                  'SELECT * FROM RDB$PROCEDURES P ' +
1254 >                  'JOIN ( ' +
1255 >                  'Select RDB$PROCEDURE_NAME, max(ProcLevel) as ProcLevel From Procs ' +
1256 >                  'Group By RDB$PROCEDURE_NAME) A On A.RDB$PROCEDURE_NAME = P.RDB$PROCEDURE_NAME ' +
1257 >                  'Order by A.ProcLevel desc, P.RDB$PROCEDURE_NAME asc';
1258  
1259    ProcedureNameSQL =
1260      'SELECT * FROM RDB$PROCEDURES ' +
# Line 918 | Line 1266 | var
1266    ProcName : String;
1267    SList : TStrings;
1268    Header : Boolean;
1269 +
1270   begin
1271  
1272    Header := true;
1273    qryProcedures := TIBSQL.Create(FDatabase);
1274    SList := TStringList.Create;
1275    try
927 {  First the dummy procedures
928    create the procedures with their parameters }
1276      if ProcedureName = '' then
1277        qryProcedures.SQL.Text := ProcedureSQL
1278      else
# Line 933 | Line 1280 | begin
1280        qryProcedures.SQL.Text := ProcedureNameSQL;
1281        qryProcedures.Params.ByName('ProcedureName').AsString := ProcedureName;
1282      end;
1283 +
1284      qryProcedures.ExecQuery;
1285      while not qryProcedures.Eof do
1286      begin
# Line 941 | Line 1289 | begin
1289          FMetaData.Add('COMMIT WORK;');
1290          FMetaData.Add('SET AUTODDL OFF;');
1291          FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term]));
1292 <        FMetaData.Add(Format('%s/* Stored procedures */%s', [NEWLINE, NEWLINE]));
1292 >        FMetaData.Add(Format('%s/* Stored procedures */%s', [LineEnding, LineEnding]));
1293          Header := false;
1294        end;
1295        ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
948      FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
949         ProcName)]));
950      GetProcedureArgs(ProcName);
951      FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, NEWLINE]));
952      qryProcedures.Next;
953    end;
1296  
1297 <    qryProcedures.Close;
1298 <    qryProcedures.ExecQuery;
1299 <    while not qryProcedures.Eof do
1300 <    begin
1301 <      SList.Clear;
1302 <      ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
1303 <      FMetaData.Add(Format('%sALTER PROCEDURE %s ', [NEWLINE,
1304 <         QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1305 <      GetProcedureArgs(ProcName);
1306 <
1307 <      if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1308 <        SList.Text := SList.Text + qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1309 <      SList.Add(Format(' %s%s', [ProcTerm, NEWLINE]));
1310 <      FMetaData.AddStrings(SList);
1297 >      case ProcDDLType of
1298 >      pdCreateStub:
1299 >        begin
1300 >          FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1301 >             ProcName)]));
1302 >          GetProcedureArgs(ProcName);
1303 >          FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1304 >        end;
1305 >
1306 >      pdCreateProc:
1307 >      begin
1308 >        FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1309 >           ProcName)]));
1310 >        GetProcedureArgs(ProcName);
1311 >        if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1312 >        begin
1313 >          SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1314 >          SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1315 >          FMetaData.AddStrings(SList);
1316 >        end
1317 >        else
1318 >          FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1319 >      end;
1320 >
1321 >      pdAlterProc:
1322 >       begin
1323 >         FMetaData.Add(Format('%sALTER PROCEDURE %s ', [LineEnding,
1324 >            QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1325 >         GetProcedureArgs(ProcName);
1326 >
1327 >         if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1328 >         begin
1329 >           SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1330 >           SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1331 >           FMetaData.AddStrings(SList);
1332 >         end
1333 >         else
1334 >           FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1335 >       end;
1336 >      end;
1337 >      if IncludeGrants then
1338 >        ShowGrantsTo(ProcName,obj_procedure,ProcTerm);
1339        qryProcedures.Next;
1340      end;
1341 <
972 < { This query gets the procedure name and the source.  We then nest a query
973 <   to retrieve the parameters. Alter is used, because the procedures are
974 <   already there}
1341 >    qryProcedures.Close;
1342  
1343      if not Header then
1344      begin
# Line 1032 | Line 1399 | end;
1399          Lists triggers in general on non-system
1400          tables with sql source only. }
1401  
1402 < procedure TIBExtract.ListTriggers(ObjectName : String; ExtractType : TExtractType);
1402 > procedure TIBExtract.ListTriggers(ObjectName: String; ExtractTypes: TExtractTypes
1403 >  );
1404   const
1405   { Query gets the trigger info for non-system triggers with
1406     source that are not part of an SQL constraint }
1407  
1408    TriggerSQL =
1409 <    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1409 >    'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1410      '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1411      'WHERE ' +
1412      ' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
# Line 1059 | Line 1427 | const
1427      '    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1428  
1429    TriggerByNameSQL =
1430 <    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1430 >    'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1431      '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1432      'WHERE ' +
1433      ' TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
# Line 1083 | Line 1451 | begin
1451        qryTriggers.SQL.Text := TriggerSQL
1452      else
1453      begin
1454 <      if ExtractType = etTable then
1454 >      if etTable in ExtractTypes  then
1455        begin
1456          qryTriggers.SQL.Text := TriggerNameSQL;
1457          qryTriggers.Params.ByName('TableName').AsString := ObjectName;
# Line 1100 | Line 1468 | begin
1468        SList.Clear;
1469        if Header then
1470        begin
1471 <        FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, NEWLINE]));
1471 >        FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, LineEnding]));
1472          FMetaData.Add(Format('%s/* Triggers only will work for SQL triggers */%s',
1473 <                       [NEWLINE, NEWLINE]));
1473 >                       [LineEnding, LineEnding]));
1474          Header := false;
1475        end;
1476        TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsString;
# Line 1118 | Line 1486 | begin
1486        if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1487          SList.Add('/* ');
1488  
1489 <      SList.Add(Format('CREATE TRIGGER %s FOR %s %s%s %s POSITION %d',
1490 <                [QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1491 <           QuoteIdentifier(FDatabase.SQLDialect, RelationName),
1492 <           NEWLINE, InActive,
1493 <           TriggerTypes[qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger],
1494 <           qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1489 >      {Database or Transaction trigger}
1490 >      SList.Add(Format('CREATE TRIGGER %s%s%s %s POSITION %d',
1491 >                [QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1492 >                LineEnding, InActive,
1493 >                GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInt64),
1494 >                qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1495 >
1496 >      if RelationName <> '' then
1497 >        SList.Add('ON ' + QuoteIdentifier(FDatabase.SQLDialect, RelationName));
1498 >
1499        if not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1500 <        SList.Text := SList.Text +
1501 <              qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1502 <      SList.Add(' ' + ProcTerm + NEWLINE);
1500 >        SList.Add(qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString)
1501 >      else
1502 >        SList.Add('AS BEGIN EXIT; END');
1503 >      SList.Add(' ' + ProcTerm);
1504        if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1505          SList.Add(' */');
1506        FMetaData.AddStrings(SList);
1507 +      if etGrant in ExtractTypes then
1508 +        ShowGrantsTo(TriggerName,obj_trigger,ProcTerm);
1509        qryTriggers.Next;
1510      end;
1511      if not Header then
# Line 1215 | Line 1590 | begin
1590        if not qryChecks.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1591          SList.Text := SList.Text + qryChecks.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1592  
1593 <      SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + NEWLINE;
1593 >      SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + LineEnding;
1594        FMetaData.AddStrings(SList);
1595        qryChecks.Next;
1596      end;
# Line 1235 | Line 1610 | const
1610    CharInfoSQL =
1611      'SELECT * FROM RDB$DATABASE DBP ' +
1612      'WHERE NOT DBP.RDB$CHARACTER_SET_NAME IS NULL ' +
1613 <    '  AND DBP.RDB$CHARACTER_SET_NAME != '' ''';
1613 >    '  AND DBP.RDB$CHARACTER_SET_NAME <> '' ''';
1614  
1615    FilesSQL =
1616      'select * from RDB$FILES ' +
# Line 1252 | Line 1627 | var
1627    FileFlags, FileLength, FileSequence, FileStart : Integer;
1628  
1629    function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
1255  var
1256    local_buffer: array[0..IBLocalBufferLength - 1] of Char;
1257    length: Integer;
1258    _DatabaseInfoCommand: Char;
1630    begin
1631 <    _DatabaseInfoCommand := Char(DatabaseInfoCommand);
1632 <    FDatabaseInfo.Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
1633 <                           IBLocalBufferLength, local_buffer), True);
1634 <    length := isc_vax_integer(@local_buffer[1], 2);
1635 <    result := isc_vax_integer(@local_buffer[3], length);
1631 >    with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
1632 >      if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
1633 >        Result := Items[0].AsInteger
1634 >      else
1635 >        IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
1636    end;
1637  
1638   begin
1639 <        NoDb := FALSE;
1639 >  NoDb := FALSE;
1640    First := TRUE;
1641    FirstFile := TRUE;
1642    HasWal := FALSE;
# Line 1278 | Line 1649 | begin
1649      NoDb := true;
1650    end;
1651    Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +
1652 <    IntToStr(FDatabaseInfo.PageSize) + NEWLINE;
1652 >    IntToStr(FDatabaseInfo.PageSize) + LineEnding;
1653    FMetaData.Add(Buffer);
1654    Buffer := '';
1655  
# Line 1287 | Line 1658 | begin
1658      qryDB.SQL.Text := CharInfoSQL;
1659      qryDB.ExecQuery;
1660  
1661 <    Buffer := Format(' DEFAULT CHARACTER SET %s',
1662 <      [qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
1661 >    if not qryDB.EOF then
1662 >      Buffer := Format(' DEFAULT CHARACTER SET %s',
1663 >        [trim(qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString)]);
1664      if NoDB then
1665 <      Buffer := Buffer + ' */'
1665 >      Buffer := Buffer + Term + ' */'
1666      else
1667        Buffer := Buffer + Term;
1668      FMetaData.Add(Buffer);
# Line 1303 | Line 1675 | begin
1675      begin
1676        if First then
1677        begin
1678 <        FMetaData.Add(NEWLINE + '/* Add secondary files in comments ');
1678 >        FMetaData.Add(LineEnding + '/* Add secondary files in comments ');
1679          First := false;
1680        end; //end_if
1681  
# Line 1328 | Line 1700 | begin
1700        if FileFlags = 0 then
1701        begin
1702          Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',
1703 <          [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1703 >          [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1704          if FileStart <> 0 then
1705            Buffer := Buffer + Format(' STARTING %d', [FileStart]);
1706          if FileLength <> 0 then
# Line 1337 | Line 1709 | begin
1709        end; //end_if
1710        if (FileFlags and FILE_cache) <> 0 then
1711          FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',
1712 <          [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1712 >          [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1713  
1714        Buffer := '';
1715        if (FileFlags and FILE_shadow) <> 0 then
# Line 1348 | Line 1720 | begin
1720          else
1721          begin
1722            Buffer := Format('%sCREATE SHADOW %d ''%s'' ',
1723 <            [NEWLINE, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1723 >            [LineEnding, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1724               qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1725            if (FileFlags and FILE_inactive) <> 0 then
1726              Buffer := Buffer + 'INACTIVE ';
# Line 1389 | Line 1761 | begin
1761        begin
1762          if NoDB then
1763            Buffer := '/* ';
1764 <        Buffer := Buffer + NEWLINE + 'ALTER DATABASE ADD ';
1764 >        Buffer := Buffer + LineEnding + 'ALTER DATABASE ADD ';
1765          First := false;
1766        end; //end_if
1767        if FirstFile then
# Line 1399 | Line 1771 | begin
1771        begin
1772          if (FileFlags and LOG_overflow) <> 0 then
1773            Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',
1774 <            [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1774 >            [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1775          else
1776            if (FileFlags and LOG_serial) <> 0 then
1777              Buffer := Buffer + Format('%s  BASE_NAME ''%s''',
1778 <              [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1778 >              [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1779            { Since we are fetching order by FILE_FLAGS, the LOG_0verflow will
1780               be last.  It will only appear if there were named round robin,
1781               so we must close the parens first }
# Line 1414 | Line 1786 | begin
1786              if FirstFile then
1787                Buffer := Buffer + '('
1788              else
1789 <              Buffer := Buffer + Format(',%s  ', [NEWLINE]);
1789 >              Buffer := Buffer + Format(',%s  ', [LineEnding]);
1790              FirstFile := false;
1791  
1792              Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsString]);
# Line 1448 | Line 1820 | begin
1820      if not First then
1821      begin
1822        if NoDB then
1823 <        FMetaData.Add(Format('%s */%s', [NEWLINE, NEWLINE]))
1823 >        FMetaData.Add(Format('%s */%s', [LineEnding, LineEnding]))
1824        else
1825 <        FMetaData.Add(Format('%s%s%s', [Term, NEWLINE, NEWLINE]));
1825 >        FMetaData.Add(Format('%s%s%s', [Term, LineEnding, LineEnding]));
1826      end;
1827    finally
1828      qryDB.Free;
# Line 1552 | Line 1924 | var
1924        Result := Result + Format(' SEGMENT SIZE %d', [qryDomains.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
1925      end //end_if
1926      else
1927 <    if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
1928 <       (not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
1929 <      Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1927 >    if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
1928 >    begin
1929 >       if not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
1930 >         Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
1931 >       else
1932 >         Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1933 >    end;
1934  
1935      { since the character set is part of the field type, display that
1936       information now. }
# Line 1562 | Line 1938 | var
1938        Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1939           0, FALSE);
1940      if not qryDomains.FieldByName('RDB$DIMENSIONS').IsNull then
1941 <      Result := GetArrayField(FieldName);
1941 >      Result := GetArrayField(qryDomains.FieldByName('RDB$FIELD_SOURCE').AsString);
1942  
1943      if not qryDomains.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
1944 <      Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1944 >      Result := Result + Format('%s%s %s', [LineEnding, TAB,
1945           qryDomains.FieldByName('RDB$DEFAULT_SOURCE').AsString]);
1946  
1947      if not qryDomains.FieldByName('RDB$VALIDATION_SOURCE').IsNull then
1948        if Pos('CHECK', AnsiUpperCase(qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString)) = 1 then
1949 <        Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1949 >        Result := Result + Format('%s%s %s', [LineEnding, TAB,
1950             qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString])
1951        else
1952 <        Result := Result + Format('%s%s /* %s */', [NEWLINE, TAB,
1952 >        Result := Result + Format('%s%s /* %s */', [LineEnding, TAB,
1953             qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString]);
1954  
1955      if qryDomains.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
# Line 1889 | Line 2265 | end;
2265   procedure TIBExtract.ListFunctions(FunctionName : String = '');
2266   const
2267    FunctionSQL =
2268 <    'SELECT * FROM RDB$FUNCTIONS ' +
2268 >    'SELECT * FROM RDB$FUNCTIONS WHERE RDB$SYSTEM_FLAG = 0 ' +
2269      'ORDER BY RDB$FUNCTION_NAME';
2270  
2271    FunctionNameSQL =
# Line 1942 | Line 2318 | begin
2318        if First then
2319        begin
2320          FMEtaData.Add(Format('%s/*  External Function declarations */%s',
2321 <          [NEWLINE, NEWLINE]));
2321 >          [LineEnding, LineEnding]));
2322          First := false;
2323        end; //end_if
2324        { Start new function declaration }
# Line 2069 | Line 2445 | begin
2445        FMetaData.Add(Format('ENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%s%s',
2446          [qryFunctions.FieldByName('RDB$ENTRYPOINT').AsString,
2447           qryFunctions.FieldByName('RDB$MODULE_NAME').AsString,
2448 <         Term, NEWLINE, NEWLINE]));
2448 >         Term, LineEnding, LineEnding]));
2449  
2450        qryFunctions.Next;
2451      end;
# Line 2085 | Line 2461 | end;
2461   Functional description
2462     Re create all non-system generators }
2463  
2464 < procedure TIBExtract.ListGenerators(GeneratorName : String = '');
2464 > procedure TIBExtract.ListGenerators(GeneratorName: String;
2465 >  ExtractTypes: TExtractTypes);
2466   const
2467    GeneratorSQL =
2468      'SELECT RDB$GENERATOR_NAME ' +
# Line 2101 | Line 2478 | const
2478      '  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2479      'ORDER BY RDB$GENERATOR_NAME';
2480  
2481 +  GeneratorValueSQL =
2482 +    'SELECT GEN_ID(%s,0) as GENERATORVALUE From RDB$Database';
2483 +
2484   var
2485    qryGenerator : TIBSQL;
2486 +  qryValue: TIBSQL;
2487    GenName : String;
2488   begin
2489    qryGenerator := TIBSQL.Create(FDatabase);
2490 +  qryValue := TIBSQL.Create(FDatabase);
2491    try
2492      if GeneratorName = '' then
2493        qryGenerator.SQL.Text := GeneratorSQL
# Line 2127 | Line 2509 | begin
2509          qryGenerator.Next;
2510          continue;
2511        end;
2512 <      FMetaData.Add(Format('CREATE GENERATOR %s%s',
2512 >      FMetaData.Add(Format('CREATE SEQUENCE %s%s',
2513          [QuoteIdentifier(FDatabase.SQLDialect, GenName),
2514           Term]));
2515 +      if etData in ExtractTypes then
2516 +      begin
2517 +        qryValue.SQL.Text := Format(GeneratorValueSQL,[GenName]);
2518 +        qryValue.ExecQuery;
2519 +        try
2520 +          if not qryValue.EOF then
2521 +            FMetaData.Add(Format('ALTER SEQUENCE %s RESTART WITH %d;',
2522 +                 [QuoteIdentifier(FDatabase.SQLDialect, GenName),
2523 +                  qryValue.FieldByName('GENERATORVALUE').AsInteger]));
2524 +        finally
2525 +          qryValue.Close;
2526 +        end;
2527 +      end;
2528        qryGenerator.Next;
2529      end;
2530    finally
2531      qryGenerator.Free;
2532 +    qryValue.Free;
2533    end;
2534   end;
2535  
# Line 2207 | Line 2603 | begin
2603        if First then
2604        begin
2605          if ObjectName = '' then
2606 <          FMetaData.Add(NEWLINE + '/*  Index definitions for all user tables */' + NEWLINE)
2606 >          FMetaData.Add(LineEnding + '/*  Index definitions for all user tables */' + LineEnding)
2607          else
2608 <          FMetaData.Add(NEWLINE + '/*  Index definitions for ' + ObjectName + ' */' + NEWLINE);
2608 >          FMetaData.Add(LineEnding + '/*  Index definitions for ' + ObjectName + ' */' + LineEnding);
2609          First := false;
2610        end; //end_if
2611  
# Line 2249 | Line 2645 | end;
2645   procedure TIBExtract.ListViews(ViewName : String);
2646   const
2647    ViewSQL =
2648 +    'with recursive Views as ( ' +
2649 +    '  Select RDB$RELATION_NAME, 1 as ViewLevel from RDB$RELATIONS ' +
2650 +    '    Where RDB$RELATION_TYPE = 1 and RDB$SYSTEM_FLAG = 0 '+
2651 +    '  UNION ALL ' +
2652 +    '  Select D.RDB$DEPENDED_ON_NAME, ViewLevel + 1 From RDB$DEPENDENCIES D ' +
2653 +    '  JOIN Views on Views.RDB$RELATION_NAME = D.RDB$DEPENDENT_NAME ' +
2654 +    '     and Views.RDB$RELATION_NAME <> D.RDB$DEPENDED_ON_NAME ' +
2655 +    '  JOIN RDB$RELATIONS R On R.RDB$RELATION_NAME = D.RDB$DEPENDED_ON_NAME ' +
2656 +    ')' +
2657 +    'SELECT R.RDB$RELATION_NAME, R.RDB$OWNER_NAME, R.RDB$VIEW_SOURCE FROM RDB$RELATIONS R ' +
2658 +    'JOIN ( ' +
2659 +    'Select RDB$RELATION_NAME, max(ViewLevel) as ViewLevel From Views ' +
2660 +    'Group By RDB$RELATION_NAME) A On A.RDB$RELATION_NAME = R.RDB$RELATION_NAME ' +
2661 +    'Where R.RDB$RELATION_TYPE = 1 and R.RDB$SYSTEM_FLAG = 0 '+
2662 +    'Order by A.ViewLevel desc, R.RDB$RELATION_NAME asc';
2663 +
2664 + {
2665      'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2666      'FROM RDB$RELATIONS ' +
2667      'WHERE ' +
2668      '  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2669      '  NOT RDB$VIEW_BLR IS NULL AND ' +
2670      '  RDB$FLAGS = 1 ' +
2671 <    'ORDER BY RDB$RELATION_ID';
2671 >    'ORDER BY RDB$RELATION_ID'; }
2672  
2673    ViewNameSQL =
2674      'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
# Line 2293 | Line 2706 | begin
2706      while not qryView.Eof do
2707      begin
2708        SList.Add(Format('%s/* View: %s, Owner: %s */%s',
2709 <         [NEWLINE, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2710 <          qryView.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
2709 >         [LineEnding, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2710 >          qryView.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
2711  
2712        SList.Add(Format('CREATE VIEW %s (', [QuoteIdentifier(FDatabase.SQLDialect,
2713          qryView.FieldByName('RDB$RELATION_NAME').AsString)]));
# Line 2311 | Line 2724 | begin
2724            SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + ', ';
2725        end;
2726        qryColumns.Close;
2727 <      SList.Text := SList.Text + Format(') AS%s', [NEWLINE]);
2727 >      SList.Text := SList.Text + Format(') AS%s', [LineEnding]);
2728        if not qryView.FieldByName('RDB$VIEW_SOURCE').IsNull then
2729          SList.Text := SList.Text + qryView.FieldByName('RDB$VIEW_SOURCE').AsString;
2730 <      SList.Text := SList.Text + Format('%s%s', [Term, NEWLINE]);
2730 >      SList.Text := SList.Text + Format('%s%s', [Term, LineEnding]);
2731        FMetaData.AddStrings(SList);
2732        SList.Clear;
2733        qryView.Next;
# Line 2343 | Line 2756 | begin
2756      Used := true;
2757    end
2758    else
2759 <    Result := Format(', %s      ', [NEWLINE]);
2759 >    Result := Format(', %s      ', [LineEnding]);
2760   end;
2761  
2762   {
# Line 2388 | Line 2801 | end;
2801  
2802   procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2803   begin
2804 <  if FDatabase <> Value then
2804 >  if (csLoading in ComponentState) or (FDatabase <> Value) then
2805    begin
2806      FDatabase := Value;
2807      if (not Assigned(FTransaction)) and (FDatabase <> nil) then
# Line 2420 | Line 2833 | begin
2833    end;
2834    FMetaData.Clear;
2835    case ObjectType of
2836 <    eoDatabase : ExtractDDL(true, '');
2836 >    eoDatabase : ExtractDDL(true, '', ExtractTypes);
2837      eoDomain :
2838        if etTable in ExtractTypes then
2839          ListDomains(ObjectName, etTable)
# Line 2440 | Line 2853 | begin
2853          if etCheck in ExtractTypes then
2854            ListCheck(ObjectName, etTable);
2855          if etTrigger in ExtractTypes then
2856 <          ListTriggers(ObjectName, etTable);
2856 >        begin
2857 >          if etGrant in ExtractTypes then
2858 >            ListTriggers(ObjectName, [etTable,etGrant])
2859 >          else
2860 >            ListTriggers(ObjectName, [etTable]);
2861 >        end;
2862          if etGrant in ExtractTypes then
2863            ShowGrants(ObjectName, Term);
2864          if etData in ExtractTypes then
# Line 2449 | Line 2867 | begin
2867        else
2868          ListAllTables(true);
2869      end;
2870 <    eoView : ListViews(ObjectName);
2871 <    eoProcedure : ListProcs(ObjectName);
2870 >    eoView :
2871 >     begin
2872 >       ListViews(ObjectName);
2873 >       if ObjectName <> '' then
2874 >       begin
2875 >         if etTrigger in ExtractTypes then
2876 >         begin
2877 >           if etGrant in ExtractTypes then
2878 >             ListTriggers(ObjectName, [etTable,etGrant])
2879 >           else
2880 >             ListTriggers(ObjectName, [etTable]);
2881 >         end;
2882 >         if etGrant in ExtractTypes then
2883 >           ShowGrants(ObjectName, Term);
2884 >       end;
2885 >     end;
2886 >    eoProcedure :
2887 >     begin
2888 >       ListProcs(pdCreateProc,ObjectName,etGrant in ExtractTypes);
2889 >       if (ObjectName <> '' ) and (etGrant in ExtractTypes) then
2890 >         ShowGrants(ObjectName, Term);
2891 >     end;
2892      eoFunction : ListFunctions(ObjectName);
2893 <    eoGenerator : ListGenerators(ObjectName);
2893 >    eoGenerator : ListGenerators(ObjectName,ExtractTypes);
2894      eoException : ListException(ObjectName);
2895      eoBLOBFilter : ListFilters(ObjectName);
2896 <    eoRole : ListRoles(ObjectName);
2896 >    eoRole : ListRoles(ObjectName,etGrant in ExtractTypes);
2897      eoTrigger :
2898        if etTable in ExtractTypes then
2899 <        ListTriggers(ObjectName, etTable)
2899 >      begin
2900 >        if etGrant in ExtractTypes then
2901 >          ListTriggers(ObjectName, [etTable,etGrant])
2902 >        else
2903 >          ListTriggers(ObjectName, [etTable])
2904 >      end
2905 >      else
2906 >      if etGrant in ExtractTypes then
2907 >        ListTriggers(ObjectName,[etTrigger,etGrant])
2908        else
2909          ListTriggers(ObjectName);
2910      eoForeign :
# Line 2545 | Line 2991 | end;
2991       It must extract granted privileges on tables/views to users,
2992       - these may be compound, so put them on the same line.
2993     Grant execute privilege on procedures to users
2994 <   Grant various privilegs to procedures.
2994 >   Grant various privileges to procedures.
2995     All privileges may have the with_grant option set. }
2996  
2997 < procedure TIBExtract.ShowGrants(MetaObject, Terminator: String);
2997 > procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String;
2998 >  NoUserGrants: boolean);
2999   const
3000 <  { This query only finds tables, eliminating owner privileges }
3001 <  OwnerPrivSQL =
3002 <    'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
3003 <    '       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE ' +
3004 <    'FROM RDB$USER_PRIVILEGES PRV, RDB$RELATIONS REL ' +
3005 <    'WHERE ' +
3006 <    '  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
3007 <    '  REL.RDB$RELATION_NAME = :METAOBJECT AND ' +
3008 <    '  PRV.RDB$PRIVILEGE <> ''M'' AND ' +
3009 <    '  REL.RDB$OWNER_NAME <> PRV.RDB$USER ' +
3010 <    'ORDER BY  PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
3011 <
3012 <  ProcPrivSQL =
3013 <    'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
3014 <    '       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE, PRV.RDB$RELATION_NAME ' +
3015 <    'FROM RDB$USER_PRIVILEGES PRV, RDB$PROCEDURES PRC ' +
3016 <    'where ' +
3017 <    '  PRV.RDB$OBJECT_TYPE = 5 AND ' +
3018 <    '  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
3019 <    '  PRC.RDB$PROCEDURE_NAME = :METAOBJECT AND ' +
3020 <    '  PRV.RDB$PRIVILEGE = ''X'' AND ' +
3021 <    '  PRC.RDB$OWNER_NAME <> PRV.RDB$USER ' +
3022 <    'ORDER BY PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
3023 <
3024 <  RolePrivSQL =
3025 <    'SELECT * FROM RDB$USER_PRIVILEGES ' +
3026 <    'WHERE ' +
3027 <    '  RDB$OBJECT_TYPE = 13 AND ' +
3028 <    '  RDB$USER_TYPE = 8  AND ' +
3029 <    '  RDB$RELATION_NAME = :METAOBJECT AND ' +
3030 <    '  RDB$PRIVILEGE = ''M'' ' +
3031 <    'ORDER BY RDB$USER';
3000 >  GrantsBaseSelect =
3001 >    'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges,  '+
3002 >    'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME,  '+
3003 >    'RDB$USER_TYPE, RDB$OBJECT_TYPE,  '+
3004 >    'case T2.RDB$TYPE_NAME  '+
3005 >    '  When ''RELATION'' then ''TABLE''  '+
3006 >    '  When ''FIELD'' then ''DOMAIN''  '+
3007 >    'Else T2.RDB$TYPE_NAME End as OBJECT_TYPE_NAME,  '+
3008 >    'T1.RDB$TYPE_NAME as USER_TYPE_NAME,  '+
3009 >    'case  '+
3010 >    'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION''  '+
3011 >    'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION''  '+
3012 >    'ELSE '''' End as GRANTOPTION,  '+
3013 >    'case When RDB$OWNER_NAME = RDB$GRANTOR then '''' '+
3014 >    'else coalesce('' GRANTED BY "'' || Trim(RDB$GRANTOR) || ''"'','''') END as GRANTEDBY  '+
3015 >    'From (   '+
3016 >    'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE   '+
3017 >    'When ''X'' then ''EXECUTE''   '+
3018 >    'When ''S'' then ''SELECT''   '+
3019 >    'When ''U'' then ''UPDATE''    '+
3020 >    'When ''D'' then ''DELETE''   '+
3021 >    'When ''R'' then ''REFERENCES''   '+
3022 >    'When ''G'' then ''USAGE''   '+
3023 >    'When ''I'' then ''INSERT''  '+
3024 >    'end )) as "Privileges",   '+
3025 >    'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME,PR.RDB$GRANTOR   '+
3026 >    'FROM RDB$USER_PRIVILEGES PR   '+
3027 >    'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE  '+
3028 >    'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)   '+
3029 >    'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME,PR.RDB$GRANTOR   '+
3030 >    'UNION   '+
3031 >    'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',   '+
3032 >    'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME,PR.RDB$GRANTOR    '+
3033 >    'FROM RDB$USER_PRIVILEGES PR   '+
3034 >    'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE  '+
3035 >    'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null    '+
3036 >    'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME,PR.RDB$GRANTOR) A '+
3037 >    'JOIN RDB$TYPES T1 On T1.RDB$TYPE = RDB$USER_TYPE and T1.RDB$FIELD_NAME = ''RDB$OBJECT_TYPE''  '+
3038 >    'JOIN RDB$TYPES T2 On T2.RDB$TYPE = RDB$OBJECT_TYPE and T2.RDB$FIELD_NAME = ''RDB$OBJECT_TYPE''  '+
3039 >    'Where METAOBJECTNAME = :METAOBJECTNAME and RDB$USER <> RDB$OWNER_NAME   '+
3040 >    'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE,METAOBJECTNAME,RDB$GRANTOR,T2.RDB$TYPE_NAME,T1.RDB$TYPE_NAME,RDB$OWNER_NAME  '+
3041 >    'ORDER BY RDB$USER, RDB$OBJECT_TYPE';
3042 >
3043 >  GrantsSQL12 =
3044 >  'with ObjectOwners As (  '+
3045 >  '  Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType  '+
3046 >  '  From RDB$RELATIONS  '+
3047 >  '  UNION  '+
3048 >  '  Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType  '+
3049 >  '  From RDB$PROCEDURES  '+
3050 >  '  UNION  '+
3051 >  '  Select RDB$EXCEPTION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 7 as ObjectType  '+
3052 >  '  From RDB$EXCEPTIONS  '+
3053 >  '  UNION  '+
3054 >  '  Select RDB$FIELD_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 9 as ObjectType  '+
3055 >  '  From RDB$FIELDS Where RDB$FIELD_NAME not Similar to ''RDB$%|SEC$%|MON$%|SQL$%'' '+
3056 >  '  UNION  '+
3057 >  '  Select RDB$GENERATOR_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 14 as ObjectType  '+
3058 >  '  From RDB$GENERATORS  '+
3059 >  '  UNION  '+
3060 >  '  Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 11 as ObjectType  '+
3061 >  '  From RDB$CHARACTER_SETS  '+
3062 >  '  UNION  '+
3063 >  '  Select RDB$COLLATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 17 as ObjectType  '+
3064 >  '  From RDB$COLLATIONS  '+
3065 >  ') '+ GrantsBaseSelect;
3066 >
3067 >  GrantsSQL =
3068 >  'with ObjectOwners As ( '+
3069 >  'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
3070 >  'From RDB$RELATIONS '+
3071 >  'UNION '+
3072 >  'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
3073 >  'From RDB$PROCEDURES '+
3074 >  'UNION '+
3075 >  'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, ''SYSDBA'', 7 as ObjectType '+
3076 >  'From RDB$EXCEPTIONS '+
3077 >  'UNION '+
3078 >  'Select RDB$GENERATOR_NAME as METAOBJECTNAME, ''SYSDBA'', 14 as ObjectType '+
3079 >  'From RDB$GENERATORS '+
3080 >  'UNION '+
3081 >  'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, ''SYSDBA'', 11 as ObjectType '+
3082 >  'From RDB$CHARACTER_SETS '+
3083 >  ') '+ GrantsBaseSelect;
3084  
3085 < var
2587 <  PrevUser, PrevField,  WithOption,
2588 <  PrivString, ColString, UserString,
2589 <  FieldName, User : String;
2590 <  c : Char;
2591 <  PrevOption, PrivFlags, GrantOption : Integer;
2592 <  First, PrevFieldNull : Boolean;
2593 <  qryOwnerPriv : TIBSQL;
2594 <
2595 <    {  Given a bit-vector of privileges, turn it into a
2596 <       string list. }
2597 <  function MakePrivString(cflags : Integer) : String;
2598 <  var
2599 <    i : Integer;
2600 <  begin
2601 <    for i := Low(PrivTypes) to High(PrivTypes) do
2602 <    begin
2603 <      if (cflags and PrivTypes[i].PrivFlag) <> 0 then
2604 <      begin
2605 <        if Result <> '' then
2606 <          Result := Result + ', ';
2607 <        Result := Result + PrivTypes[i].PrivString;
2608 <      end; //end_if
2609 <    end; //end_for
2610 <  end; //end_fcn MakePrivDtring
3085 > var qryOwnerPriv : TIBSQL;
3086  
3087   begin
3088    if MetaObject = '' then
3089      exit;
3090  
2616  First := true;
2617  PrevOption := -1;
2618  PrevUser := '';
2619  PrivString := '';
2620  ColString := '';
2621  WithOption := '';
2622  PrivFlags := 0;
2623  PrevFieldNull := false;
2624  PrevField := '';
2625
3091    qryOwnerPriv := TIBSQL.Create(FDatabase);
3092    try
3093 <    qryOwnerPriv.SQL.Text := OwnerPrivSQL;
3094 <    qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3093 >    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
3094 >      qryOwnerPriv.SQL.Text := GrantsSQL12
3095 >    else
3096 >    qryOwnerPriv.SQL.Text := GrantsSQL;
3097 >    qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
3098      qryOwnerPriv.ExecQuery;
3099      while not qryOwnerPriv.Eof do
3100      begin
3101 <      { Sometimes grant options are null, sometimes 0.  Both same }
3102 <      if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').IsNull then
3103 <        GrantOption := 0
3104 <      else
3105 <        GrantOption := qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger;
3106 <
3107 <      if qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull then
3108 <        FieldName := ''
3109 <      else
3110 <        FieldName := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').AsString;
3111 <
2644 <      User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2645 <      { Print a new grant statement for each new user or change of option }
2646 <
2647 <      if ((PrevUser <> '') and (PrevUser <> User)) or
2648 <          ((Not First) and
2649 <            (PrevFieldNull <> qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull)) or
2650 <          ((not PrevFieldNull) and (PrevField <> FieldName)) or
2651 <          ((PrevOption <> -1) and (PrevOption <> GrantOption)) then
2652 <      begin
2653 <        PrivString := MakePrivString(PrivFlags);
2654 <
2655 <        First := false;
2656 <        FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2657 <          ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2658 <          UserString, WithOption, Terminator]));
2659 <        { re-initialize strings }
2660 <
2661 <        PrivString := '';
2662 <        WithOption := '';
2663 <        ColString := '';
2664 <        PrivFlags := 0;
2665 <      end; //end_if
2666 <
2667 <      PrevUser := User;
2668 <      PrevOption := GrantOption;
2669 <      PrevFieldNull := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull;
2670 <      PrevField := FieldName;
2671 <
2672 <      case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2673 <        obj_relation,
2674 <        obj_view,
2675 <        obj_trigger,
2676 <        obj_procedure,
2677 <        obj_sql_role:
2678 <          UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2679 <        else
2680 <          UserString := User;
2681 <      end; //end_case
2682 <
2683 <      case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2684 <        obj_view :
2685 <          UserString := 'VIEW ' + UserString;
2686 <        obj_trigger :
2687 <          UserString := 'TRIGGER '+ UserString;
2688 <        obj_procedure :
2689 <          UserString := 'PROCEDURE ' + UserString;
2690 <      end; //end_case
2691 <
2692 <      c := qryOwnerPriv.FieldByName('RDB$PRIVILEGE').AsString[1];
2693 <
2694 <      case c of
2695 <        'S' : PrivFlags := PrivFlags or priv_SELECT;
2696 <        'I' : PrivFlags := PrivFlags or priv_INSERT;
2697 <        'U' : PrivFlags := PrivFlags or priv_UPDATE;
2698 <        'D' : PrivFlags := PrivFlags or priv_DELETE;
2699 <        'R' : PrivFlags := PrivFlags or priv_REFERENCES;
2700 <        'X' : ;
2701 <          { Execute should not be here -- special handling below }
2702 <        else
2703 <          PrivFlags := PrivFlags or priv_UNKNOWN;
2704 <      end; //end_switch
2705 <
2706 <      { Column level privileges for update only }
2707 <
2708 <      if FieldName = '' then
2709 <        ColString := ''
2710 <      else
2711 <        ColString := Format(' (%s)', [QuoteIdentifier(FDatabase.SQLDialect, FieldName)]);
2712 <
2713 <      if GrantOption <> 0 then
2714 <        WithOption := ' WITH GRANT OPTION';
2715 <
3101 >      if not NoUserGrants or (qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger <> obj_user)
3102 >          or (qryOwnerPriv.FieldByName('RDB$USER').AsString = 'PUBLIC') then
3103 >      FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s%s', [
3104 >                            qryOwnerPriv.FieldByName('Privileges').AsString,
3105 >                            qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
3106 >                            qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
3107 >                            qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
3108 >                            qryOwnerPriv.FieldByName('RDB$USER').AsString,
3109 >                            qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
3110 >                            qryOwnerPriv.FieldByName('GRANTEDBY').AsString,
3111 >                            Terminator]));
3112        qryOwnerPriv.Next;
3113      end;
2718    { Print last case if there was anything to print }
2719    if PrevOption <> -1 then
2720    begin
2721      PrivString := MakePrivString(PrivFlags);
2722      First := false;
2723      FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2724        ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2725        UserString, WithOption, Terminator]));
2726      { re-initialize strings }
2727    end; //end_if
3114      qryOwnerPriv.Close;
3115 +  finally
3116 +    qryOwnerPriv.Free;
3117 +  end;
3118 + end;
3119  
3120 <    if First then
3121 <    begin
3122 <     { Part two is for stored procedures only }
3123 <      qryOwnerPriv.SQL.Text := ProcPrivSQL;
3124 <      qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3125 <      qryOwnerPriv.ExecQuery;
3126 <      while not qryOwnerPriv.Eof do
3127 <      begin
3128 <        First := false;
3129 <        User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
3130 <
3131 <        case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
3132 <          obj_relation,
3133 <          obj_view,
3134 <          obj_trigger,
3135 <          obj_procedure,
3136 <          obj_sql_role:
3137 <            UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
3138 <          else
3139 <            UserString := User;
3140 <        end; //end_case
3141 <        case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
3142 <          obj_view :
3143 <            UserString := 'VIEW ' + UserString;
3144 <          obj_trigger :
3145 <            UserString := 'TRIGGER '+ UserString;
3146 <          obj_procedure :
3147 <            UserString := 'PROCEDURE ' + UserString;
3148 <        end; //end_case
3120 > procedure TIBExtract.ShowGrantsTo(MetaObject: String; ObjectType: integer; Terminator: String);
3121 > const
3122 >  GrantsSQL =
3123 >  'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
3124 >  'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
3125 >  'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
3126 >  'case  RDB$OBJECT_TYPE '+
3127 >  'When 0 then ''TABLE'' '+
3128 >  'When 5 then ''PROCEDURE'' '+
3129 >  'When 7 then ''EXCEPTION'' '+
3130 >  'When 11 then ''CHARACTER SET'' '+
3131 >  'ELSE NULL END as OBJECT_TYPE_NAME, '+
3132 >  'case RDB$USER_TYPE '+
3133 >  'When 5 then ''PROCEDURE'' '+
3134 >  'When 2 then ''TRIGGER'' '+
3135 >  'When 8 then ''USER'' '+
3136 >  'When 13 then ''ROLE'' '+
3137 >  'ELSE NULL END as USER_TYPE_NAME, '+
3138 >  'case '+
3139 >  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
3140 >  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
3141 >  'ELSE '''' End as GRANTOPTION '+
3142 >  'From (  '+
3143 >  'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
3144 >  'When ''X'' then ''EXECUTE''  '+
3145 >  'When ''S'' then ''SELECT''  '+
3146 >  'When ''U'' then ''UPDATE''   '+
3147 >  'When ''D'' then ''DELETE''  '+
3148 >  'When ''R'' then ''REFERENCES''  '+
3149 >  'When ''G'' then ''USAGE''  '+
3150 >  'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
3151 >  'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
3152 >  'FROM RDB$USER_PRIVILEGES PR  '+
3153 >  'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
3154 >  'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
3155 >  'UNION  '+
3156 >  'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
3157 >  'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE   '+
3158 >  'FROM RDB$USER_PRIVILEGES PR  '+
3159 >  'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
3160 >  'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE)  '+
3161 >  'Where RDB$USER = :METAOBJECTNAME and RDB$USER_TYPE = :USERTYPE '+
3162 >  'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE, METAOBJECTNAME '+
3163 >  'ORDER BY METAOBJECTNAME';
3164  
3165 <        if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2761 <          WithOption := ' WITH GRANT OPTION'
2762 <        else
2763 <          WithOption := '';
3165 > var qryOwnerPriv : TIBSQL;
3166  
3167 <        FMetaData.Add(Format('GRANT EXECUTE ON PROCEDURE %s TO %s%s%s',
3168 <          [QuoteIdentifier(FDatabase.SQLDialect, MetaObject), UserString,
3169 <           WithOption, terminator]));
3167 > begin
3168 >  if MetaObject = '' then
3169 >    exit;
3170  
3171 <        qryOwnerPriv.Next;
3172 <      end;
3173 <      qryOwnerPriv.Close;
3174 <    end;
3175 <    if First then
3171 >  qryOwnerPriv := TIBSQL.Create(FDatabase);
3172 >  try
3173 >    qryOwnerPriv.SQL.Text := GrantsSQL;
3174 >    qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
3175 >    qryOwnerPriv.Params.ByName('USERTYPE').AsInteger := ObjectType;
3176 >    qryOwnerPriv.ExecQuery;
3177 >    while not qryOwnerPriv.Eof do
3178      begin
3179 <      qryOwnerPriv.SQL.Text := RolePrivSQL;
3180 <      qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3181 <      qryOwnerPriv.ExecQuery;
3182 <      while not qryOwnerPriv.Eof do
3183 <      begin
3184 <        if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
3185 <          WithOption := ' WITH ADMIN OPTION'
3186 <        else
3187 <          WithOption := '';
2784 <
2785 <        FMetaData.Add(Format('GRANT %s TO %s%s%s',
2786 <          [QuoteIdentifier(FDatabase.SQLDialect, qryOwnerPriv.FieldByName('RDB$RELATION_NAME').AsString),
2787 <           qryOwnerPriv.FieldByName('RDB$USER_NAME').AsString,
2788 <           WithOption, terminator]));
2789 <
2790 <        qryOwnerPriv.Next;
2791 <      end;
3179 >      FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
3180 >                            qryOwnerPriv.FieldByName('Privileges').AsString,
3181 >                            qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
3182 >                            qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
3183 >                            qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
3184 >                            qryOwnerPriv.FieldByName('RDB$USER').AsString,
3185 >                            qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
3186 >                            Terminator]));
3187 >      qryOwnerPriv.Next;
3188      end;
3189      qryOwnerPriv.Close;
3190    finally
3191      qryOwnerPriv.Free;
3192    end;
3193 +  FMetaData.Add('');
3194   end;
3195  
3196   {         ShowGrantRoles
# Line 2833 | Line 3230 | begin
3230          WithOption := '';
3231        FMetaData.Add(Format('GRANT %s TO %s%s%s%s',
3232          [ QuoteIdentifier(FDatabase.SQLDialect, qryRole.FieldByName('RDB$RELATION_NAME').AsString),
3233 <         UserString, WithOption, Terminator, NEWLINE]));
3233 >         UserString, WithOption, Terminator, LineEnding]));
3234  
3235        qryRole.Next;
3236      end;
# Line 2913 | Line 3310 | var
3310          end;
3311          break;
3312        end;
3313 <    if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
3314 <       (not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
3315 <      Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3313 >    if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
3314 >    begin
3315 >       if not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
3316 >         Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
3317 >       else
3318 >         Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3319 >    end;
3320  
3321      { Show international character sets and collations }
3322  
# Line 2976 | Line 3377 | begin
3377        if FirstTime then
3378        begin
3379          FirstTime := false;
3380 <        FMetaData.Add('RETURNS' + NEWLINE + '(');
3380 >        FMetaData.Add('RETURNS' + LineEnding + '(');
3381        end;
3382  
3383        Line := FormatParamStr;
# Line 3011 | Line 3412 | end;
3412  
3413   procedure TIBExtract.ListData(ObjectName: String);
3414   const
3415 <  SelectSQL = 'SELECT * FROM %s';
3416 < var
3417 <  qrySelect : TIBSQL;
3418 <  Line : String;
3419 <  i : Integer;
3415 >  SelectFieldListSQL = 'Select List(RDB$FIELD_NAME) From ( '+
3416 >    'Select RF.RDB$FIELD_NAME From RDB$RELATION_FIELDS RF '+
3417 >    'JOIN RDB$FIELDS F On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
3418 >    'Where F.RDB$COMPUTED_BLR is NULL and RF.RDB$RELATION_NAME = Upper(:Relation) '+
3419 >    'Order by RF.RDB$FIELD_POSITION asc)';
3420 >
3421 >  TableSQL =
3422 >    'SELECT * FROM RDB$RELATIONS ' +
3423 >    'WHERE ' +
3424 >    '  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
3425 >    '  RDB$VIEW_BLR IS NULL ' +
3426 >    'ORDER BY RDB$RELATION_NAME';
3427 >
3428 > var FieldList: string;
3429 >
3430   begin
3431 <  qrySelect := TIBSQL.Create(FDatabase);
3432 <  try
3433 <    qrySelect.SQL.Text := Format(SelectSQL,
3434 <      [QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]);
3435 <    qrySelect.ExecQuery;
3436 <    while not qrySelect.Eof do
3437 <    begin
3438 <      Line := 'INSERT INTO ' + QuoteIdentifier(FDatabase.SQLDialect, ObjectName) + ' (';
3439 <      for i := 0 to qrySelect.Current.Count - 1 do
3029 <        if (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3030 <           (qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3031 <        begin
3032 <          Line := Line + QuoteIdentifier(FDatabase.SQLDialect, qrySelect.Fields[i].Name);
3033 <          if i <> (qrySelect.Current.Count - 1) then
3034 <            Line := Line + ', ';
3035 <        end;
3036 <      Line := Line + ') VALUES (';
3037 <      for i := 0 to qrySelect.Current.Count - 1 do
3431 >  if ObjectName = '' then {List all}
3432 >  begin
3433 >    with TIBSQL.Create(self) do
3434 >    try
3435 >      Database := FDatabase;
3436 >      SQL.Text := TableSQL;
3437 >      ExecQuery;
3438 >      FMetaData.Add('/* Data Starts */');
3439 >      while not EOF do
3440        begin
3441 <        if qrySelect.Fields[i].IsNull and
3442 <           (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3041 <           (qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3042 <        begin
3043 <          Line := Line + 'NULL';
3044 <          if i <> (qrySelect.Current.Count - 1) then
3045 <            Line := Line + ', ';
3046 <        end
3047 <        else
3048 <        case qrySelect.Fields[i].SQLType of
3049 <          SQL_TEXT, SQL_VARYING, SQL_TYPE_DATE,
3050 <          SQL_TYPE_TIME, SQL_TIMESTAMP :
3051 <          begin
3052 <            Line := Line + QuotedStr(qrySelect.Fields[i].AsString);
3053 <            if i <> (qrySelect.Current.Count - 1) then
3054 <              Line := Line + ', ';
3055 <          end;
3056 <          SQL_SHORT, SQL_LONG, SQL_INT64,
3057 <          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
3058 <          begin
3059 <            Line := Line + qrySelect.Fields[i].AsString;
3060 <            if i <> (qrySelect.Current.Count - 1) then
3061 <              Line := Line + ', ';
3062 <          end;
3063 <          SQL_ARRAY, SQL_BLOB : ;
3064 <          else
3065 <            IBError(ibxeInvalidDataConversion, [nil]);
3066 <        end;
3441 >        ListData(Trim(FieldByName('RDB$RELATION_NAME').AsString));
3442 >        Next;
3443        end;
3444 <      Line := Line + ')' + Term;
3445 <      FMetaData.Add(Line);
3446 <      qrySelect.Next;
3444 >      FMetaData.Add('/* Data Ends */');
3445 >    finally
3446 >      Free;
3447 >    end;
3448 >  end
3449 >  else
3450 >  begin
3451 >    FieldList := '*';
3452 >    with TIBSQL.Create(self) do
3453 >    try
3454 >      Database := FDatabase;
3455 >      SQL.Text := SelectFieldListSQL;
3456 >      Params[0].AsString := ObjectName;
3457 >      ExecQuery;
3458 >      try
3459 >        if not EOF then
3460 >          FieldList := Fields[0].AsString;
3461 >      finally
3462 >        Close;
3463 >      end;
3464 >    finally
3465 >      Free
3466 >    end;
3467 >
3468 >    with TIBInsertStmtsOut.Create(self) do
3469 >    try
3470 >      Database := FDatabase;
3471 >      if DataOut(Format('Select %s From %s',[FieldList,QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]),
3472 >                Add2MetaData) then
3473 >        FMetaData.Add('COMMIT;');
3474 >    finally
3475 >      Free
3476      end;
3072  finally
3073    qrySelect.Free;
3477    end;
3478   end;
3479  
3480 < procedure TIBExtract.ListRoles(ObjectName: String);
3480 > procedure TIBExtract.ListRoles(ObjectName: String; IncludeGrants: boolean);
3481   const
3482    RolesSQL =
3483 <    'select * from RDB$ROLES ' +
3483 >    'select * from RDB$ROLES WHERE RDB$SYSTEM_FLAG = 0 ' +
3484      'order by RDB$ROLE_NAME';
3485  
3486    RolesByNameSQL =
# Line 3121 | Line 3524 | begin
3524              PrevOwner := OwnerName;
3525            end;
3526            FMetaData.Add('CREATE ROLE ' + RoleName + Term);
3527 +          if IncludeGrants then
3528 +            ShowGrantsTo(qryRoles.FieldByName('rdb$Role_Name').AsString,obj_sql_role,Term);
3529            qryRoles.Next;
3530          end;
3531        finally

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines