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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 139 by tony, Wed Jan 24 16:16:29 2018 UTC

# Line 23 | Line 23
23   {                                                                        }
24   {************************************************************************}
25  
26 < { Syntax Enhancements Supported:
26 > { Syntax Enhancements Supported (by Firebird Version no.):
27  
28   Multi-action triggers (1.5)
29   CREATE SEQUENCE (2.0)
# Line 31 | Line 31 | 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;
# Line 61 | Line 62 | type
62  
63    TExtractTypes = Set of TExtractType;
64  
65 +  TProcDDLType = (pdCreateProc,pdCreateStub,pdAlterProc);
66 +
67    { TIBExtract }
68  
69    TIBExtract = class(TComponent)
# Line 71 | 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: integer): string;
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);
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;
91 >    function ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean =
92 >      false): 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 = '');
98 >    procedure ListProcs(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
99 >      IncludeGrants:boolean=false);
100      procedure ListAllTables(flag : Boolean);
101 <    procedure ListTriggers(AlterTrigger, IncludeBody: boolean; 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 99 | 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 112 | Line 121 | type
121      function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
122        FieldPrec, FieldLen : Integer) : String;
123      function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
115    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
124      procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
125        ExtractTypes : TExtractTypes = []);
126      property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
# Line 146 | 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 195 | 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 233 | Line 244 | const
244  
245   implementation
246  
247 < uses FBMessages;
247 > uses FBMessages, IBDataOutput;
248  
249   const
239  NEWLINE = #13#10;
250    TERM = ';';
251    ProcTerm = '^';
252  
# Line 265 | 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 322 | 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; IncludeData: boolean = false) : Boolean;
367   var
368          DidConnect : Boolean;
369          DidStart : Boolean;
# Line 359 | Line 400 | begin
400      ListFunctions;
401      ListDomains;
402      ListAllTables(flag);
403 +    if IncludeData then
404 +      ListData('');
405      ListIndex;
406      ListForeign;
407 <    ListGenerators;
407 >    if IncludeData then
408 >      ListGenerators('',[etData])
409 >    else
410 >      ListGenerators;
411      ListViews;
412      ListCheck;
413      ListException;
414 <    ListTriggers(false,false);
415 <    ListProcs;
416 <    ListTriggers(true,true);
414 >    ListProcs(pdCreateStub);
415 >    ListTriggers;
416 >    ListProcs(pdAlterProc);
417      ListGrants;
418    end;
419  
# Line 414 | Line 460 | const
460      '  (RELC.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR ' +
461      '  RELC.RDB$CONSTRAINT_TYPE = ''UNIQUE'') AND ' +
462      '  RELC.RDB$RELATION_NAME = :RELATIONNAME ' +
463 <    'ORDER BY RELC.RDB$CONSTRAINT_NAME';
463 >    'ORDER BY RELC.RDB$CONSTRAINT_TYPE desc, RELC.RDB$CONSTRAINT_NAME';
464  
465    GetGeneratorSQL =
466      'SELECT * FROM RDB$GENERATORS WHERE RDB$GENERATOR_NAME = :GENERATOR';
# Line 422 | Line 468 | const
468   var
469    Collation, CharSetId : integer;
470          i : integer;
471 <  ColList, Column, Constraint : String;
471 >  Column, Constraint : String;
472    SubType : integer;
473    IntChar : integer;
474    qryTables, qryPrecision, qryConstraints, qryRelConstraints, qryGenerators : TIBSQL;
# Line 432 | Line 478 | var
478    TableType: integer;
479   begin
480    Result := true;
435  ColList := '';
481    IntChar := 0;
482    ValidRelation := false;
483  
# Line 445 | Line 490 | begin
490    qryGenerators := TIBSQL.Create(FDatabase);
491    try
492      qryTables.SQL.Add(TableListSQL);
493 +    RelationName := trim(RelationName);
494      qryTables.Params.ByName('RelationName').AsString := RelationName;
495      qryTables.ExecQuery;
496      qryPrecision.SQL.Add(PrecisionSQL);
# Line 458 | Line 504 | begin
504        if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and
505           (Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsString) <> '') then
506          FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',
507 <          [NEWLINE, RelationName,
508 <           qryTables.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
507 >          [LineEnding, RelationName,
508 >           qryTables.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
509        if TableType > 3 then
510         CreateTable := 'CREATE GLOBAL TEMPORARY TABLE'
511        else
# Line 497 | Line 543 | begin
543            (qryTables.FieldByName('RDB$FIELD_NAME1').AsString[5] in ['0'..'9'])) and
544            (qryTables.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
545          begin
546 <          Column := Column + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME1').AsString);
546 >          Column := Column + QuoteIdentifier(FDatabase.SQLDialect, trim(qryTables.FieldByName('RDB$FIELD_NAME1').AsString));
547            { International character sets }
548            if (qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying])
549                and (not qryTables.FieldByName('RDB$COLLATION_ID').IsNull)
# Line 602 | Line 648 | begin
648          end;
649  
650          {Firebird 3 introduces IDENTITY columns. We need to check for them here}
651 <        if qryTables.HasField('RDB$GENERATOR_NAME') then
651 >        if qryTables.HasField('RDB$GENERATOR_NAME') and not qryTables.FieldByName('RDB$GENERATOR_NAME').IsNull then
652          begin
653            qryGenerators.ParamByName('GENERATOR').AsString :=  qryTables.FieldByName('RDB$GENERATOR_NAME').AsString;
654            qryGenerators.ExecQuery;
# Line 701 | Line 747 | begin
747      end;
748      if ValidRelation then
749      begin
704      FMetaData.Add(') ');
750        if TableType = 4 then
751 <      FMetaData.Add('ON COMMIT PRESERVE ROWS ');
752 <      FMetaData.Add(Term);
751 >        FMetaData.Add(' ) ON COMMIT PRESERVE ROWS ' + TERM)
752 >      else
753 >       FMetaData.Add(')' + TERM);
754      end;
755    finally
756      qryTables.Free;
# Line 740 | Line 786 | var
786    qryViews, qryColumns : TIBSQL;
787    RelationName, ColList : String;
788   begin
789 +  ColList := '';
790    qryViews := TIBSQL.Create(FDatabase);
791    qryColumns := TIBSQL.Create(FDatabase);
792    try
# Line 833 | Line 880 | begin
880      FTransaction.Commit;
881   end;
882  
883 + procedure TIBExtract.Add2MetaData(const Msg: string; IsError: boolean);
884 + begin
885 +  FMetaData.Add(Msg);
886 + end;
887 +
888   function TIBExtract.GetDatabase: TIBDatabase;
889   begin
890    result := FDatabase;
# Line 879 | Line 931 | begin
931    Result := FTransaction;
932   end;
933  
934 < function TIBExtract.GetTriggerType(TypeID: integer): string;
934 > function TIBExtract.GetTriggerType(TypeID: Int64): string;
935 > const
936 >  AllDDLTriggers = $7FFFFFFFFFFFDFFF shr 1;
937   var separator: string;
938 +    i: integer;
939 +
940 +  function GetMask(Bits: integer): byte;
941 +  begin
942 +    case Bits of
943 +      1: Result := $01;
944 +      2: Result := $03;
945 +      3: Result := $07;
946 +    end;
947 +  end;
948 +
949 +  function GetDDLEvent(Phase: TTriggerPhase; ObjectName: string): string;
950 +  begin
951 +    Result := '';
952 +    case Phase of
953 +    tpCreate:
954 +     Result := separator + 'CREATE ' + ObjectName;
955 +    tpAlter:
956 +     Result := separator + 'ALTER ' + ObjectName;
957 +    tpDrop:
958 +     Result := separator + 'Drop ' + ObjectName;
959 +    end;
960 +    if Result <> '' then
961 +      separator := ' OR ';
962 +  end;
963 +
964   begin
965    if TypeID and $2000 <> 0 then
966    {database trigger}
# Line 888 | Line 968 | begin
968      Result := 'ON ';
969      case TypeID of
970      $2000:
971 <      Result += 'CONNECT ';
971 >      Result += 'CONNECT';
972      $2001:
973 <      Result += 'DISCONNECT ';
973 >      Result += 'DISCONNECT';
974      $2002:
975 <      Result +='TRANSACTION START ';
975 >      Result +='TRANSACTION START';
976      $2003:
977 <      Result += 'TRANSACTION COMMIT ';
977 >      Result += 'TRANSACTION COMMIT';
978      $2004:
979 <      Result += 'TRANSACTION ROLLBACK ';
979 >      Result += 'TRANSACTION ROLLBACK';
980      end;
981    end
982    else
983 +  if TypeID and $4000 <> 0 then
984 +  {DDL Trigger}
985 +  begin
986 +    if TypeID and $01 <> 0 then
987 +      Result := 'AFTER '
988 +    else
989 +      Result := 'BEFORE ';
990 +    TypeID := TypeID shr 1;
991 +    separator := '';
992 +    i := 0;
993 +    if TypeID = AllDDLTriggers then
994 +      Result += 'ANY DDL STATEMENT'
995 +    else
996 +      repeat
997 +        if TypeID and GetMask(DDLTriggers[i].Bits) <> 0 then
998 +        begin
999 +          if (DDLTriggers[i].Bits > 0) and (TypeID and $01 <> 0) then
1000 +           Result += GetDDLEvent(DDLTriggers[i].Bit1,DDLTriggers[i].ObjectName);
1001 +
1002 +          if (DDLTriggers[i].Bits > 1) and (TypeID and $02 <> 0) then
1003 +            Result += GetDDLEvent(DDLTriggers[i].Bit2,DDLTriggers[i].ObjectName);
1004 +
1005 +          if (DDLTriggers[i].Bits > 2) and (TypeID and $04 <> 0) then
1006 +            Result += GetDDLEvent(DDLTriggers[i].Bit3,DDLTriggers[i].ObjectName);
1007 +        end;
1008 +        TypeID := TypeID shr DDLTriggers[i].Bits;
1009 +        Inc(i);
1010 +      until TypeID = 0;
1011 +  end
1012 +  else
1013 +  {Normal Trigger}
1014    begin
1015      Inc(TypeID);
1016      if TypeID and $01 <> 0 then
# Line 920 | Line 1031 | begin
1031          Result += 'DELETE';
1032        end;
1033        TypeID := TypeID shr 2;
1034 <    until TypeID = 0;
1035 <  end;
1034 >    until TypeID = 0
1035 >  end
1036   end;
1037  
1038   {          ListAllGrants
# Line 937 | Line 1048 | const
1048                  '  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
1049                  'ORDER BY RDB$RELATION_NAME';
1050  
1051 <  ProcedureSQL = 'select * from RDB$PROCEDURES ' +
1051 >  ProcedureSQL = 'select * from RDB$PROCEDURES '+
1052 >                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1053                   'Order BY RDB$PROCEDURE_NAME';
1054  
1055 +  ExceptionSQL = 'select * from RDB$EXCEPTIONS '+
1056 +                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1057 +                 'Order BY RDB$EXCEPTION_NAME';
1058 +
1059 +  GeneratorSQL = 'select * from RDB$GENERATORS '+
1060 +                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1061 +                 'Order BY RDB$GENERATOR_NAME';
1062 +
1063   var
1064    qryRoles : TIBSQL;
1065    RelationName : String;
# Line 969 | Line 1089 | begin
1089  
1090      ShowGrantRoles(Term);
1091  
1092 +    qryRoles.SQL.Text := ExceptionSQL;
1093 +    qryRoles.ExecQuery;
1094 +    try
1095 +      while not qryRoles.Eof do
1096 +      begin
1097 +        ShowGrants(Trim(qryRoles.FieldByName('RDB$EXCEPTION_NAME').AsString), Term);
1098 +        qryRoles.Next;
1099 +      end;
1100 +    finally
1101 +      qryRoles.Close;
1102 +    end;
1103 +
1104 +    qryRoles.SQL.Text := GeneratorSQL;
1105 +    qryRoles.ExecQuery;
1106 +    try
1107 +      while not qryRoles.Eof do
1108 +      begin
1109 +        ShowGrants(Trim(qryRoles.FieldByName('RDB$GENERATOR_NAME').AsString), Term);
1110 +        qryRoles.Next;
1111 +      end;
1112 +    finally
1113 +      qryRoles.Close;
1114 +    end;
1115 +
1116      qryRoles.SQL.Text := ProcedureSQL;
1117      qryRoles.ExecQuery;
1118      try
# Line 996 | Line 1140 | end;
1140  
1141           procname -- Name of procedure to investigate }
1142  
1143 < procedure TIBExtract.ListProcs(ProcedureName : String);
1143 > procedure TIBExtract.ListProcs(ProcDDLType: TProcDDLType;
1144 >  ProcedureName: String; IncludeGrants: boolean);
1145   const
1146    CreateProcedureStr1 = 'CREATE PROCEDURE %s ';
1147    CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';
1148 <  ProcedureSQL =
1149 <    'SELECT * FROM RDB$PROCEDURES ' +
1150 <    'ORDER BY RDB$PROCEDURE_NAME';
1148 >  ProcedureSQL =  {Order procedures by dependency order and then procedure name}
1149 >                  'with recursive Procs as ( ' +
1150 >                  'Select RDB$PROCEDURE_NAME, 1 as ProcLevel from RDB$PROCEDURES ' +
1151 >                  'UNION ALL ' +
1152 >                  'Select D.RDB$DEPENDED_ON_NAME, ProcLevel + 1 From RDB$DEPENDENCIES D ' +
1153 >                  'JOIN Procs on Procs.RDB$PROCEDURE_NAME = D.RDB$DEPENDENT_NAME ' +
1154 >                  '  and Procs.RDB$PROCEDURE_NAME <> D.RDB$DEPENDED_ON_NAME ' +
1155 >                  'JOIN RDB$PROCEDURES P On P.RDB$PROCEDURE_NAME = D.RDB$DEPENDED_ON_NAME ' +
1156 >                  '  ) ' +
1157 >                  'SELECT * FROM RDB$PROCEDURES P ' +
1158 >                  'JOIN ( ' +
1159 >                  'Select RDB$PROCEDURE_NAME, max(ProcLevel) as ProcLevel From Procs ' +
1160 >                  'Group By RDB$PROCEDURE_NAME) A On A.RDB$PROCEDURE_NAME = P.RDB$PROCEDURE_NAME ' +
1161 >                  'Order by A.ProcLevel desc, P.RDB$PROCEDURE_NAME asc';
1162  
1163    ProcedureNameSQL =
1164      'SELECT * FROM RDB$PROCEDURES ' +
# Line 1014 | Line 1170 | var
1170    ProcName : String;
1171    SList : TStrings;
1172    Header : Boolean;
1173 +
1174   begin
1175  
1176    Header := true;
1177    qryProcedures := TIBSQL.Create(FDatabase);
1178    SList := TStringList.Create;
1179    try
1023 {  First the dummy procedures
1024    create the procedures with their parameters }
1180      if ProcedureName = '' then
1181        qryProcedures.SQL.Text := ProcedureSQL
1182      else
# Line 1029 | Line 1184 | begin
1184        qryProcedures.SQL.Text := ProcedureNameSQL;
1185        qryProcedures.Params.ByName('ProcedureName').AsString := ProcedureName;
1186      end;
1187 +
1188      qryProcedures.ExecQuery;
1189      while not qryProcedures.Eof do
1190      begin
# Line 1037 | Line 1193 | begin
1193          FMetaData.Add('COMMIT WORK;');
1194          FMetaData.Add('SET AUTODDL OFF;');
1195          FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term]));
1196 <        FMetaData.Add(Format('%s/* Stored procedures */%s', [NEWLINE, NEWLINE]));
1196 >        FMetaData.Add(Format('%s/* Stored procedures */%s', [LineEnding, LineEnding]));
1197          Header := false;
1198        end;
1199        ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
1044      FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1045         ProcName)]));
1046      GetProcedureArgs(ProcName);
1047      FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, NEWLINE]));
1048      qryProcedures.Next;
1049    end;
1200  
1201 <    qryProcedures.Close;
1202 <    qryProcedures.ExecQuery;
1203 <    while not qryProcedures.Eof do
1204 <    begin
1205 <      SList.Clear;
1206 <      ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
1207 <      FMetaData.Add(Format('%sALTER PROCEDURE %s ', [NEWLINE,
1208 <         QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1209 <      GetProcedureArgs(ProcName);
1210 <
1211 <      if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1212 <        SList.Text := SList.Text + qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1213 <      SList.Add(Format(' %s%s', [ProcTerm, NEWLINE]));
1214 <      FMetaData.AddStrings(SList);
1201 >      case ProcDDLType of
1202 >      pdCreateStub:
1203 >        begin
1204 >          FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1205 >             ProcName)]));
1206 >          GetProcedureArgs(ProcName);
1207 >          FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1208 >        end;
1209 >
1210 >      pdCreateProc:
1211 >      begin
1212 >        FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1213 >           ProcName)]));
1214 >        GetProcedureArgs(ProcName);
1215 >        if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1216 >        begin
1217 >          SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1218 >          SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1219 >          FMetaData.AddStrings(SList);
1220 >        end
1221 >        else
1222 >          FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1223 >      end;
1224 >
1225 >      pdAlterProc:
1226 >       begin
1227 >         FMetaData.Add(Format('%sALTER PROCEDURE %s ', [LineEnding,
1228 >            QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1229 >         GetProcedureArgs(ProcName);
1230 >
1231 >         if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1232 >         begin
1233 >           SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1234 >           SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1235 >           FMetaData.AddStrings(SList);
1236 >         end
1237 >         else
1238 >           FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1239 >       end;
1240 >      end;
1241 >      if IncludeGrants then
1242 >        ShowGrantsTo(ProcName,obj_procedure,ProcTerm);
1243        qryProcedures.Next;
1244      end;
1245 <
1068 < { This query gets the procedure name and the source.  We then nest a query
1069 <   to retrieve the parameters. Alter is used, because the procedures are
1070 <   already there}
1245 >    qryProcedures.Close;
1246  
1247      if not Header then
1248      begin
# Line 1128 | Line 1303 | end;
1303          Lists triggers in general on non-system
1304          tables with sql source only. }
1305  
1306 < procedure TIBExtract.ListTriggers(AlterTrigger, IncludeBody: boolean;
1307 <  ObjectName: String; ExtractType: TExtractType);
1306 > procedure TIBExtract.ListTriggers(ObjectName: String; ExtractTypes: TExtractTypes
1307 >  );
1308   const
1309   { Query gets the trigger info for non-system triggers with
1310     source that are not part of an SQL constraint }
1311  
1312    TriggerSQL =
1313 <    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1313 >    'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1314      '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1315      'WHERE ' +
1316      ' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
# Line 1156 | Line 1331 | const
1331      '    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1332  
1333    TriggerByNameSQL =
1334 <    'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1334 >    'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1335      '  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1336      'WHERE ' +
1337      ' TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
# Line 1180 | Line 1355 | begin
1355        qryTriggers.SQL.Text := TriggerSQL
1356      else
1357      begin
1358 <      if ExtractType = etTable then
1358 >      if etTable in ExtractTypes  then
1359        begin
1360          qryTriggers.SQL.Text := TriggerNameSQL;
1361          qryTriggers.Params.ByName('TableName').AsString := ObjectName;
# Line 1197 | Line 1372 | begin
1372        SList.Clear;
1373        if Header then
1374        begin
1375 <        FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, NEWLINE]));
1375 >        FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, LineEnding]));
1376          FMetaData.Add(Format('%s/* Triggers only will work for SQL triggers */%s',
1377 <                       [NEWLINE, NEWLINE]));
1377 >                       [LineEnding, LineEnding]));
1378          Header := false;
1379        end;
1380        TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsString;
# Line 1215 | Line 1390 | begin
1390        if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1391          SList.Add('/* ');
1392  
1393 <      if AlterTrigger then
1394 <        SList.Add(Format('Alter TRIGGER %s ',[QuoteIdentifier(FDatabase.SQLDialect, TriggerName)]))
1395 <    else
1396 <        SList.Add(Format('CREATE TRIGGER %s FOR %s %s%s %s POSITION %d',
1397 <                [QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1398 <           QuoteIdentifier(FDatabase.SQLDialect, RelationName),
1399 <           NEWLINE, InActive,
1400 <           GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger),
1401 <           qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1402 <      if IncludeBody and not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1403 <        SList.Text := SList.Text +
1404 <              qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString
1393 >      {Database or Transaction trigger}
1394 >      SList.Add(Format('CREATE TRIGGER %s%s%s %s POSITION %d',
1395 >                [QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1396 >                LineEnding, InActive,
1397 >                GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInt64),
1398 >                qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1399 >
1400 >      if RelationName <> '' then
1401 >        SList.Add('ON ' + QuoteIdentifier(FDatabase.SQLDialect, RelationName));
1402 >
1403 >      if not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1404 >        SList.Add(qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString)
1405        else
1406 <        SList.Text := SList.Text + 'AS BEGIN EXIT; END';
1407 <      SList.Add(' ' + ProcTerm + NEWLINE);
1406 >        SList.Add('AS BEGIN EXIT; END');
1407 >      SList.Add(' ' + ProcTerm);
1408        if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1409          SList.Add(' */');
1410        FMetaData.AddStrings(SList);
1411 +      if etGrant in ExtractTypes then
1412 +        ShowGrantsTo(TriggerName,obj_trigger,ProcTerm);
1413        qryTriggers.Next;
1414      end;
1415      if not Header then
# Line 1317 | Line 1494 | begin
1494        if not qryChecks.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1495          SList.Text := SList.Text + qryChecks.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1496  
1497 <      SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + NEWLINE;
1497 >      SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + LineEnding;
1498        FMetaData.AddStrings(SList);
1499        qryChecks.Next;
1500      end;
# Line 1376 | Line 1553 | begin
1553      NoDb := true;
1554    end;
1555    Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +
1556 <    IntToStr(FDatabaseInfo.PageSize) + NEWLINE;
1556 >    IntToStr(FDatabaseInfo.PageSize) + LineEnding;
1557    FMetaData.Add(Buffer);
1558    Buffer := '';
1559  
# Line 1387 | Line 1564 | begin
1564  
1565      if not qryDB.EOF then
1566        Buffer := Format(' DEFAULT CHARACTER SET %s',
1567 <        [qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
1567 >        [trim(qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString)]);
1568      if NoDB then
1569        Buffer := Buffer + Term + ' */'
1570      else
# Line 1402 | Line 1579 | begin
1579      begin
1580        if First then
1581        begin
1582 <        FMetaData.Add(NEWLINE + '/* Add secondary files in comments ');
1582 >        FMetaData.Add(LineEnding + '/* Add secondary files in comments ');
1583          First := false;
1584        end; //end_if
1585  
# Line 1427 | Line 1604 | begin
1604        if FileFlags = 0 then
1605        begin
1606          Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',
1607 <          [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1607 >          [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1608          if FileStart <> 0 then
1609            Buffer := Buffer + Format(' STARTING %d', [FileStart]);
1610          if FileLength <> 0 then
# Line 1436 | Line 1613 | begin
1613        end; //end_if
1614        if (FileFlags and FILE_cache) <> 0 then
1615          FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',
1616 <          [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1616 >          [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1617  
1618        Buffer := '';
1619        if (FileFlags and FILE_shadow) <> 0 then
# Line 1447 | Line 1624 | begin
1624          else
1625          begin
1626            Buffer := Format('%sCREATE SHADOW %d ''%s'' ',
1627 <            [NEWLINE, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1627 >            [LineEnding, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1628               qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1629            if (FileFlags and FILE_inactive) <> 0 then
1630              Buffer := Buffer + 'INACTIVE ';
# Line 1488 | Line 1665 | begin
1665        begin
1666          if NoDB then
1667            Buffer := '/* ';
1668 <        Buffer := Buffer + NEWLINE + 'ALTER DATABASE ADD ';
1668 >        Buffer := Buffer + LineEnding + 'ALTER DATABASE ADD ';
1669          First := false;
1670        end; //end_if
1671        if FirstFile then
# Line 1498 | Line 1675 | begin
1675        begin
1676          if (FileFlags and LOG_overflow) <> 0 then
1677            Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',
1678 <            [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1678 >            [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1679          else
1680            if (FileFlags and LOG_serial) <> 0 then
1681              Buffer := Buffer + Format('%s  BASE_NAME ''%s''',
1682 <              [NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1682 >              [LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1683            { Since we are fetching order by FILE_FLAGS, the LOG_0verflow will
1684               be last.  It will only appear if there were named round robin,
1685               so we must close the parens first }
# Line 1513 | Line 1690 | begin
1690              if FirstFile then
1691                Buffer := Buffer + '('
1692              else
1693 <              Buffer := Buffer + Format(',%s  ', [NEWLINE]);
1693 >              Buffer := Buffer + Format(',%s  ', [LineEnding]);
1694              FirstFile := false;
1695  
1696              Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsString]);
# Line 1547 | Line 1724 | begin
1724      if not First then
1725      begin
1726        if NoDB then
1727 <        FMetaData.Add(Format('%s */%s', [NEWLINE, NEWLINE]))
1727 >        FMetaData.Add(Format('%s */%s', [LineEnding, LineEnding]))
1728        else
1729 <        FMetaData.Add(Format('%s%s%s', [Term, NEWLINE, NEWLINE]));
1729 >        FMetaData.Add(Format('%s%s%s', [Term, LineEnding, LineEnding]));
1730      end;
1731    finally
1732      qryDB.Free;
# Line 1651 | Line 1828 | var
1828        Result := Result + Format(' SEGMENT SIZE %d', [qryDomains.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
1829      end //end_if
1830      else
1831 <    if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
1832 <       (not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
1833 <      Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1831 >    if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
1832 >    begin
1833 >       if not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
1834 >         Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
1835 >       else
1836 >         Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1837 >    end;
1838  
1839      { since the character set is part of the field type, display that
1840       information now. }
# Line 1664 | Line 1845 | var
1845        Result := GetArrayField(qryDomains.FieldByName('RDB$FIELD_SOURCE').AsString);
1846  
1847      if not qryDomains.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
1848 <      Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1848 >      Result := Result + Format('%s%s %s', [LineEnding, TAB,
1849           qryDomains.FieldByName('RDB$DEFAULT_SOURCE').AsString]);
1850  
1851      if not qryDomains.FieldByName('RDB$VALIDATION_SOURCE').IsNull then
1852        if Pos('CHECK', AnsiUpperCase(qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString)) = 1 then
1853 <        Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1853 >        Result := Result + Format('%s%s %s', [LineEnding, TAB,
1854             qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString])
1855        else
1856 <        Result := Result + Format('%s%s /* %s */', [NEWLINE, TAB,
1856 >        Result := Result + Format('%s%s /* %s */', [LineEnding, TAB,
1857             qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString]);
1858  
1859      if qryDomains.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
# Line 2041 | Line 2222 | begin
2222        if First then
2223        begin
2224          FMEtaData.Add(Format('%s/*  External Function declarations */%s',
2225 <          [NEWLINE, NEWLINE]));
2225 >          [LineEnding, LineEnding]));
2226          First := false;
2227        end; //end_if
2228        { Start new function declaration }
# Line 2168 | Line 2349 | begin
2349        FMetaData.Add(Format('ENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%s%s',
2350          [qryFunctions.FieldByName('RDB$ENTRYPOINT').AsString,
2351           qryFunctions.FieldByName('RDB$MODULE_NAME').AsString,
2352 <         Term, NEWLINE, NEWLINE]));
2352 >         Term, LineEnding, LineEnding]));
2353  
2354        qryFunctions.Next;
2355      end;
# Line 2184 | Line 2365 | end;
2365   Functional description
2366     Re create all non-system generators }
2367  
2368 < procedure TIBExtract.ListGenerators(GeneratorName : String = '');
2368 > procedure TIBExtract.ListGenerators(GeneratorName: String;
2369 >  ExtractTypes: TExtractTypes);
2370   const
2371    GeneratorSQL =
2372      'SELECT RDB$GENERATOR_NAME ' +
# Line 2200 | Line 2382 | const
2382      '  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2383      'ORDER BY RDB$GENERATOR_NAME';
2384  
2385 +  GeneratorValueSQL =
2386 +    'SELECT GEN_ID(%s,0) as GENERATORVALUE From RDB$Database';
2387 +
2388   var
2389    qryGenerator : TIBSQL;
2390 +  qryValue: TIBSQL;
2391    GenName : String;
2392   begin
2393    qryGenerator := TIBSQL.Create(FDatabase);
2394 +  qryValue := TIBSQL.Create(FDatabase);
2395    try
2396      if GeneratorName = '' then
2397        qryGenerator.SQL.Text := GeneratorSQL
# Line 2229 | Line 2416 | begin
2416        FMetaData.Add(Format('CREATE SEQUENCE %s%s',
2417          [QuoteIdentifier(FDatabase.SQLDialect, GenName),
2418           Term]));
2419 +      if etData in ExtractTypes then
2420 +      begin
2421 +        qryValue.SQL.Text := Format(GeneratorValueSQL,[GenName]);
2422 +        qryValue.ExecQuery;
2423 +        try
2424 +          if not qryValue.EOF then
2425 +            FMetaData.Add(Format('ALTER SEQUENCE %s RESTART WITH %d;',
2426 +                 [QuoteIdentifier(FDatabase.SQLDialect, GenName),
2427 +                  qryValue.FieldByName('GENERATORVALUE').AsInteger]));
2428 +        finally
2429 +          qryValue.Close;
2430 +        end;
2431 +      end;
2432        qryGenerator.Next;
2433      end;
2434    finally
2435      qryGenerator.Free;
2436 +    qryValue.Free;
2437    end;
2438   end;
2439  
# Line 2306 | Line 2507 | begin
2507        if First then
2508        begin
2509          if ObjectName = '' then
2510 <          FMetaData.Add(NEWLINE + '/*  Index definitions for all user tables */' + NEWLINE)
2510 >          FMetaData.Add(LineEnding + '/*  Index definitions for all user tables */' + LineEnding)
2511          else
2512 <          FMetaData.Add(NEWLINE + '/*  Index definitions for ' + ObjectName + ' */' + NEWLINE);
2512 >          FMetaData.Add(LineEnding + '/*  Index definitions for ' + ObjectName + ' */' + LineEnding);
2513          First := false;
2514        end; //end_if
2515  
# Line 2348 | Line 2549 | end;
2549   procedure TIBExtract.ListViews(ViewName : String);
2550   const
2551    ViewSQL =
2552 +    'with recursive Views as ( ' +
2553 +    '  Select RDB$RELATION_NAME, 1 as ViewLevel from RDB$RELATIONS ' +
2554 +    '    Where RDB$RELATION_TYPE = 1 and RDB$SYSTEM_FLAG = 0 '+
2555 +    '  UNION ALL ' +
2556 +    '  Select D.RDB$DEPENDED_ON_NAME, ViewLevel + 1 From RDB$DEPENDENCIES D ' +
2557 +    '  JOIN Views on Views.RDB$RELATION_NAME = D.RDB$DEPENDENT_NAME ' +
2558 +    '     and Views.RDB$RELATION_NAME <> D.RDB$DEPENDED_ON_NAME ' +
2559 +    '  JOIN RDB$RELATIONS R On R.RDB$RELATION_NAME = D.RDB$DEPENDED_ON_NAME ' +
2560 +    ')' +
2561 +    'SELECT R.RDB$RELATION_NAME, R.RDB$OWNER_NAME, R.RDB$VIEW_SOURCE FROM RDB$RELATIONS R ' +
2562 +    'JOIN ( ' +
2563 +    'Select RDB$RELATION_NAME, max(ViewLevel) as ViewLevel From Views ' +
2564 +    'Group By RDB$RELATION_NAME) A On A.RDB$RELATION_NAME = R.RDB$RELATION_NAME ' +
2565 +    'Where R.RDB$RELATION_TYPE = 1 and R.RDB$SYSTEM_FLAG = 0 '+
2566 +    'Order by A.ViewLevel desc, R.RDB$RELATION_NAME asc';
2567 +
2568 + {
2569      'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2570      'FROM RDB$RELATIONS ' +
2571      'WHERE ' +
2572      '  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2573      '  NOT RDB$VIEW_BLR IS NULL AND ' +
2574      '  RDB$FLAGS = 1 ' +
2575 <    'ORDER BY RDB$RELATION_ID';
2575 >    'ORDER BY RDB$RELATION_ID'; }
2576  
2577    ViewNameSQL =
2578      'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
# Line 2392 | Line 2610 | begin
2610      while not qryView.Eof do
2611      begin
2612        SList.Add(Format('%s/* View: %s, Owner: %s */%s',
2613 <         [NEWLINE, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2614 <          qryView.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
2613 >         [LineEnding, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2614 >          qryView.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
2615  
2616        SList.Add(Format('CREATE VIEW %s (', [QuoteIdentifier(FDatabase.SQLDialect,
2617          qryView.FieldByName('RDB$RELATION_NAME').AsString)]));
# Line 2410 | Line 2628 | begin
2628            SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + ', ';
2629        end;
2630        qryColumns.Close;
2631 <      SList.Text := SList.Text + Format(') AS%s', [NEWLINE]);
2631 >      SList.Text := SList.Text + Format(') AS%s', [LineEnding]);
2632        if not qryView.FieldByName('RDB$VIEW_SOURCE').IsNull then
2633          SList.Text := SList.Text + qryView.FieldByName('RDB$VIEW_SOURCE').AsString;
2634 <      SList.Text := SList.Text + Format('%s%s', [Term, NEWLINE]);
2634 >      SList.Text := SList.Text + Format('%s%s', [Term, LineEnding]);
2635        FMetaData.AddStrings(SList);
2636        SList.Clear;
2637        qryView.Next;
# Line 2442 | Line 2660 | begin
2660      Used := true;
2661    end
2662    else
2663 <    Result := Format(', %s      ', [NEWLINE]);
2663 >    Result := Format(', %s      ', [LineEnding]);
2664   end;
2665  
2666   {
# Line 2487 | Line 2705 | end;
2705  
2706   procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2707   begin
2708 <  if FDatabase <> Value then
2708 >  if (csLoading in ComponentState) or (FDatabase <> Value) then
2709    begin
2710      FDatabase := Value;
2711      if (not Assigned(FTransaction)) and (FDatabase <> nil) then
# Line 2519 | Line 2737 | begin
2737    end;
2738    FMetaData.Clear;
2739    case ObjectType of
2740 <    eoDatabase : ExtractDDL(true, '');
2740 >    eoDatabase : ExtractDDL(true, '', etData in ExtractTypes);
2741      eoDomain :
2742        if etTable in ExtractTypes then
2743          ListDomains(ObjectName, etTable)
# Line 2539 | Line 2757 | begin
2757          if etCheck in ExtractTypes then
2758            ListCheck(ObjectName, etTable);
2759          if etTrigger in ExtractTypes then
2760 <          ListTriggers(false,true,ObjectName, etTable);
2760 >        begin
2761 >          if etGrant in ExtractTypes then
2762 >            ListTriggers(ObjectName, [etTable,etGrant])
2763 >          else
2764 >            ListTriggers(ObjectName, [etTable]);
2765 >        end;
2766          if etGrant in ExtractTypes then
2767            ShowGrants(ObjectName, Term);
2768          if etData in ExtractTypes then
# Line 2554 | Line 2777 | begin
2777         if ObjectName <> '' then
2778         begin
2779           if etTrigger in ExtractTypes then
2780 <           ListTriggers(false,true,ObjectName, etTable);
2780 >         begin
2781 >           if etGrant in ExtractTypes then
2782 >             ListTriggers(ObjectName, [etTable,etGrant])
2783 >           else
2784 >             ListTriggers(ObjectName, [etTable]);
2785 >         end;
2786 >         if etGrant in ExtractTypes then
2787 >           ShowGrants(ObjectName, Term);
2788         end;
2789       end;
2790 <    eoProcedure : ListProcs(ObjectName);
2790 >    eoProcedure :
2791 >     begin
2792 >       ListProcs(pdCreateProc,ObjectName,etGrant in ExtractTypes);
2793 >       if (ObjectName <> '' ) and (etGrant in ExtractTypes) then
2794 >         ShowGrants(ObjectName, Term);
2795 >     end;
2796      eoFunction : ListFunctions(ObjectName);
2797 <    eoGenerator : ListGenerators(ObjectName);
2797 >    eoGenerator : ListGenerators(ObjectName,ExtractTypes);
2798      eoException : ListException(ObjectName);
2799      eoBLOBFilter : ListFilters(ObjectName);
2800      eoRole : ListRoles(ObjectName);
2801      eoTrigger :
2802        if etTable in ExtractTypes then
2803 <        ListTriggers(false,true,ObjectName, etTable)
2803 >      begin
2804 >        if etGrant in ExtractTypes then
2805 >          ListTriggers(ObjectName, [etTable,etGrant])
2806 >        else
2807 >          ListTriggers(ObjectName, [etTable])
2808 >      end
2809 >      else
2810 >      if etGrant in ExtractTypes then
2811 >        ListTriggers(ObjectName,[etTrigger,etGrant])
2812        else
2813 <        ListTriggers(false,true,ObjectName);
2813 >        ListTriggers(ObjectName);
2814      eoForeign :
2815        if etTable in ExtractTypes then
2816          ListForeign(ObjectName, etTable)
# Line 2657 | Line 2900 | end;
2900  
2901   procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String);
2902   const
2903 <  { This query only finds tables, eliminating owner privileges }
2904 <  OwnerPrivSQL =
2905 <    'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2906 <    '       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE ' +
2907 <    'FROM RDB$USER_PRIVILEGES PRV, RDB$RELATIONS REL ' +
2908 <    'WHERE ' +
2909 <    '  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2910 <    '  REL.RDB$RELATION_NAME = :METAOBJECT AND ' +
2911 <    '  PRV.RDB$PRIVILEGE <> ''M'' AND ' +
2912 <    '  REL.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2913 <    'ORDER BY  PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2914 <
2915 <  ProcPrivSQL =
2916 <    'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2917 <    '       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE, PRV.RDB$RELATION_NAME ' +
2918 <    'FROM RDB$USER_PRIVILEGES PRV, RDB$PROCEDURES PRC ' +
2919 <    'where ' +
2920 <    '  PRV.RDB$OBJECT_TYPE = 5 AND ' +
2921 <    '  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2922 <    '  PRC.RDB$PROCEDURE_NAME = :METAOBJECT AND ' +
2923 <    '  PRV.RDB$PRIVILEGE = ''X'' AND ' +
2924 <    '  PRC.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2925 <    'ORDER BY PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2926 <
2927 <  RolePrivSQL =
2928 <    'SELECT * FROM RDB$USER_PRIVILEGES ' +
2929 <    'WHERE ' +
2930 <    '  RDB$OBJECT_TYPE = 13 AND ' +
2931 <    '  RDB$USER_TYPE = 8  AND ' +
2932 <    '  RDB$RELATION_NAME = :METAOBJECT AND ' +
2933 <    '  RDB$PRIVILEGE = ''M'' ' +
2934 <    'ORDER BY RDB$USER';
2903 >  GrantsBaseSelect =
2904 >  'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
2905 >  'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
2906 >  'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
2907 >  'case  RDB$OBJECT_TYPE '+
2908 >  'When 0 then ''TABLE'' '+
2909 >  'When 5 then ''PROCEDURE'' '+
2910 >  'When 7 then ''EXCEPTION'' '+
2911 >  'When 11 then ''CHARACTER SET'' '+
2912 >  'When 14 then ''GENERATOR'' '+
2913 >  'ELSE NULL END as OBJECT_TYPE_NAME, '+
2914 >  'case RDB$USER_TYPE '+
2915 >  'When 5 then ''PROCEDURE'' '+
2916 >  'When 2 then ''TRIGGER'' '+
2917 >  'When 8 then ''USER'' '+
2918 >  'When 13 then ''ROLE'' '+
2919 >  'ELSE NULL END as USER_TYPE_NAME, '+
2920 >  'case '+
2921 >  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
2922 >  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
2923 >  'ELSE '''' End as GRANTOPTION '+
2924 >  'From (  '+
2925 >  'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
2926 >  'When ''X'' then ''EXECUTE''  '+
2927 >  'When ''S'' then ''SELECT''  '+
2928 >  'When ''U'' then ''UPDATE''   '+
2929 >  'When ''D'' then ''DELETE''  '+
2930 >  'When ''R'' then ''REFERENCES''  '+
2931 >  'When ''G'' then ''USAGE''  '+
2932 >  'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
2933 >  'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME  '+
2934 >  'FROM RDB$USER_PRIVILEGES PR  '+
2935 >  'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
2936 >  'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
2937 >  '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  '+
2938 >  'UNION  '+
2939 >  'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
2940 >  'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME   '+
2941 >  'FROM RDB$USER_PRIVILEGES PR  '+
2942 >  'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
2943 >  'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
2944 >  '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)  '+
2945 >  'Where METAOBJECTNAME = :METAOBJECTNAME and RDB$USER <> RDB$OWNER_NAME  '+
2946 >  'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE,METAOBJECTNAME '+
2947 >  'ORDER BY RDB$USER, RDB$OBJECT_TYPE';
2948 >
2949 >  GrantsSQL12 =
2950 >  'with ObjectOwners As ( '+
2951 >  'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
2952 >  'From RDB$RELATIONS '+
2953 >  'UNION '+
2954 >  'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
2955 >  'From RDB$PROCEDURES '+
2956 >  'UNION '+
2957 >  'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 7 as ObjectType '+
2958 >  'From RDB$EXCEPTIONS '+
2959 >  'UNION '+
2960 >  'Select RDB$GENERATOR_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 14 as ObjectType '+
2961 >  'From RDB$GENERATORS '+
2962 >  'UNION '+
2963 >  'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 11 as ObjectType '+
2964 >  'From RDB$CHARACTER_SETS '+
2965 >  ') '+ GrantsBaseSelect;
2966 >
2967 >  GrantsSQL =
2968 >  'with ObjectOwners As ( '+
2969 >  'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
2970 >  'From RDB$RELATIONS '+
2971 >  'UNION '+
2972 >  'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
2973 >  'From RDB$PROCEDURES '+
2974 >  'UNION '+
2975 >  'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, ''SYSDBA'', 7 as ObjectType '+
2976 >  'From RDB$EXCEPTIONS '+
2977 >  'UNION '+
2978 >  'Select RDB$GENERATOR_NAME as METAOBJECTNAME, ''SYSDBA'', 14 as ObjectType '+
2979 >  'From RDB$GENERATORS '+
2980 >  'UNION '+
2981 >  'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, ''SYSDBA'', 11 as ObjectType '+
2982 >  'From RDB$CHARACTER_SETS '+
2983 >  ') '+ GrantsBaseSelect;
2984  
2985 < var
2694 <  PrevUser, PrevField,  WithOption,
2695 <  PrivString, ColString, UserString,
2696 <  FieldName, User : String;
2697 <  c : Char;
2698 <  PrevOption, PrivFlags, GrantOption : Integer;
2699 <  First, PrevFieldNull : Boolean;
2700 <  qryOwnerPriv : TIBSQL;
2701 <
2702 <    {  Given a bit-vector of privileges, turn it into a
2703 <       string list. }
2704 <  function MakePrivString(cflags : Integer) : String;
2705 <  var
2706 <    i : Integer;
2707 <  begin
2708 <    Result := '';
2709 <    for i := Low(PrivTypes) to High(PrivTypes) do
2710 <    begin
2711 <      if (cflags and PrivTypes[i].PrivFlag) <> 0 then
2712 <      begin
2713 <        if Result <> '' then
2714 <          Result := Result + ', ';
2715 <        Result := Result + PrivTypes[i].PrivString;
2716 <      end; //end_if
2717 <    end; //end_for
2718 <  end; //end_fcn MakePrivDtring
2985 > var qryOwnerPriv : TIBSQL;
2986  
2987   begin
2988    if MetaObject = '' then
2989      exit;
2990  
2724  First := true;
2725  PrevOption := -1;
2726  PrevUser := '';
2727  PrivString := '';
2728  ColString := '';
2729  WithOption := '';
2730  PrivFlags := 0;
2731  PrevFieldNull := false;
2732  PrevField := '';
2733
2991    qryOwnerPriv := TIBSQL.Create(FDatabase);
2992    try
2993 <    qryOwnerPriv.SQL.Text := OwnerPrivSQL;
2994 <    qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2993 >    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
2994 >      qryOwnerPriv.SQL.Text := GrantsSQL12
2995 >    else
2996 >    qryOwnerPriv.SQL.Text := GrantsSQL;
2997 >    qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
2998      qryOwnerPriv.ExecQuery;
2999      while not qryOwnerPriv.Eof do
3000      begin
3001 <      { Sometimes grant options are null, sometimes 0.  Both same }
3002 <      if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').IsNull then
3003 <        GrantOption := 0
3004 <      else
3005 <        GrantOption := qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger;
3006 <
3007 <      if qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull then
3008 <        FieldName := ''
2749 <      else
2750 <        FieldName := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').AsString;
2751 <
2752 <      User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2753 <      { Print a new grant statement for each new user or change of option }
2754 <
2755 <      if ((PrevUser <> '') and (PrevUser <> User)) or
2756 <          ((Not First) and
2757 <            (PrevFieldNull <> qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull)) or
2758 <          ((not PrevFieldNull) and (PrevField <> FieldName)) or
2759 <          ((PrevOption <> -1) and (PrevOption <> GrantOption)) then
2760 <      begin
2761 <        PrivString := MakePrivString(PrivFlags);
2762 <
2763 <        First := false;
2764 <        FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2765 <          ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2766 <          UserString, WithOption, Terminator]));
2767 <        { re-initialize strings }
2768 <
2769 <        PrivString := '';
2770 <        WithOption := '';
2771 <        ColString := '';
2772 <        PrivFlags := 0;
2773 <      end; //end_if
2774 <
2775 <      PrevUser := User;
2776 <      PrevOption := GrantOption;
2777 <      PrevFieldNull := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull;
2778 <      PrevField := FieldName;
2779 <
2780 <      case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2781 <        obj_relation,
2782 <        obj_view,
2783 <        obj_trigger,
2784 <        obj_procedure,
2785 <        obj_sql_role:
2786 <          UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2787 <        else
2788 <          UserString := User;
2789 <      end; //end_case
2790 <
2791 <      case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2792 <        obj_view :
2793 <          UserString := 'VIEW ' + UserString;
2794 <        obj_trigger :
2795 <          UserString := 'TRIGGER '+ UserString;
2796 <        obj_procedure :
2797 <          UserString := 'PROCEDURE ' + UserString;
2798 <      end; //end_case
2799 <
2800 <      c := qryOwnerPriv.FieldByName('RDB$PRIVILEGE').AsString[1];
2801 <
2802 <      case c of
2803 <        'S' : PrivFlags := PrivFlags or priv_SELECT;
2804 <        'I' : PrivFlags := PrivFlags or priv_INSERT;
2805 <        'U' : PrivFlags := PrivFlags or priv_UPDATE;
2806 <        'D' : PrivFlags := PrivFlags or priv_DELETE;
2807 <        'R' : PrivFlags := PrivFlags or priv_REFERENCES;
2808 <        'X' : ;
2809 <          { Execute should not be here -- special handling below }
2810 <        else
2811 <          PrivFlags := PrivFlags or priv_UNKNOWN;
2812 <      end; //end_switch
2813 <
2814 <      { Column level privileges for update only }
2815 <
2816 <      if FieldName = '' then
2817 <        ColString := ''
2818 <      else
2819 <        ColString := Format(' (%s)', [QuoteIdentifier(FDatabase.SQLDialect, FieldName)]);
2820 <
2821 <      if GrantOption <> 0 then
2822 <        WithOption := ' WITH GRANT OPTION';
2823 <
3001 >      FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
3002 >                            qryOwnerPriv.FieldByName('Privileges').AsString,
3003 >                            qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
3004 >                            qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
3005 >                            qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
3006 >                            qryOwnerPriv.FieldByName('RDB$USER').AsString,
3007 >                            qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
3008 >                            Terminator]));
3009        qryOwnerPriv.Next;
3010      end;
2826    { Print last case if there was anything to print }
2827    if PrevOption <> -1 then
2828    begin
2829      PrivString := MakePrivString(PrivFlags);
2830      First := false;
2831      FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2832        ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2833        UserString, WithOption, Terminator]));
2834      { re-initialize strings }
2835    end; //end_if
3011      qryOwnerPriv.Close;
3012 +  finally
3013 +    qryOwnerPriv.Free;
3014 +  end;
3015 + end;
3016  
3017 <    if First then
3018 <    begin
3019 <     { Part two is for stored procedures only }
3020 <      qryOwnerPriv.SQL.Text := ProcPrivSQL;
3021 <      qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3022 <      qryOwnerPriv.ExecQuery;
3023 <      while not qryOwnerPriv.Eof do
3024 <      begin
3025 <        First := false;
3026 <        User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
3027 <
3028 <        case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
3029 <          obj_relation,
3030 <          obj_view,
3031 <          obj_trigger,
3032 <          obj_procedure,
3033 <          obj_sql_role:
3034 <            UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
3035 <          else
3036 <            UserString := User;
3037 <        end; //end_case
3038 <        case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
3039 <          obj_view :
3040 <            UserString := 'VIEW ' + UserString;
3041 <          obj_trigger :
3042 <            UserString := 'TRIGGER '+ UserString;
3043 <          obj_procedure :
3044 <            UserString := 'PROCEDURE ' + UserString;
3045 <        end; //end_case
3017 > procedure TIBExtract.ShowGrantsTo(MetaObject: String; ObjectType: integer; Terminator: String);
3018 > const
3019 >  GrantsSQL =
3020 >  'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
3021 >  'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
3022 >  'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
3023 >  'case  RDB$OBJECT_TYPE '+
3024 >  'When 0 then ''TABLE'' '+
3025 >  'When 5 then ''PROCEDURE'' '+
3026 >  'When 7 then ''EXCEPTION'' '+
3027 >  'When 11 then ''CHARACTER SET'' '+
3028 >  'ELSE NULL END as OBJECT_TYPE_NAME, '+
3029 >  'case RDB$USER_TYPE '+
3030 >  'When 5 then ''PROCEDURE'' '+
3031 >  'When 2 then ''TRIGGER'' '+
3032 >  'When 8 then ''USER'' '+
3033 >  'When 13 then ''ROLE'' '+
3034 >  'ELSE NULL END as USER_TYPE_NAME, '+
3035 >  'case '+
3036 >  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
3037 >  'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
3038 >  'ELSE '''' End as GRANTOPTION '+
3039 >  'From (  '+
3040 >  'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
3041 >  'When ''X'' then ''EXECUTE''  '+
3042 >  'When ''S'' then ''SELECT''  '+
3043 >  'When ''U'' then ''UPDATE''   '+
3044 >  'When ''D'' then ''DELETE''  '+
3045 >  'When ''R'' then ''REFERENCES''  '+
3046 >  'When ''G'' then ''USAGE''  '+
3047 >  'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
3048 >  'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
3049 >  'FROM RDB$USER_PRIVILEGES PR  '+
3050 >  'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
3051 >  'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
3052 >  'UNION  '+
3053 >  'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
3054 >  'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE   '+
3055 >  'FROM RDB$USER_PRIVILEGES PR  '+
3056 >  'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
3057 >  'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE)  '+
3058 >  'Where RDB$USER = :METAOBJECTNAME and RDB$USER_TYPE = :USERTYPE '+
3059 >  'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE, METAOBJECTNAME '+
3060 >  'ORDER BY METAOBJECTNAME';
3061  
3062 <        if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2869 <          WithOption := ' WITH GRANT OPTION'
2870 <        else
2871 <          WithOption := '';
3062 > var qryOwnerPriv : TIBSQL;
3063  
3064 <        FMetaData.Add(Format('GRANT EXECUTE ON PROCEDURE %s TO %s%s%s',
3065 <          [QuoteIdentifier(FDatabase.SQLDialect, MetaObject), UserString,
3066 <           WithOption, terminator]));
3064 > begin
3065 >  if MetaObject = '' then
3066 >    exit;
3067  
3068 <        qryOwnerPriv.Next;
3069 <      end;
3070 <      qryOwnerPriv.Close;
3071 <    end;
3072 <    if First then
3068 >  qryOwnerPriv := TIBSQL.Create(FDatabase);
3069 >  try
3070 >    qryOwnerPriv.SQL.Text := GrantsSQL;
3071 >    qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
3072 >    qryOwnerPriv.Params.ByName('USERTYPE').AsInteger := ObjectType;
3073 >    qryOwnerPriv.ExecQuery;
3074 >    while not qryOwnerPriv.Eof do
3075      begin
3076 <      qryOwnerPriv.SQL.Text := RolePrivSQL;
3077 <      qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3078 <      qryOwnerPriv.ExecQuery;
3079 <      while not qryOwnerPriv.Eof do
3080 <      begin
3081 <        if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
3082 <          WithOption := ' WITH ADMIN OPTION'
3083 <        else
3084 <          WithOption := '';
2892 <
2893 <        FMetaData.Add(Format('GRANT %s TO %s%s%s',
2894 <          [QuoteIdentifier(FDatabase.SQLDialect, qryOwnerPriv.FieldByName('RDB$RELATION_NAME').AsString),
2895 <           qryOwnerPriv.FieldByName('RDB$USER_NAME').AsString,
2896 <           WithOption, terminator]));
2897 <
2898 <        qryOwnerPriv.Next;
2899 <      end;
3076 >      FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
3077 >                            qryOwnerPriv.FieldByName('Privileges').AsString,
3078 >                            qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
3079 >                            qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
3080 >                            qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
3081 >                            qryOwnerPriv.FieldByName('RDB$USER').AsString,
3082 >                            qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
3083 >                            Terminator]));
3084 >      qryOwnerPriv.Next;
3085      end;
3086      qryOwnerPriv.Close;
3087    finally
3088      qryOwnerPriv.Free;
3089    end;
3090 +  FMetaData.Add('');
3091   end;
3092  
3093   {         ShowGrantRoles
# Line 2941 | Line 3127 | begin
3127          WithOption := '';
3128        FMetaData.Add(Format('GRANT %s TO %s%s%s%s',
3129          [ QuoteIdentifier(FDatabase.SQLDialect, qryRole.FieldByName('RDB$RELATION_NAME').AsString),
3130 <         UserString, WithOption, Terminator, NEWLINE]));
3130 >         UserString, WithOption, Terminator, LineEnding]));
3131  
3132        qryRole.Next;
3133      end;
# Line 3021 | Line 3207 | var
3207          end;
3208          break;
3209        end;
3210 <    if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
3211 <       (not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
3212 <      Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3210 >    if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
3211 >    begin
3212 >       if not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
3213 >         Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
3214 >       else
3215 >         Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3216 >    end;
3217  
3218      { Show international character sets and collations }
3219  
# Line 3084 | Line 3274 | begin
3274        if FirstTime then
3275        begin
3276          FirstTime := false;
3277 <        FMetaData.Add('RETURNS' + NEWLINE + '(');
3277 >        FMetaData.Add('RETURNS' + LineEnding + '(');
3278        end;
3279  
3280        Line := FormatParamStr;
# Line 3119 | Line 3309 | end;
3309  
3310   procedure TIBExtract.ListData(ObjectName: String);
3311   const
3312 <  SelectSQL = 'SELECT * FROM %s';
3313 < var
3314 <  qrySelect : TIBSQL;
3315 <  Line : String;
3316 <  i : Integer;
3312 >  SelectFieldListSQL = 'Select List(RDB$FIELD_NAME) From ( '+
3313 >    'Select RF.RDB$FIELD_NAME From RDB$RELATION_FIELDS RF '+
3314 >    'JOIN RDB$FIELDS F On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
3315 >    'Where F.RDB$COMPUTED_BLR is NULL and RF.RDB$RELATION_NAME = Upper(:Relation) '+
3316 >    'Order by RF.RDB$FIELD_POSITION asc)';
3317 >
3318 >  TableSQL =
3319 >    'SELECT * FROM RDB$RELATIONS ' +
3320 >    'WHERE ' +
3321 >    '  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
3322 >    '  RDB$VIEW_BLR IS NULL ' +
3323 >    'ORDER BY RDB$RELATION_NAME';
3324 >
3325 > var FieldList: string;
3326 >
3327   begin
3328 <  qrySelect := TIBSQL.Create(FDatabase);
3329 <  try
3330 <    qrySelect.SQL.Text := Format(SelectSQL,
3331 <      [QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]);
3332 <    qrySelect.ExecQuery;
3333 <    while not qrySelect.Eof do
3334 <    begin
3335 <      Line := 'INSERT INTO ' + QuoteIdentifier(FDatabase.SQLDialect, ObjectName) + ' (';
3336 <      for i := 0 to qrySelect.FieldCount - 1 do
3137 <        if (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3138 <           (qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3139 <        begin
3140 <          Line := Line + QuoteIdentifier(FDatabase.SQLDialect, qrySelect.Fields[i].Name);
3141 <          if i <> (qrySelect.FieldCount - 1) then
3142 <            Line := Line + ', ';
3143 <        end;
3144 <      Line := Line + ') VALUES (';
3145 <      for i := 0 to qrySelect.FieldCount - 1 do
3328 >  if ObjectName = '' then {List all}
3329 >  begin
3330 >    with TIBSQL.Create(self) do
3331 >    try
3332 >      Database := FDatabase;
3333 >      SQL.Text := TableSQL;
3334 >      ExecQuery;
3335 >      FMetaData.Add('/* Data Starts */');
3336 >      while not EOF do
3337        begin
3338 <        if qrySelect.Fields[i].IsNull and
3339 <           (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3149 <           (qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3150 <        begin
3151 <          Line := Line + 'NULL';
3152 <          if i <> (qrySelect.FieldCount - 1) then
3153 <            Line := Line + ', ';
3154 <        end
3155 <        else
3156 <        case qrySelect.Fields[i].SQLType of
3157 <          SQL_TEXT, SQL_VARYING, SQL_TYPE_DATE,
3158 <          SQL_TYPE_TIME, SQL_TIMESTAMP :
3159 <          begin
3160 <            Line := Line + QuotedStr(qrySelect.Fields[i].AsString);
3161 <            if i <> (qrySelect.FieldCount - 1) then
3162 <              Line := Line + ', ';
3163 <          end;
3164 <          SQL_SHORT, SQL_LONG, SQL_INT64,
3165 <          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN:
3166 <          begin
3167 <            Line := Line + qrySelect.Fields[i].AsString;
3168 <            if i <> (qrySelect.FieldCount - 1) then
3169 <              Line := Line + ', ';
3170 <          end;
3171 <          SQL_ARRAY, SQL_BLOB : ;
3172 <          else
3173 <            IBError(ibxeInvalidDataConversion, [nil]);
3174 <        end;
3338 >        ListData(Trim(FieldByName('RDB$RELATION_NAME').AsString));
3339 >        Next;
3340        end;
3341 <      Line := Line + ')' + Term;
3342 <      FMetaData.Add(Line);
3343 <      qrySelect.Next;
3341 >      FMetaData.Add('/* Data Ends */');
3342 >    finally
3343 >      Free;
3344 >    end;
3345 >  end
3346 >  else
3347 >  begin
3348 >    FieldList := '*';
3349 >    with TIBSQL.Create(self) do
3350 >    try
3351 >      Database := FDatabase;
3352 >      SQL.Text := SelectFieldListSQL;
3353 >      Params[0].AsString := ObjectName;
3354 >      ExecQuery;
3355 >      try
3356 >        if not EOF then
3357 >          FieldList := Fields[0].AsString;
3358 >      finally
3359 >        Close;
3360 >      end;
3361 >    finally
3362 >      Free
3363 >    end;
3364 >
3365 >    with TIBInsertStmtsOut.Create(self) do
3366 >    try
3367 >      Database := FDatabase;
3368 >      if DataOut(Format('Select %s From %s',[FieldList,QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]),
3369 >                Add2MetaData) then
3370 >        FMetaData.Add('COMMIT;');
3371 >    finally
3372 >      Free
3373      end;
3180  finally
3181    qrySelect.Free;
3374    end;
3375   end;
3376  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines