ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBExtract.pas

Comparing ibx/trunk/runtime/IBExtract.pas (file contents):
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 19 | Line 19
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                                                 }
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
#	Line 36 | Line 48 | uses
48		unix,
49		{$ENDIF}
50		SysUtils, Classes, IBDatabase, IBDatabaseInfo,
51	<	IBSQL, IBUtils, IBHeader, IB, IBIntf;
51	>	IBSQL, IBUtils, IBHeader, IB;
52
53		type
54		TExtractObjectTypes =
#	Line 46 | 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 58 | 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 85 | 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 98 | Line 121 | type
121		function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
122		FieldPrec, FieldLen : Integer) : String;
123		function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
101	–	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
124		procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
125		ExtractTypes : TExtractTypes = []);
126		property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
#	Line 121 | 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 132 | 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 155 | 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 168 | Line 193 | const
193		'TRANSACTION_DESCRIPTION',  { NTX: keyword }
194		'EXTERNAL_FILE_DESCRIPTION');       { NTX: keyword }
195
171	–	TriggerTypes : Array[0..6] of String = (
172	–	'',
173	–	'BEFORE INSERT',                    { NTX: keyword }
174	–	'AFTER INSERT',                             { NTX: keyword }
175	–	'BEFORE UPDATE',                    { NTX: keyword }
176	–	'AFTER UPDATE',                             { NTX: keyword }
177	–	'BEFORE DELETE',                    { NTX: keyword }
178	–	'AFTER DELETE');                    { NTX: keyword }
179	–
196		IntegralSubtypes : Array[0..2] of String = (
197		'UNKNOWN',                  { Defined type, NTX: keyword }
198		'NUMERIC',                  { NUMERIC, NTX: keyword }
#	Line 189 | 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 227 | Line 244 | const
244
245		implementation
246
247	+	uses FBMessages, IBDataOutput;
248	+
249		const
231	–	NEWLINE = #13#10;
250		TERM = ';';
251		ProcTerm = '^';
252
#	Line 257 | 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 270 | 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
289	–	Result := Result + '] ';
343		qryArray.Free;
344
345		end;
#	Line 310 | 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 326 | 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 346 | 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 375 | 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 400 | 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;
416	–	ColList := '';
482		IntChar := 0;
483		ValidRelation := false;
484
#	Line 423 | 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 471 | 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 543 | 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 575 | 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 661 | 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 695 | 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 740 | 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 787 | 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 796 | 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 833 | 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 846 | 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 869 | 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 878 | 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 905 | 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 923 | 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
932	–	{  First the dummy procedures
933	–	create the procedures with their parameters }
1276		if ProcedureName = '' then
1277		qryProcedures.SQL.Text := ProcedureSQL
1278		else
#	Line 938 | 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 946 | 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);
953	–	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
954	–	ProcName)]));
955	–	GetProcedureArgs(ProcName);
956	–	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, NEWLINE]));
957	–	qryProcedures.Next;
958	–	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	<
977	<	{ This query gets the procedure name and the source.  We then nest a query
978	<	to retrieve the parameters. Alter is used, because the procedures are
979	<	already there}
1341	>	qryProcedures.Close;
1342
1343		if not Header then
1344		begin
#	Line 1037 | 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 1064 | 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 1088 | 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 1105 | 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 1123 | 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 1220 | 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 1240 | 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 1257 | Line 1627 | var
1627		FileFlags, FileLength, FileSequence, FileStart : Integer;
1628
1629		function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
1260	–	var
1261	–	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
1262	–	length: Integer;
1263	–	_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 1283 | 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 1292 | 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 1308 | 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 1333 | 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 1342 | 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 1353 | 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 1394 | 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 1404 | 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 1419 | 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 1453 | 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 1557 | 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 1567 | 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 1894 | 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 1947 | 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 2074 | 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 2090 | 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 2106 | 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 2132 | 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 2212 | 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 2254 | 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 2298 | 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 2316 | 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 2348 | 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 2393 | 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 2425 | 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 2445 | 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 2454 | 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 2550 | 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
2592	<	PrevUser, PrevField,  WithOption,
2593	<	PrivString, ColString, UserString,
2594	<	FieldName, User : String;
2595	<	c : Char;
2596	<	PrevOption, PrivFlags, GrantOption : Integer;
2597	<	First, PrevFieldNull : Boolean;
2598	<	qryOwnerPriv : TIBSQL;
2599	<
2600	<	{  Given a bit-vector of privileges, turn it into a
2601	<	string list. }
2602	<	function MakePrivString(cflags : Integer) : String;
2603	<	var
2604	<	i : Integer;
2605	<	begin
2606	<	for i := Low(PrivTypes) to High(PrivTypes) do
2607	<	begin
2608	<	if (cflags and PrivTypes[i].PrivFlag) <> 0 then
2609	<	begin
2610	<	if Result <> '' then
2611	<	Result := Result + ', ';
2612	<	Result := Result + PrivTypes[i].PrivString;
2613	<	end; //end_if
2614	<	end; //end_for
2615	<	end; //end_fcn MakePrivDtring
3085	>	var qryOwnerPriv : TIBSQL;
3086
3087		begin
3088		if MetaObject = '' then
3089		exit;
3090
2621	–	First := true;
2622	–	PrevOption := -1;
2623	–	PrevUser := '';
2624	–	PrivString := '';
2625	–	ColString := '';
2626	–	WithOption := '';
2627	–	PrivFlags := 0;
2628	–	PrevFieldNull := false;
2629	–	PrevField := '';
2630	–
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	<
2649	<	User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2650	<	{ Print a new grant statement for each new user or change of option }
2651	<
2652	<	if ((PrevUser <> '') and (PrevUser <> User)) or
2653	<	((Not First) and
2654	<	(PrevFieldNull <> qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull)) or
2655	<	((not PrevFieldNull) and (PrevField <> FieldName)) or
2656	<	((PrevOption <> -1) and (PrevOption <> GrantOption)) then
2657	<	begin
2658	<	PrivString := MakePrivString(PrivFlags);
2659	<
2660	<	First := false;
2661	<	FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2662	<	ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2663	<	UserString, WithOption, Terminator]));
2664	<	{ re-initialize strings }
2665	<
2666	<	PrivString := '';
2667	<	WithOption := '';
2668	<	ColString := '';
2669	<	PrivFlags := 0;
2670	<	end; //end_if
2671	<
2672	<	PrevUser := User;
2673	<	PrevOption := GrantOption;
2674	<	PrevFieldNull := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull;
2675	<	PrevField := FieldName;
2676	<
2677	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2678	<	obj_relation,
2679	<	obj_view,
2680	<	obj_trigger,
2681	<	obj_procedure,
2682	<	obj_sql_role:
2683	<	UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2684	<	else
2685	<	UserString := User;
2686	<	end; //end_case
2687	<
2688	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2689	<	obj_view :
2690	<	UserString := 'VIEW ' + UserString;
2691	<	obj_trigger :
2692	<	UserString := 'TRIGGER '+ UserString;
2693	<	obj_procedure :
2694	<	UserString := 'PROCEDURE ' + UserString;
2695	<	end; //end_case
2696	<
2697	<	c := qryOwnerPriv.FieldByName('RDB$PRIVILEGE').AsString[1];
2698	<
2699	<	case c of
2700	<	'S' : PrivFlags := PrivFlags or priv_SELECT;
2701	<	'I' : PrivFlags := PrivFlags or priv_INSERT;
2702	<	'U' : PrivFlags := PrivFlags or priv_UPDATE;
2703	<	'D' : PrivFlags := PrivFlags or priv_DELETE;
2704	<	'R' : PrivFlags := PrivFlags or priv_REFERENCES;
2705	<	'X' : ;
2706	<	{ Execute should not be here -- special handling below }
2707	<	else
2708	<	PrivFlags := PrivFlags or priv_UNKNOWN;
2709	<	end; //end_switch
2710	<
2711	<	{ Column level privileges for update only }
2712	<
2713	<	if FieldName = '' then
2714	<	ColString := ''
2715	<	else
2716	<	ColString := Format(' (%s)', [QuoteIdentifier(FDatabase.SQLDialect, FieldName)]);
2717	<
2718	<	if GrantOption <> 0 then
2719	<	WithOption := ' WITH GRANT OPTION';
2720	<
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;
2723	–	{ Print last case if there was anything to print }
2724	–	if PrevOption <> -1 then
2725	–	begin
2726	–	PrivString := MakePrivString(PrivFlags);
2727	–	First := false;
2728	–	FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2729	–	ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2730	–	UserString, WithOption, Terminator]));
2731	–	{ re-initialize strings }
2732	–	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
2766	<	WithOption := ' WITH GRANT OPTION'
2767	<	else
2768	<	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 := '';
2789	<
2790	<	FMetaData.Add(Format('GRANT %s TO %s%s%s',
2791	<	[QuoteIdentifier(FDatabase.SQLDialect, qryOwnerPriv.FieldByName('RDB$RELATION_NAME').AsString),
2792	<	qryOwnerPriv.FieldByName('RDB$USER_NAME').AsString,
2793	<	WithOption, terminator]));
2794	<
2795	<	qryOwnerPriv.Next;
2796	<	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 2838 | 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 2918 | 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 2981 | 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 3016 | 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
3034	<	if (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3035	<	(qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3036	<	begin
3037	<	Line := Line + QuoteIdentifier(FDatabase.SQLDialect, qrySelect.Fields[i].Name);
3038	<	if i <> (qrySelect.Current.Count - 1) then
3039	<	Line := Line + ', ';
3040	<	end;
3041	<	Line := Line + ') VALUES (';
3042	<	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
3046	<	(qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3047	<	begin
3048	<	Line := Line + 'NULL';
3049	<	if i <> (qrySelect.Current.Count - 1) then
3050	<	Line := Line + ', ';
3051	<	end
3052	<	else
3053	<	case qrySelect.Fields[i].SQLType of
3054	<	SQL_TEXT, SQL_VARYING, SQL_TYPE_DATE,
3055	<	SQL_TYPE_TIME, SQL_TIMESTAMP :
3056	<	begin
3057	<	Line := Line + QuotedStr(qrySelect.Fields[i].AsString);
3058	<	if i <> (qrySelect.Current.Count - 1) then
3059	<	Line := Line + ', ';
3060	<	end;
3061	<	SQL_SHORT, SQL_LONG, SQL_INT64,
3062	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN:
3063	<	begin
3064	<	Line := Line + qrySelect.Fields[i].AsString;
3065	<	if i <> (qrySelect.Current.Count - 1) then
3066	<	Line := Line + ', ';
3067	<	end;
3068	<	SQL_ARRAY, SQL_BLOB : ;
3069	<	else
3070	<	IBError(ibxeInvalidDataConversion, [nil]);
3071	<	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;
3077	–	finally
3078	–	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 3126 | 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