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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 108 by tony, Thu Jan 18 14:37:46 2018 UTC

#	Line 23 | Line 23
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	+	}
35	+
36		unit IBExtract;
37
38		{$Mode Delphi}
39	+	{$codepage UTF8}
40
41		interface
42
#	Line 36 | Line 47 | uses
47		unix,
48		{$ENDIF}
49		SysUtils, Classes, IBDatabase, IBDatabaseInfo,
50	<	IBSQL, IBUtils, IBHeader, IB, IBIntf;
50	>	IBSQL, IBUtils, IBHeader, IB;
51
52		type
53		TExtractObjectTypes =
#	Line 50 | Line 61 | type
61
62		TExtractTypes = Set of TExtractType;
63
64	+	TProcDDLType = (pdCreateProc,pdCreateStub,pdAlterProc);
65	+
66	+	{ TIBExtract }
67	+
68		TIBExtract = class(TComponent)
69		private
70		FDatabase : TIBDatabase;
#	Line 58 | Line 73 | type
73		FDatabaseInfo: TIBDatabaseInfo;
74		FShowSystem: Boolean;
75		{ Private declarations }
76	+	procedure Add2MetaData(const Msg: string; IsError: boolean=true);
77		function GetDatabase: TIBDatabase;
78		function GetIndexSegments ( indexname : String) : String;
79		function GetTransaction: TIBTransaction;
80	+	function GetTriggerType(TypeID: integer): string;
81		procedure SetDatabase(const Value: TIBDatabase);
82		procedure SetTransaction(const Value: TIBTransaction);
83		function PrintValidation(ToValidate : String;       flag : Boolean) : String;
84		procedure ShowGrants(MetaObject: String; Terminator : String);
85	+	procedure ShowGrantsTo(MetaObject: String; ObjectType: integer;
86	+	Terminator: String);
87		procedure ShowGrantRoles(Terminator : String);
88		procedure GetProcedureArgs(Proc : String);
89		protected
90	<	function ExtractDDL(Flag : Boolean; TableName : String) : Boolean;
91	<	function ExtractListTable(RelationName, NewName : String; DomainFlag : Boolean) : Boolean;
90	>	function ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean =
91	>	false): Boolean;
92	>	function ExtractListTable(RelationName, NewName: String; DomainFlag: Boolean): Boolean;
93		procedure ExtractListView (ViewName : String);
94		procedure ListData(ObjectName : String);
95		procedure ListRoles(ObjectName : String = '');
96		procedure ListGrants;
97	<	procedure ListProcs(ProcedureName : String = '');
97	>	procedure ListProcs(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
98	>	IncludeGrants:boolean=false);
99		procedure ListAllTables(flag : Boolean);
100	<	procedure ListTriggers(ObjectName : String = ''; ExtractType : TExtractType = etTrigger);
100	>	procedure ListTriggers(ObjectName: String=''; ExtractTypes: TExtractTypes = [etTrigger]);
101		procedure ListCheck(ObjectName : String = ''; ExtractType : TExtractType = etCheck);
102		function PrintSet(var Used : Boolean) : String;
103		procedure ListCreateDb(TargetDb : String = '');
#	Line 85 | Line 106 | type
106		procedure ListFilters(FilterName : String = '');
107		procedure ListForeign(ObjectName : String = ''; ExtractType : TExtractType = etForeign);
108		procedure ListFunctions(FunctionName : String = '');
109	<	procedure ListGenerators(GeneratorName : String = '');
109	>	procedure ListGenerators(GeneratorName : String = ''; ExtractTypes: TExtractTypes=[]);
110		procedure ListIndex(ObjectName : String = ''; ExtractType : TExtractType = etIndex);
111		procedure ListViews(ViewName : String = '');
112	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
113
114		{ Protected declarations }
115		public
#	Line 98 | Line 120 | type
120		function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
121		FieldPrec, FieldLen : Integer) : String;
122		function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
101	–	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
123		procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
124		ExtractTypes : TExtractTypes = []);
125		property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
#	Line 121 | Line 142 | type
142		PrivString : String;
143		end;
144
145	<	TSQLTypes = Array[0..13] of TSQLType;
145	>	TSQLTypes = Array[0..14] of TSQLType;
146
147		const
148
#	Line 132 | Line 153 | const
153		priv_DELETE = 16;
154		priv_EXECUTE = 32;
155		priv_REFERENCES = 64;
156	+	priv_USAGE = 128;
157
158	<	PrivTypes : Array[0..5] of TPrivTypes = (
158	>	PrivTypes : Array[0..6] of TPrivTypes = (
159		(PrivFlag : priv_DELETE; PrivString : 'DELETE' ),
160		(PrivFlag : priv_EXECUTE; PrivString : 'EXECUTE' ),
161		(PrivFlag : priv_INSERT; PrivString : 'INSERT' ),
162		(PrivFlag : priv_SELECT; PrivString : 'SELECT' ),
163		(PrivFlag : priv_UPDATE; PrivString : 'UPDATE' ),
164	<	(PrivFlag : priv_REFERENCES; PrivString : 'REFERENCES'));
164	>	(PrivFlag : priv_REFERENCES; PrivString : 'REFERENCES'),
165	>	(PrivFlag : priv_USAGE; PrivString : 'USAGE' ));
166
167		ColumnTypes : TSQLTypes = (
168		(SqlType : blr_short; TypeName :    'SMALLINT'),            { NTX: keyword }
#	Line 155 | Line 178 | const
178		(SqlType : blr_sql_time; TypeName : 'TIME'),                { NTX: keyword }
179		(SqlType : blr_sql_date; TypeName : 'DATE'),                { NTX: keyword }
180		(SqlType : blr_timestamp; TypeName : 'TIMESTAMP'),          { NTX: keyword }
181	<	(SqlType : blr_int64; TypeName : 'INT64'));
181	>	(SqlType : blr_int64; TypeName : 'INT64'),
182	>	(SqlType : blr_bool; TypeName : 'BOOLEAN'));
183
184		SubTypes : Array[0..8] of String = (
185		'UNKNOWN',                  { NTX: keyword }
#	Line 168 | Line 192 | const
192		'TRANSACTION_DESCRIPTION',  { NTX: keyword }
193		'EXTERNAL_FILE_DESCRIPTION');       { NTX: keyword }
194
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	–
195		IntegralSubtypes : Array[0..2] of String = (
196		'UNKNOWN',                  { Defined type, NTX: keyword }
197		'NUMERIC',                  { NUMERIC, NTX: keyword }
#	Line 189 | Line 204 | const
204		ODS_VERSION10 = 10; { V6.0 features. SQL delimited idetifier,
205		SQLDATE, and 64-bit exact numeric
206		type }
207	+	ODS_VERSION12 = 12; {Firebird 3}
208
209		{ flags for RDB$FILE_FLAGS }
210		FILE_shadow = 1;
#	Line 227 | Line 243 | const
243
244		implementation
245
246	+	uses FBMessages, IBDataOutput;
247	+
248		const
231	–	NEWLINE = #13#10;
249		TERM = ';';
250		ProcTerm = '^';
251
#	Line 270 | Line 287 | var
287		qryArray : TIBSQL;
288		begin
289		qryArray := TIBSQL.Create(FDatabase);
290	<	Result := '[';
290	>	Result := '';
291		qryArray.SQL.Add(ArraySQL);
292		qryArray.Params.ByName('FieldName').AsString := FieldName;
293		qryArray.ExecQuery;
294
295		{  Format is [lower:upper, lower:upper,..]  }
296
297	<	while not qryArray.Eof do
297	>	if not qryArray.Eof then
298		begin
299	<	if (qryArray.FieldByName('RDB$DIMENSION').AsInteger > 0) then
300	<	Result := Result + ', ';
301	<	Result := Result + qryArray.FieldByName('RDB$LOWER_BOUND').AsString + ':' +
302	<	qryArray.FieldByName('RDB$UPPER_BOUND').AsString;
303	<	qryArray.Next;
299	>	Result := '[';
300	>	while not qryArray.Eof do
301	>	begin
302	>	if (qryArray.FieldByName('RDB$DIMENSION').AsInteger > 0) then
303	>	Result := Result + ', ';
304	>	Result := Result + qryArray.FieldByName('RDB$LOWER_BOUND').AsString + ':' +
305	>	qryArray.FieldByName('RDB$UPPER_BOUND').AsString;
306	>	qryArray.Next;
307	>	end;
308	>	Result := Result + '] ';
309		end;
310
289	–	Result := Result + '] ';
311		qryArray.Free;
312
313		end;
#	Line 310 | Line 331 | begin
331		inherited;
332		end;
333
334	<	function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String) : Boolean;
334	>	function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean = false) : Boolean;
335		var
336		DidConnect : Boolean;
337		DidStart : Boolean;
#	Line 326 | Line 347 | begin
347		end;
348
349		FMetaData.Add(Format('SET SQL DIALECT %d;', [FDatabase.SQLDialect]));
350	+	FMetaData.Add('SET AUTODDL ON;');
351		FMetaData.Add('');
352
353		if not FTransaction.Active then
#	Line 346 | Line 368 | begin
368		ListFunctions;
369		ListDomains;
370		ListAllTables(flag);
371	+	if IncludeData then
372	+	ListData('');
373		ListIndex;
374		ListForeign;
375	<	ListGenerators;
375	>	if IncludeData then
376	>	ListGenerators('',[etData])
377	>	else
378	>	ListGenerators;
379		ListViews;
380		ListCheck;
381		ListException;
382	<	ListProcs;
382	>	ListProcs(pdCreateStub);
383		ListTriggers;
384	+	ListProcs(pdAlterProc);
385		ListGrants;
386		end;
387
#	Line 375 | Line 403 | end;
403		domain_flag -- extract needed domains before the table }
404
405		function TIBExtract.ExtractListTable(RelationName, NewName: String;
406	<	DomainFlag: Boolean) : Boolean;
406	>	DomainFlag: Boolean): Boolean;
407		const
408		TableListSQL =
409		'SELECT * FROM RDB$RELATIONS REL JOIN RDB$RELATION_FIELDS RFR ON ' + {Do Not Localize}
#	Line 400 | Line 428 | const
428		'  (RELC.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR ' +
429		'  RELC.RDB$CONSTRAINT_TYPE = ''UNIQUE'') AND ' +
430		'  RELC.RDB$RELATION_NAME = :RELATIONNAME ' +
431	<	'ORDER BY RELC.RDB$CONSTRAINT_NAME';
431	>	'ORDER BY RELC.RDB$CONSTRAINT_TYPE desc, RELC.RDB$CONSTRAINT_NAME';
432	>
433	>	GetGeneratorSQL =
434	>	'SELECT * FROM RDB$GENERATORS WHERE RDB$GENERATOR_NAME = :GENERATOR';
435
436		var
437		Collation, CharSetId : integer;
#	Line 408 | Line 439 | var
439		ColList, Column, Constraint : String;
440		SubType : integer;
441		IntChar : integer;
442	<	qryTables, qryPrecision, qryConstraints, qryRelConstraints : TIBSQL;
442	>	qryTables, qryPrecision, qryConstraints, qryRelConstraints, qryGenerators : TIBSQL;
443		PrecisionKnown, ValidRelation : Boolean;
444		FieldScale, FieldType : Integer;
445	+	CreateTable: string;
446	+	TableType: integer;
447		begin
448		Result := true;
449		ColList := '';
#	Line 423 | Line 456 | begin
456		qryPrecision := TIBSQL.Create(FDatabase);
457		qryConstraints := TIBSQL.Create(FDatabase);
458		qryRelConstraints := TIBSQL.Create(FDatabase);
459	+	qryGenerators := TIBSQL.Create(FDatabase);
460		try
461		qryTables.SQL.Add(TableListSQL);
462	+	RelationName := trim(RelationName);
463		qryTables.Params.ByName('RelationName').AsString := RelationName;
464		qryTables.ExecQuery;
465		qryPrecision.SQL.Add(PrecisionSQL);
466		qryConstraints.SQL.Add(ConstraintSQL);
467		qryRelConstraints.SQL.Add(RelConstraintsSQL);
468	+	qryGenerators.SQL.Add(GetGeneratorSQL);
469		if not qryTables.Eof then
470		begin
471		ValidRelation := true;
472	+	TableType := qryTables.FieldByName('RDB$RELATION_TYPE').AsInteger;
473		if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and
474		(Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsString) <> '') then
475		FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',
476	<	[NEWLINE, RelationName,
477	<	qryTables.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
476	>	[LineEnding, RelationName,
477	>	qryTables.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
478	>	if TableType > 3 then
479	>	CreateTable := 'CREATE GLOBAL TEMPORARY TABLE'
480	>	else
481	>	CreateTable := 'CREATE TABLE';
482		if NewName <> '' then
483	<	FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
483	>	FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
484		else
485	<	FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
485	>	FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
486		if not qryTables.FieldByName('RDB$EXTERNAL_FILE').IsNull then
487		FMetaData.Add(Format('EXTERNAL FILE %s ',
488		[QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsString)]));
#	Line 471 | Line 512 | begin
512		(qryTables.FieldByName('RDB$FIELD_NAME1').AsString[5] in ['0'..'9'])) and
513		(qryTables.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
514		begin
515	<	Column := Column + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME1').AsString);
515	>	Column := Column + QuoteIdentifier(FDatabase.SQLDialect, trim(qryTables.FieldByName('RDB$FIELD_NAME1').AsString));
516		{ International character sets }
517		if (qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying])
518		and (not qryTables.FieldByName('RDB$COLLATION_ID').IsNull)
#	Line 543 | Line 584 | begin
584
585		{ Catch arrays after printing the type  }
586
587	<	if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull then
588	<	Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_NAME').AsString);
587	>	if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull and (qryTables.FieldByName('RDB$DIMENSIONS').AsInteger > 0) then
588	>	Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_SOURCE').AsString);
589
590		if FieldType = blr_blob then
591		begin
#	Line 575 | Line 616 | begin
616		end;
617		end;
618
619	+	{Firebird 3 introduces IDENTITY columns. We need to check for them here}
620	+	if qryTables.HasField('RDB$GENERATOR_NAME') and not qryTables.FieldByName('RDB$GENERATOR_NAME').IsNull then
621	+	begin
622	+	qryGenerators.ParamByName('GENERATOR').AsString :=  qryTables.FieldByName('RDB$GENERATOR_NAME').AsString;
623	+	qryGenerators.ExecQuery;
624	+	if not qryGenerators.Eof then
625	+	begin
626	+	Column := Column + Format(' GENERATED BY DEFAULT AS IDENTITY START WITH %d',
627	+	[qryGenerators.FieldByName('RDB$INITIAL_VALUE').AsInteger]);
628	+	end;
629	+	qryGenerators.Close;
630	+	end;
631	+
632		{ Handle defaults for columns }
633		{ Originally This called PrintMetadataTextBlob,
634		should no longer need }
#	Line 661 | Line 715 | begin
715		qryRelConstraints.Next;
716		end;
717		if ValidRelation then
718	<	FMetaData.Add(')' + Term);
718	>	begin
719	>	if TableType = 4 then
720	>	FMetaData.Add(' ) ON COMMIT PRESERVE ROWS ' + TERM)
721	>	else
722	>	FMetaData.Add(')' + TERM);
723	>	end;
724		finally
725		qryTables.Free;
726		qryPrecision.Free;
727		qryConstraints.Free;
728		qryRelConstraints.Free;
729	+	qryGenerators.Free;
730		end;
731		end;
732
#	Line 740 | Line 800 | var
800		CharSetSQL : TIBSQL;
801		DidActivate : Boolean;
802		begin
803	+	Result := '';
804		if not FTransaction.Active then
805		begin
806		FTransaction.StartTransaction;
#	Line 787 | Line 848 | begin
848		FTransaction.Commit;
849		end;
850
851	+	procedure TIBExtract.Add2MetaData(const Msg: string; IsError: boolean);
852	+	begin
853	+	FMetaData.Add(Msg);
854	+	end;
855	+
856		function TIBExtract.GetDatabase: TIBDatabase;
857		begin
858		result := FDatabase;
#	Line 796 | Line 862 | end;
862		Functional description
863		returns the list of columns in an index. }
864
865	<	function TIBExtract.GetIndexSegments(IndexName: String): String;
865	>	function TIBExtract.GetIndexSegments(indexname: String): String;
866		const
867		IndexNamesSQL =
868		'SELECT * FROM RDB$INDEX_SEGMENTS SEG ' +
#	Line 833 | Line 899 | begin
899		Result := FTransaction;
900		end;
901
902	+	function TIBExtract.GetTriggerType(TypeID: integer): string;
903	+	var separator: string;
904	+	begin
905	+	if TypeID and $2000 <> 0 then
906	+	{database trigger}
907	+	begin
908	+	Result := 'ON ';
909	+	case TypeID of
910	+	$2000:
911	+	Result += 'CONNECT';
912	+	$2001:
913	+	Result += 'DISCONNECT';
914	+	$2002:
915	+	Result +='TRANSACTION START';
916	+	$2003:
917	+	Result += 'TRANSACTION COMMIT';
918	+	$2004:
919	+	Result += 'TRANSACTION ROLLBACK';
920	+	end;
921	+	end
922	+	else
923	+	begin
924	+	Inc(TypeID);
925	+	if TypeID and $01 <> 0 then
926	+	Result := 'AFTER '
927	+	else
928	+	Result := 'BEFORE ';
929	+	TypeID := TypeID shr 1;
930	+	separator := '';
931	+	repeat
932	+	Result += separator;
933	+	separator := ' or ';
934	+	case TypeID and $03 of
935	+	1:
936	+	Result += 'INSERT';
937	+	2:
938	+	Result += 'UPDATE';
939	+	3:
940	+	Result += 'DELETE';
941	+	end;
942	+	TypeID := TypeID shr 2;
943	+	until TypeID = 0;
944	+	end;
945	+	end;
946	+
947		{          ListAllGrants
948		Functional description
949		Print the permissions on all user tables.
#	Line 846 | Line 957 | const
957		'  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
958		'ORDER BY RDB$RELATION_NAME';
959
960	<	ProcedureSQL = 'select * from RDB$PROCEDURES ' +
960	>	ProcedureSQL = 'select * from RDB$PROCEDURES '+
961	>	'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
962		'Order BY RDB$PROCEDURE_NAME';
963
964	+	ExceptionSQL = 'select * from RDB$EXCEPTIONS '+
965	+	'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
966	+	'Order BY RDB$EXCEPTION_NAME';
967	+
968	+	GeneratorSQL = 'select * from RDB$GENERATORS '+
969	+	'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
970	+	'Order BY RDB$GENERATOR_NAME';
971	+
972		var
973		qryRoles : TIBSQL;
974		RelationName : String;
#	Line 878 | Line 998 | begin
998
999		ShowGrantRoles(Term);
1000
1001	+	qryRoles.SQL.Text := ExceptionSQL;
1002	+	qryRoles.ExecQuery;
1003	+	try
1004	+	while not qryRoles.Eof do
1005	+	begin
1006	+	ShowGrants(Trim(qryRoles.FieldByName('RDB$EXCEPTION_NAME').AsString), Term);
1007	+	qryRoles.Next;
1008	+	end;
1009	+	finally
1010	+	qryRoles.Close;
1011	+	end;
1012	+
1013	+	qryRoles.SQL.Text := GeneratorSQL;
1014	+	qryRoles.ExecQuery;
1015	+	try
1016	+	while not qryRoles.Eof do
1017	+	begin
1018	+	ShowGrants(Trim(qryRoles.FieldByName('RDB$GENERATOR_NAME').AsString), Term);
1019	+	qryRoles.Next;
1020	+	end;
1021	+	finally
1022	+	qryRoles.Close;
1023	+	end;
1024	+
1025		qryRoles.SQL.Text := ProcedureSQL;
1026		qryRoles.ExecQuery;
1027		try
#	Line 905 | Line 1049 | end;
1049
1050		procname -- Name of procedure to investigate }
1051
1052	<	procedure TIBExtract.ListProcs(ProcedureName : String);
1052	>	procedure TIBExtract.ListProcs(ProcDDLType: TProcDDLType;
1053	>	ProcedureName: String; IncludeGrants: boolean);
1054		const
1055		CreateProcedureStr1 = 'CREATE PROCEDURE %s ';
1056		CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';
1057	<	ProcedureSQL =
1058	<	'SELECT * FROM RDB$PROCEDURES ' +
1059	<	'ORDER BY RDB$PROCEDURE_NAME';
1057	>	ProcedureSQL =  {Order procedures by dependency order and then procedure name}
1058	>	'with recursive Procs as ( ' +
1059	>	'Select RDB$PROCEDURE_NAME, 1 as ProcLevel from RDB$PROCEDURES ' +
1060	>	'UNION ALL ' +
1061	>	'Select D.RDB$DEPENDED_ON_NAME, ProcLevel + 1 From RDB$DEPENDENCIES D ' +
1062	>	'JOIN Procs on Procs.RDB$PROCEDURE_NAME = D.RDB$DEPENDENT_NAME ' +
1063	>	'  and Procs.RDB$PROCEDURE_NAME <> D.RDB$DEPENDED_ON_NAME ' +
1064	>	'JOIN RDB$PROCEDURES P On P.RDB$PROCEDURE_NAME = D.RDB$DEPENDED_ON_NAME ' +
1065	>	'  ) ' +
1066	>	'SELECT * FROM RDB$PROCEDURES P ' +
1067	>	'JOIN ( ' +
1068	>	'Select RDB$PROCEDURE_NAME, max(ProcLevel) as ProcLevel From Procs ' +
1069	>	'Group By RDB$PROCEDURE_NAME) A On A.RDB$PROCEDURE_NAME = P.RDB$PROCEDURE_NAME ' +
1070	>	'Order by A.ProcLevel desc, P.RDB$PROCEDURE_NAME asc';
1071
1072		ProcedureNameSQL =
1073		'SELECT * FROM RDB$PROCEDURES ' +
#	Line 923 | Line 1079 | var
1079		ProcName : String;
1080		SList : TStrings;
1081		Header : Boolean;
1082	+
1083		begin
1084
1085		Header := true;
1086		qryProcedures := TIBSQL.Create(FDatabase);
1087		SList := TStringList.Create;
1088		try
932	–	{  First the dummy procedures
933	–	create the procedures with their parameters }
1089		if ProcedureName = '' then
1090		qryProcedures.SQL.Text := ProcedureSQL
1091		else
#	Line 938 | Line 1093 | begin
1093		qryProcedures.SQL.Text := ProcedureNameSQL;
1094		qryProcedures.Params.ByName('ProcedureName').AsString := ProcedureName;
1095		end;
1096	+
1097		qryProcedures.ExecQuery;
1098		while not qryProcedures.Eof do
1099		begin
#	Line 946 | Line 1102 | begin
1102		FMetaData.Add('COMMIT WORK;');
1103		FMetaData.Add('SET AUTODDL OFF;');
1104		FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term]));
1105	<	FMetaData.Add(Format('%s/* Stored procedures */%s', [NEWLINE, NEWLINE]));
1105	>	FMetaData.Add(Format('%s/* Stored procedures */%s', [LineEnding, LineEnding]));
1106		Header := false;
1107		end;
1108		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;
1109
1110	<	qryProcedures.Close;
1111	<	qryProcedures.ExecQuery;
1112	<	while not qryProcedures.Eof do
1113	<	begin
1114	<	SList.Clear;
1115	<	ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
1116	<	FMetaData.Add(Format('%sALTER PROCEDURE %s ', [NEWLINE,
1117	<	QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1118	<	GetProcedureArgs(ProcName);
1119	<
1120	<	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1121	<	SList.Text := SList.Text + qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1122	<	SList.Add(Format(' %s%s', [ProcTerm, NEWLINE]));
1123	<	FMetaData.AddStrings(SList);
1110	>	case ProcDDLType of
1111	>	pdCreateStub:
1112	>	begin
1113	>	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1114	>	ProcName)]));
1115	>	GetProcedureArgs(ProcName);
1116	>	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1117	>	end;
1118	>
1119	>	pdCreateProc:
1120	>	begin
1121	>	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1122	>	ProcName)]));
1123	>	GetProcedureArgs(ProcName);
1124	>	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1125	>	begin
1126	>	SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1127	>	SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1128	>	FMetaData.AddStrings(SList);
1129	>	end
1130	>	else
1131	>	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1132	>	end;
1133	>
1134	>	pdAlterProc:
1135	>	begin
1136	>	FMetaData.Add(Format('%sALTER PROCEDURE %s ', [LineEnding,
1137	>	QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1138	>	GetProcedureArgs(ProcName);
1139	>
1140	>	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1141	>	begin
1142	>	SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1143	>	SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1144	>	FMetaData.AddStrings(SList);
1145	>	end
1146	>	else
1147	>	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1148	>	end;
1149	>	end;
1150	>	if IncludeGrants then
1151	>	ShowGrantsTo(ProcName,obj_procedure,ProcTerm);
1152		qryProcedures.Next;
1153		end;
1154	<
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}
1154	>	qryProcedures.Close;
1155
1156		if not Header then
1157		begin
#	Line 1037 | Line 1212 | end;
1212		Lists triggers in general on non-system
1213		tables with sql source only. }
1214
1215	<	procedure TIBExtract.ListTriggers(ObjectName : String; ExtractType : TExtractType);
1215	>	procedure TIBExtract.ListTriggers(ObjectName: String; ExtractTypes: TExtractTypes
1216	>	);
1217		const
1218		{ Query gets the trigger info for non-system triggers with
1219		source that are not part of an SQL constraint }
1220
1221		TriggerSQL =
1222	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1222	>	'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1223		'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1224		'WHERE ' +
1225		' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
#	Line 1064 | Line 1240 | const
1240		'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1241
1242		TriggerByNameSQL =
1243	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1243	>	'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1244		'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1245		'WHERE ' +
1246		' TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
#	Line 1088 | Line 1264 | begin
1264		qryTriggers.SQL.Text := TriggerSQL
1265		else
1266		begin
1267	<	if ExtractType = etTable then
1267	>	if etTable in ExtractTypes  then
1268		begin
1269		qryTriggers.SQL.Text := TriggerNameSQL;
1270		qryTriggers.Params.ByName('TableName').AsString := ObjectName;
#	Line 1105 | Line 1281 | begin
1281		SList.Clear;
1282		if Header then
1283		begin
1284	<	FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, NEWLINE]));
1284	>	FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, LineEnding]));
1285		FMetaData.Add(Format('%s/* Triggers only will work for SQL triggers */%s',
1286	<	[NEWLINE, NEWLINE]));
1286	>	[LineEnding, LineEnding]));
1287		Header := false;
1288		end;
1289		TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsString;
#	Line 1123 | Line 1299 | begin
1299		if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1300		SList.Add('/* ');
1301
1302	<	SList.Add(Format('CREATE TRIGGER %s FOR %s %s%s %s POSITION %d',
1303	<	[QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1304	<	QuoteIdentifier(FDatabase.SQLDialect, RelationName),
1305	<	NEWLINE, InActive,
1306	<	TriggerTypes[qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger],
1307	<	qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1302	>	{Database or Transaction trigger}
1303	>	SList.Add(Format('CREATE TRIGGER %s%s%s %s POSITION %d',
1304	>	[QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1305	>	LineEnding, InActive,
1306	>	GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger),
1307	>	qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1308	>
1309	>	if RelationName <> '' then
1310	>	SList.Add('ON ' + QuoteIdentifier(FDatabase.SQLDialect, RelationName));
1311	>
1312		if not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1313	<	SList.Text := SList.Text +
1314	<	qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1315	<	SList.Add(' ' + ProcTerm + NEWLINE);
1313	>	SList.Add(qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString)
1314	>	else
1315	>	SList.Add('AS BEGIN EXIT; END');
1316	>	SList.Add(' ' + ProcTerm);
1317		if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1318		SList.Add(' */');
1319		FMetaData.AddStrings(SList);
1320	+	if etGrant in ExtractTypes then
1321	+	ShowGrantsTo(TriggerName,obj_trigger,ProcTerm);
1322		qryTriggers.Next;
1323		end;
1324		if not Header then
#	Line 1220 | Line 1403 | begin
1403		if not qryChecks.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1404		SList.Text := SList.Text + qryChecks.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1405
1406	<	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + NEWLINE;
1406	>	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + LineEnding;
1407		FMetaData.AddStrings(SList);
1408		qryChecks.Next;
1409		end;
#	Line 1240 | Line 1423 | const
1423		CharInfoSQL =
1424		'SELECT * FROM RDB$DATABASE DBP ' +
1425		'WHERE NOT DBP.RDB$CHARACTER_SET_NAME IS NULL ' +
1426	<	'  AND DBP.RDB$CHARACTER_SET_NAME != '' ''';
1426	>	'  AND DBP.RDB$CHARACTER_SET_NAME <> '' ''';
1427
1428		FilesSQL =
1429		'select * from RDB$FILES ' +
#	Line 1257 | Line 1440 | var
1440		FileFlags, FileLength, FileSequence, FileStart : Integer;
1441
1442		function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
1260	–	var
1261	–	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
1262	–	length: Integer;
1263	–	_DatabaseInfoCommand: Char;
1443		begin
1444	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
1445	<	FDatabaseInfo.Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
1446	<	IBLocalBufferLength, local_buffer), True);
1447	<	length := isc_vax_integer(@local_buffer[1], 2);
1448	<	result := isc_vax_integer(@local_buffer[3], length);
1444	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
1445	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
1446	>	Result := Items[0].AsInteger
1447	>	else
1448	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
1449		end;
1450
1451		begin
1452	<	NoDb := FALSE;
1452	>	NoDb := FALSE;
1453		First := TRUE;
1454		FirstFile := TRUE;
1455		HasWal := FALSE;
#	Line 1283 | Line 1462 | begin
1462		NoDb := true;
1463		end;
1464		Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +
1465	<	IntToStr(FDatabaseInfo.PageSize) + NEWLINE;
1465	>	IntToStr(FDatabaseInfo.PageSize) + LineEnding;
1466		FMetaData.Add(Buffer);
1467		Buffer := '';
1468
#	Line 1292 | Line 1471 | begin
1471		qryDB.SQL.Text := CharInfoSQL;
1472		qryDB.ExecQuery;
1473
1474	<	Buffer := Format(' DEFAULT CHARACTER SET %s',
1475	<	[qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
1474	>	if not qryDB.EOF then
1475	>	Buffer := Format(' DEFAULT CHARACTER SET %s',
1476	>	[trim(qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString)]);
1477		if NoDB then
1478	<	Buffer := Buffer + ' */'
1478	>	Buffer := Buffer + Term + ' */'
1479		else
1480		Buffer := Buffer + Term;
1481		FMetaData.Add(Buffer);
#	Line 1308 | Line 1488 | begin
1488		begin
1489		if First then
1490		begin
1491	<	FMetaData.Add(NEWLINE + '/* Add secondary files in comments ');
1491	>	FMetaData.Add(LineEnding + '/* Add secondary files in comments ');
1492		First := false;
1493		end; //end_if
1494
#	Line 1333 | Line 1513 | begin
1513		if FileFlags = 0 then
1514		begin
1515		Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',
1516	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1516	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1517		if FileStart <> 0 then
1518		Buffer := Buffer + Format(' STARTING %d', [FileStart]);
1519		if FileLength <> 0 then
#	Line 1342 | Line 1522 | begin
1522		end; //end_if
1523		if (FileFlags and FILE_cache) <> 0 then
1524		FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',
1525	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1525	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1526
1527		Buffer := '';
1528		if (FileFlags and FILE_shadow) <> 0 then
#	Line 1353 | Line 1533 | begin
1533		else
1534		begin
1535		Buffer := Format('%sCREATE SHADOW %d ''%s'' ',
1536	<	[NEWLINE, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1536	>	[LineEnding, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1537		qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1538		if (FileFlags and FILE_inactive) <> 0 then
1539		Buffer := Buffer + 'INACTIVE ';
#	Line 1394 | Line 1574 | begin
1574		begin
1575		if NoDB then
1576		Buffer := '/* ';
1577	<	Buffer := Buffer + NEWLINE + 'ALTER DATABASE ADD ';
1577	>	Buffer := Buffer + LineEnding + 'ALTER DATABASE ADD ';
1578		First := false;
1579		end; //end_if
1580		if FirstFile then
#	Line 1404 | Line 1584 | begin
1584		begin
1585		if (FileFlags and LOG_overflow) <> 0 then
1586		Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',
1587	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1587	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1588		else
1589		if (FileFlags and LOG_serial) <> 0 then
1590		Buffer := Buffer + Format('%s  BASE_NAME ''%s''',
1591	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1591	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1592		{ Since we are fetching order by FILE_FLAGS, the LOG_0verflow will
1593		be last.  It will only appear if there were named round robin,
1594		so we must close the parens first }
#	Line 1419 | Line 1599 | begin
1599		if FirstFile then
1600		Buffer := Buffer + '('
1601		else
1602	<	Buffer := Buffer + Format(',%s  ', [NEWLINE]);
1602	>	Buffer := Buffer + Format(',%s  ', [LineEnding]);
1603		FirstFile := false;
1604
1605		Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsString]);
#	Line 1453 | Line 1633 | begin
1633		if not First then
1634		begin
1635		if NoDB then
1636	<	FMetaData.Add(Format('%s */%s', [NEWLINE, NEWLINE]))
1636	>	FMetaData.Add(Format('%s */%s', [LineEnding, LineEnding]))
1637		else
1638	<	FMetaData.Add(Format('%s%s%s', [Term, NEWLINE, NEWLINE]));
1638	>	FMetaData.Add(Format('%s%s%s', [Term, LineEnding, LineEnding]));
1639		end;
1640		finally
1641		qryDB.Free;
#	Line 1557 | Line 1737 | var
1737		Result := Result + Format(' SEGMENT SIZE %d', [qryDomains.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
1738		end //end_if
1739		else
1740	<	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
1741	<	(not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
1742	<	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1740	>	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
1741	>	begin
1742	>	if not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
1743	>	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
1744	>	else
1745	>	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1746	>	end;
1747
1748		{ since the character set is part of the field type, display that
1749		information now. }
#	Line 1567 | Line 1751 | var
1751		Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1752		0, FALSE);
1753		if not qryDomains.FieldByName('RDB$DIMENSIONS').IsNull then
1754	<	Result := GetArrayField(FieldName);
1754	>	Result := GetArrayField(qryDomains.FieldByName('RDB$FIELD_SOURCE').AsString);
1755
1756		if not qryDomains.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
1757	<	Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1757	>	Result := Result + Format('%s%s %s', [LineEnding, TAB,
1758		qryDomains.FieldByName('RDB$DEFAULT_SOURCE').AsString]);
1759
1760		if not qryDomains.FieldByName('RDB$VALIDATION_SOURCE').IsNull then
1761		if Pos('CHECK', AnsiUpperCase(qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString)) = 1 then
1762	<	Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1762	>	Result := Result + Format('%s%s %s', [LineEnding, TAB,
1763		qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString])
1764		else
1765	<	Result := Result + Format('%s%s /* %s */', [NEWLINE, TAB,
1765	>	Result := Result + Format('%s%s /* %s */', [LineEnding, TAB,
1766		qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString]);
1767
1768		if qryDomains.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
#	Line 1894 | Line 2078 | end;
2078		procedure TIBExtract.ListFunctions(FunctionName : String = '');
2079		const
2080		FunctionSQL =
2081	<	'SELECT * FROM RDB$FUNCTIONS ' +
2081	>	'SELECT * FROM RDB$FUNCTIONS WHERE RDB$SYSTEM_FLAG = 0 ' +
2082		'ORDER BY RDB$FUNCTION_NAME';
2083
2084		FunctionNameSQL =
#	Line 1947 | Line 2131 | begin
2131		if First then
2132		begin
2133		FMEtaData.Add(Format('%s/*  External Function declarations */%s',
2134	<	[NEWLINE, NEWLINE]));
2134	>	[LineEnding, LineEnding]));
2135		First := false;
2136		end; //end_if
2137		{ Start new function declaration }
#	Line 2074 | Line 2258 | begin
2258		FMetaData.Add(Format('ENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%s%s',
2259		[qryFunctions.FieldByName('RDB$ENTRYPOINT').AsString,
2260		qryFunctions.FieldByName('RDB$MODULE_NAME').AsString,
2261	<	Term, NEWLINE, NEWLINE]));
2261	>	Term, LineEnding, LineEnding]));
2262
2263		qryFunctions.Next;
2264		end;
#	Line 2090 | Line 2274 | end;
2274		Functional description
2275		Re create all non-system generators }
2276
2277	<	procedure TIBExtract.ListGenerators(GeneratorName : String = '');
2277	>	procedure TIBExtract.ListGenerators(GeneratorName: String;
2278	>	ExtractTypes: TExtractTypes);
2279		const
2280		GeneratorSQL =
2281		'SELECT RDB$GENERATOR_NAME ' +
#	Line 2106 | Line 2291 | const
2291		'  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2292		'ORDER BY RDB$GENERATOR_NAME';
2293
2294	+	GeneratorValueSQL =
2295	+	'SELECT GEN_ID(%s,0) as GENERATORVALUE From RDB$Database';
2296	+
2297		var
2298		qryGenerator : TIBSQL;
2299	+	qryValue: TIBSQL;
2300		GenName : String;
2301		begin
2302		qryGenerator := TIBSQL.Create(FDatabase);
2303	+	qryValue := TIBSQL.Create(FDatabase);
2304		try
2305		if GeneratorName = '' then
2306		qryGenerator.SQL.Text := GeneratorSQL
#	Line 2132 | Line 2322 | begin
2322		qryGenerator.Next;
2323		continue;
2324		end;
2325	<	FMetaData.Add(Format('CREATE GENERATOR %s%s',
2325	>	FMetaData.Add(Format('CREATE SEQUENCE %s%s',
2326		[QuoteIdentifier(FDatabase.SQLDialect, GenName),
2327		Term]));
2328	+	if etData in ExtractTypes then
2329	+	begin
2330	+	qryValue.SQL.Text := Format(GeneratorValueSQL,[GenName]);
2331	+	qryValue.ExecQuery;
2332	+	try
2333	+	if not qryValue.EOF then
2334	+	FMetaData.Add(Format('ALTER SEQUENCE %s RESTART WITH %d;',
2335	+	[QuoteIdentifier(FDatabase.SQLDialect, GenName),
2336	+	qryValue.FieldByName('GENERATORVALUE').AsInteger]));
2337	+	finally
2338	+	qryValue.Close;
2339	+	end;
2340	+	end;
2341		qryGenerator.Next;
2342		end;
2343		finally
2344		qryGenerator.Free;
2345	+	qryValue.Free;
2346		end;
2347		end;
2348
#	Line 2212 | Line 2416 | begin
2416		if First then
2417		begin
2418		if ObjectName = '' then
2419	<	FMetaData.Add(NEWLINE + '/*  Index definitions for all user tables */' + NEWLINE)
2419	>	FMetaData.Add(LineEnding + '/*  Index definitions for all user tables */' + LineEnding)
2420		else
2421	<	FMetaData.Add(NEWLINE + '/*  Index definitions for ' + ObjectName + ' */' + NEWLINE);
2421	>	FMetaData.Add(LineEnding + '/*  Index definitions for ' + ObjectName + ' */' + LineEnding);
2422		First := false;
2423		end; //end_if
2424
#	Line 2254 | Line 2458 | end;
2458		procedure TIBExtract.ListViews(ViewName : String);
2459		const
2460		ViewSQL =
2461	+	'with recursive Views as ( ' +
2462	+	'  Select RDB$RELATION_NAME, 1 as ViewLevel from RDB$RELATIONS ' +
2463	+	'    Where RDB$RELATION_TYPE = 1 and RDB$SYSTEM_FLAG = 0 '+
2464	+	'  UNION ALL ' +
2465	+	'  Select D.RDB$DEPENDED_ON_NAME, ViewLevel + 1 From RDB$DEPENDENCIES D ' +
2466	+	'  JOIN Views on Views.RDB$RELATION_NAME = D.RDB$DEPENDENT_NAME ' +
2467	+	'     and Views.RDB$RELATION_NAME <> D.RDB$DEPENDED_ON_NAME ' +
2468	+	'  JOIN RDB$RELATIONS R On R.RDB$RELATION_NAME = D.RDB$DEPENDED_ON_NAME ' +
2469	+	')' +
2470	+	'SELECT R.RDB$RELATION_NAME, R.RDB$OWNER_NAME, R.RDB$VIEW_SOURCE FROM RDB$RELATIONS R ' +
2471	+	'JOIN ( ' +
2472	+	'Select RDB$RELATION_NAME, max(ViewLevel) as ViewLevel From Views ' +
2473	+	'Group By RDB$RELATION_NAME) A On A.RDB$RELATION_NAME = R.RDB$RELATION_NAME ' +
2474	+	'Where R.RDB$RELATION_TYPE = 1 and R.RDB$SYSTEM_FLAG = 0 '+
2475	+	'Order by A.ViewLevel desc, R.RDB$RELATION_NAME asc';
2476	+
2477	+	{
2478		'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2479		'FROM RDB$RELATIONS ' +
2480		'WHERE ' +
2481		'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2482		'  NOT RDB$VIEW_BLR IS NULL AND ' +
2483		'  RDB$FLAGS = 1 ' +
2484	<	'ORDER BY RDB$RELATION_ID';
2484	>	'ORDER BY RDB$RELATION_ID'; }
2485
2486		ViewNameSQL =
2487		'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
#	Line 2298 | Line 2519 | begin
2519		while not qryView.Eof do
2520		begin
2521		SList.Add(Format('%s/* View: %s, Owner: %s */%s',
2522	<	[NEWLINE, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2523	<	qryView.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
2522	>	[LineEnding, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2523	>	qryView.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
2524
2525		SList.Add(Format('CREATE VIEW %s (', [QuoteIdentifier(FDatabase.SQLDialect,
2526		qryView.FieldByName('RDB$RELATION_NAME').AsString)]));
#	Line 2316 | Line 2537 | begin
2537		SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + ', ';
2538		end;
2539		qryColumns.Close;
2540	<	SList.Text := SList.Text + Format(') AS%s', [NEWLINE]);
2540	>	SList.Text := SList.Text + Format(') AS%s', [LineEnding]);
2541		if not qryView.FieldByName('RDB$VIEW_SOURCE').IsNull then
2542		SList.Text := SList.Text + qryView.FieldByName('RDB$VIEW_SOURCE').AsString;
2543	<	SList.Text := SList.Text + Format('%s%s', [Term, NEWLINE]);
2543	>	SList.Text := SList.Text + Format('%s%s', [Term, LineEnding]);
2544		FMetaData.AddStrings(SList);
2545		SList.Clear;
2546		qryView.Next;
#	Line 2348 | Line 2569 | begin
2569		Used := true;
2570		end
2571		else
2572	<	Result := Format(', %s      ', [NEWLINE]);
2572	>	Result := Format(', %s      ', [LineEnding]);
2573		end;
2574
2575		{
#	Line 2393 | Line 2614 | end;
2614
2615		procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2616		begin
2617	<	if FDatabase <> Value then
2617	>	if (csLoading in ComponentState) or (FDatabase <> Value) then
2618		begin
2619		FDatabase := Value;
2620		if (not Assigned(FTransaction)) and (FDatabase <> nil) then
#	Line 2425 | Line 2646 | begin
2646		end;
2647		FMetaData.Clear;
2648		case ObjectType of
2649	<	eoDatabase : ExtractDDL(true, '');
2649	>	eoDatabase : ExtractDDL(true, '', etData in ExtractTypes);
2650		eoDomain :
2651		if etTable in ExtractTypes then
2652		ListDomains(ObjectName, etTable)
#	Line 2445 | Line 2666 | begin
2666		if etCheck in ExtractTypes then
2667		ListCheck(ObjectName, etTable);
2668		if etTrigger in ExtractTypes then
2669	<	ListTriggers(ObjectName, etTable);
2669	>	begin
2670	>	if etGrant in ExtractTypes then
2671	>	ListTriggers(ObjectName, [etTable,etGrant])
2672	>	else
2673	>	ListTriggers(ObjectName, [etTable]);
2674	>	end;
2675		if etGrant in ExtractTypes then
2676		ShowGrants(ObjectName, Term);
2677		if etData in ExtractTypes then
#	Line 2454 | Line 2680 | begin
2680		else
2681		ListAllTables(true);
2682		end;
2683	<	eoView : ListViews(ObjectName);
2684	<	eoProcedure : ListProcs(ObjectName);
2683	>	eoView :
2684	>	begin
2685	>	ListViews(ObjectName);
2686	>	if ObjectName <> '' then
2687	>	begin
2688	>	if etTrigger in ExtractTypes then
2689	>	begin
2690	>	if etGrant in ExtractTypes then
2691	>	ListTriggers(ObjectName, [etTable,etGrant])
2692	>	else
2693	>	ListTriggers(ObjectName, [etTable]);
2694	>	end;
2695	>	if etGrant in ExtractTypes then
2696	>	ShowGrants(ObjectName, Term);
2697	>	end;
2698	>	end;
2699	>	eoProcedure :
2700	>	begin
2701	>	ListProcs(pdCreateProc,ObjectName,etGrant in ExtractTypes);
2702	>	if (ObjectName <> '' ) and (etGrant in ExtractTypes) then
2703	>	ShowGrants(ObjectName, Term);
2704	>	end;
2705		eoFunction : ListFunctions(ObjectName);
2706	<	eoGenerator : ListGenerators(ObjectName);
2706	>	eoGenerator : ListGenerators(ObjectName,ExtractTypes);
2707		eoException : ListException(ObjectName);
2708		eoBLOBFilter : ListFilters(ObjectName);
2709		eoRole : ListRoles(ObjectName);
2710		eoTrigger :
2711		if etTable in ExtractTypes then
2712	<	ListTriggers(ObjectName, etTable)
2712	>	begin
2713	>	if etGrant in ExtractTypes then
2714	>	ListTriggers(ObjectName, [etTable,etGrant])
2715	>	else
2716	>	ListTriggers(ObjectName, [etTable])
2717	>	end
2718	>	else
2719	>	if etGrant in ExtractTypes then
2720	>	ListTriggers(ObjectName,[etTrigger,etGrant])
2721		else
2722		ListTriggers(ObjectName);
2723		eoForeign :
#	Line 2550 | Line 2804 | end;
2804		It must extract granted privileges on tables/views to users,
2805		- these may be compound, so put them on the same line.
2806		Grant execute privilege on procedures to users
2807	<	Grant various privilegs to procedures.
2807	>	Grant various privileges to procedures.
2808		All privileges may have the with_grant option set. }
2809
2810	<	procedure TIBExtract.ShowGrants(MetaObject, Terminator: String);
2810	>	procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String);
2811		const
2812	<	{ This query only finds tables, eliminating owner privileges }
2813	<	OwnerPrivSQL =
2814	<	'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2815	<	'       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE ' +
2816	<	'FROM RDB$USER_PRIVILEGES PRV, RDB$RELATIONS REL ' +
2817	<	'WHERE ' +
2818	<	'  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2819	<	'  REL.RDB$RELATION_NAME = :METAOBJECT AND ' +
2820	<	'  PRV.RDB$PRIVILEGE <> ''M'' AND ' +
2821	<	'  REL.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2822	<	'ORDER BY  PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2823	<
2824	<	ProcPrivSQL =
2825	<	'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2826	<	'       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE, PRV.RDB$RELATION_NAME ' +
2827	<	'FROM RDB$USER_PRIVILEGES PRV, RDB$PROCEDURES PRC ' +
2828	<	'where ' +
2829	<	'  PRV.RDB$OBJECT_TYPE = 5 AND ' +
2830	<	'  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2831	<	'  PRC.RDB$PROCEDURE_NAME = :METAOBJECT AND ' +
2832	<	'  PRV.RDB$PRIVILEGE = ''X'' AND ' +
2833	<	'  PRC.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2834	<	'ORDER BY PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2835	<
2836	<	RolePrivSQL =
2837	<	'SELECT * FROM RDB$USER_PRIVILEGES ' +
2838	<	'WHERE ' +
2839	<	'  RDB$OBJECT_TYPE = 13 AND ' +
2840	<	'  RDB$USER_TYPE = 8  AND ' +
2841	<	'  RDB$RELATION_NAME = :METAOBJECT AND ' +
2842	<	'  RDB$PRIVILEGE = ''M'' ' +
2843	<	'ORDER BY RDB$USER';
2812	>	GrantsBaseSelect =
2813	>	'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
2814	>	'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
2815	>	'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
2816	>	'case  RDB$OBJECT_TYPE '+
2817	>	'When 0 then ''TABLE'' '+
2818	>	'When 5 then ''PROCEDURE'' '+
2819	>	'When 7 then ''EXCEPTION'' '+
2820	>	'When 11 then ''CHARACTER SET'' '+
2821	>	'When 14 then ''GENERATOR'' '+
2822	>	'ELSE NULL END as OBJECT_TYPE_NAME, '+
2823	>	'case RDB$USER_TYPE '+
2824	>	'When 5 then ''PROCEDURE'' '+
2825	>	'When 2 then ''TRIGGER'' '+
2826	>	'When 8 then ''USER'' '+
2827	>	'When 13 then ''ROLE'' '+
2828	>	'ELSE NULL END as USER_TYPE_NAME, '+
2829	>	'case '+
2830	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
2831	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
2832	>	'ELSE '''' End as GRANTOPTION '+
2833	>	'From (  '+
2834	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
2835	>	'When ''X'' then ''EXECUTE''  '+
2836	>	'When ''S'' then ''SELECT''  '+
2837	>	'When ''U'' then ''UPDATE''   '+
2838	>	'When ''D'' then ''DELETE''  '+
2839	>	'When ''R'' then ''REFERENCES''  '+
2840	>	'When ''G'' then ''USAGE''  '+
2841	>	'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
2842	>	'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME  '+
2843	>	'FROM RDB$USER_PRIVILEGES PR  '+
2844	>	'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
2845	>	'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
2846	>	'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  '+
2847	>	'UNION  '+
2848	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
2849	>	'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME   '+
2850	>	'FROM RDB$USER_PRIVILEGES PR  '+
2851	>	'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
2852	>	'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
2853	>	'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)  '+
2854	>	'Where METAOBJECTNAME = :METAOBJECTNAME and RDB$USER <> RDB$OWNER_NAME  '+
2855	>	'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE,METAOBJECTNAME '+
2856	>	'ORDER BY RDB$USER, RDB$OBJECT_TYPE';
2857	>
2858	>	GrantsSQL12 =
2859	>	'with ObjectOwners As ( '+
2860	>	'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
2861	>	'From RDB$RELATIONS '+
2862	>	'UNION '+
2863	>	'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
2864	>	'From RDB$PROCEDURES '+
2865	>	'UNION '+
2866	>	'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 7 as ObjectType '+
2867	>	'From RDB$EXCEPTIONS '+
2868	>	'UNION '+
2869	>	'Select RDB$GENERATOR_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 14 as ObjectType '+
2870	>	'From RDB$GENERATORS '+
2871	>	'UNION '+
2872	>	'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 11 as ObjectType '+
2873	>	'From RDB$CHARACTER_SETS '+
2874	>	') '+ GrantsBaseSelect;
2875	>
2876	>	GrantsSQL =
2877	>	'with ObjectOwners As ( '+
2878	>	'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
2879	>	'From RDB$RELATIONS '+
2880	>	'UNION '+
2881	>	'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
2882	>	'From RDB$PROCEDURES '+
2883	>	'UNION '+
2884	>	'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, ''SYSDBA'', 7 as ObjectType '+
2885	>	'From RDB$EXCEPTIONS '+
2886	>	'UNION '+
2887	>	'Select RDB$GENERATOR_NAME as METAOBJECTNAME, ''SYSDBA'', 14 as ObjectType '+
2888	>	'From RDB$GENERATORS '+
2889	>	'UNION '+
2890	>	'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, ''SYSDBA'', 11 as ObjectType '+
2891	>	'From RDB$CHARACTER_SETS '+
2892	>	') '+ GrantsBaseSelect;
2893
2894	<	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
2894	>	var qryOwnerPriv : TIBSQL;
2895
2896		begin
2897		if MetaObject = '' then
2898		exit;
2899
2621	–	First := true;
2622	–	PrevOption := -1;
2623	–	PrevUser := '';
2624	–	PrivString := '';
2625	–	ColString := '';
2626	–	WithOption := '';
2627	–	PrivFlags := 0;
2628	–	PrevFieldNull := false;
2629	–	PrevField := '';
2630	–
2900		qryOwnerPriv := TIBSQL.Create(FDatabase);
2901		try
2902	<	qryOwnerPriv.SQL.Text := OwnerPrivSQL;
2903	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2902	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
2903	>	qryOwnerPriv.SQL.Text := GrantsSQL12
2904	>	else
2905	>	qryOwnerPriv.SQL.Text := GrantsSQL;
2906	>	qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
2907		qryOwnerPriv.ExecQuery;
2908		while not qryOwnerPriv.Eof do
2909		begin
2910	<	{ Sometimes grant options are null, sometimes 0.  Both same }
2911	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').IsNull then
2912	<	GrantOption := 0
2913	<	else
2914	<	GrantOption := qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger;
2915	<
2916	<	if qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull then
2917	<	FieldName := ''
2646	<	else
2647	<	FieldName := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').AsString;
2648	<
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	<
2910	>	FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
2911	>	qryOwnerPriv.FieldByName('Privileges').AsString,
2912	>	qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
2913	>	qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
2914	>	qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
2915	>	qryOwnerPriv.FieldByName('RDB$USER').AsString,
2916	>	qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
2917	>	Terminator]));
2918		qryOwnerPriv.Next;
2919		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
2920		qryOwnerPriv.Close;
2921	+	finally
2922	+	qryOwnerPriv.Free;
2923	+	end;
2924	+	end;
2925
2926	<	if First then
2927	<	begin
2928	<	{ Part two is for stored procedures only }
2929	<	qryOwnerPriv.SQL.Text := ProcPrivSQL;
2930	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2931	<	qryOwnerPriv.ExecQuery;
2932	<	while not qryOwnerPriv.Eof do
2933	<	begin
2934	<	First := false;
2935	<	User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2936	<
2937	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2938	<	obj_relation,
2939	<	obj_view,
2940	<	obj_trigger,
2941	<	obj_procedure,
2942	<	obj_sql_role:
2943	<	UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2944	<	else
2945	<	UserString := User;
2946	<	end; //end_case
2947	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2948	<	obj_view :
2949	<	UserString := 'VIEW ' + UserString;
2950	<	obj_trigger :
2951	<	UserString := 'TRIGGER '+ UserString;
2952	<	obj_procedure :
2953	<	UserString := 'PROCEDURE ' + UserString;
2954	<	end; //end_case
2926	>	procedure TIBExtract.ShowGrantsTo(MetaObject: String; ObjectType: integer; Terminator: String);
2927	>	const
2928	>	GrantsSQL =
2929	>	'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
2930	>	'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
2931	>	'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
2932	>	'case  RDB$OBJECT_TYPE '+
2933	>	'When 0 then ''TABLE'' '+
2934	>	'When 5 then ''PROCEDURE'' '+
2935	>	'When 7 then ''EXCEPTION'' '+
2936	>	'When 11 then ''CHARACTER SET'' '+
2937	>	'ELSE NULL END as OBJECT_TYPE_NAME, '+
2938	>	'case RDB$USER_TYPE '+
2939	>	'When 5 then ''PROCEDURE'' '+
2940	>	'When 2 then ''TRIGGER'' '+
2941	>	'When 8 then ''USER'' '+
2942	>	'When 13 then ''ROLE'' '+
2943	>	'ELSE NULL END as USER_TYPE_NAME, '+
2944	>	'case '+
2945	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
2946	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
2947	>	'ELSE '''' End as GRANTOPTION '+
2948	>	'From (  '+
2949	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
2950	>	'When ''X'' then ''EXECUTE''  '+
2951	>	'When ''S'' then ''SELECT''  '+
2952	>	'When ''U'' then ''UPDATE''   '+
2953	>	'When ''D'' then ''DELETE''  '+
2954	>	'When ''R'' then ''REFERENCES''  '+
2955	>	'When ''G'' then ''USAGE''  '+
2956	>	'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
2957	>	'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
2958	>	'FROM RDB$USER_PRIVILEGES PR  '+
2959	>	'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
2960	>	'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
2961	>	'UNION  '+
2962	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
2963	>	'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE   '+
2964	>	'FROM RDB$USER_PRIVILEGES PR  '+
2965	>	'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
2966	>	'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE)  '+
2967	>	'Where RDB$USER = :METAOBJECTNAME and RDB$USER_TYPE = :USERTYPE '+
2968	>	'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE, METAOBJECTNAME '+
2969	>	'ORDER BY METAOBJECTNAME';
2970
2971	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2766	<	WithOption := ' WITH GRANT OPTION'
2767	<	else
2768	<	WithOption := '';
2971	>	var qryOwnerPriv : TIBSQL;
2972
2973	<	FMetaData.Add(Format('GRANT EXECUTE ON PROCEDURE %s TO %s%s%s',
2974	<	[QuoteIdentifier(FDatabase.SQLDialect, MetaObject), UserString,
2975	<	WithOption, terminator]));
2973	>	begin
2974	>	if MetaObject = '' then
2975	>	exit;
2976
2977	<	qryOwnerPriv.Next;
2978	<	end;
2979	<	qryOwnerPriv.Close;
2980	<	end;
2981	<	if First then
2977	>	qryOwnerPriv := TIBSQL.Create(FDatabase);
2978	>	try
2979	>	qryOwnerPriv.SQL.Text := GrantsSQL;
2980	>	qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
2981	>	qryOwnerPriv.Params.ByName('USERTYPE').AsInteger := ObjectType;
2982	>	qryOwnerPriv.ExecQuery;
2983	>	while not qryOwnerPriv.Eof do
2984		begin
2985	<	qryOwnerPriv.SQL.Text := RolePrivSQL;
2986	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2987	<	qryOwnerPriv.ExecQuery;
2988	<	while not qryOwnerPriv.Eof do
2989	<	begin
2990	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2991	<	WithOption := ' WITH ADMIN OPTION'
2992	<	else
2993	<	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;
2985	>	FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
2986	>	qryOwnerPriv.FieldByName('Privileges').AsString,
2987	>	qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
2988	>	qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
2989	>	qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
2990	>	qryOwnerPriv.FieldByName('RDB$USER').AsString,
2991	>	qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
2992	>	Terminator]));
2993	>	qryOwnerPriv.Next;
2994		end;
2995		qryOwnerPriv.Close;
2996		finally
2997		qryOwnerPriv.Free;
2998		end;
2999	+	FMetaData.Add('');
3000		end;
3001
3002		{         ShowGrantRoles
#	Line 2838 | Line 3036 | begin
3036		WithOption := '';
3037		FMetaData.Add(Format('GRANT %s TO %s%s%s%s',
3038		[ QuoteIdentifier(FDatabase.SQLDialect, qryRole.FieldByName('RDB$RELATION_NAME').AsString),
3039	<	UserString, WithOption, Terminator, NEWLINE]));
3039	>	UserString, WithOption, Terminator, LineEnding]));
3040
3041		qryRole.Next;
3042		end;
#	Line 2918 | Line 3116 | var
3116		end;
3117		break;
3118		end;
3119	<	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
3120	<	(not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
3121	<	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3119	>	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
3120	>	begin
3121	>	if not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
3122	>	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
3123	>	else
3124	>	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3125	>	end;
3126
3127		{ Show international character sets and collations }
3128
#	Line 2981 | Line 3183 | begin
3183		if FirstTime then
3184		begin
3185		FirstTime := false;
3186	<	FMetaData.Add('RETURNS' + NEWLINE + '(');
3186	>	FMetaData.Add('RETURNS' + LineEnding + '(');
3187		end;
3188
3189		Line := FormatParamStr;
#	Line 3016 | Line 3218 | end;
3218
3219		procedure TIBExtract.ListData(ObjectName: String);
3220		const
3221	<	SelectSQL = 'SELECT * FROM %s';
3222	<	var
3223	<	qrySelect : TIBSQL;
3224	<	Line : String;
3225	<	i : Integer;
3221	>	SelectFieldListSQL = 'Select List(RDB$FIELD_NAME) From ( '+
3222	>	'Select RF.RDB$FIELD_NAME From RDB$RELATION_FIELDS RF '+
3223	>	'JOIN RDB$FIELDS F On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
3224	>	'Where F.RDB$COMPUTED_BLR is NULL and RF.RDB$RELATION_NAME = Upper(:Relation) '+
3225	>	'Order by RF.RDB$FIELD_POSITION asc)';
3226	>
3227	>	TableSQL =
3228	>	'SELECT * FROM RDB$RELATIONS ' +
3229	>	'WHERE ' +
3230	>	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
3231	>	'  RDB$VIEW_BLR IS NULL ' +
3232	>	'ORDER BY RDB$RELATION_NAME';
3233	>
3234	>	var FieldList: string;
3235	>
3236		begin
3237	<	qrySelect := TIBSQL.Create(FDatabase);
3238	<	try
3239	<	qrySelect.SQL.Text := Format(SelectSQL,
3240	<	[QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]);
3241	<	qrySelect.ExecQuery;
3242	<	while not qrySelect.Eof do
3243	<	begin
3244	<	Line := 'INSERT INTO ' + QuoteIdentifier(FDatabase.SQLDialect, ObjectName) + ' (';
3245	<	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
3237	>	if ObjectName = '' then {List all}
3238	>	begin
3239	>	with TIBSQL.Create(self) do
3240	>	try
3241	>	Database := FDatabase;
3242	>	SQL.Text := TableSQL;
3243	>	ExecQuery;
3244	>	FMetaData.Add('/* Data Starts */');
3245	>	while not EOF do
3246		begin
3247	<	if qrySelect.Fields[i].IsNull and
3248	<	(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:
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;
3247	>	ListData(Trim(FieldByName('RDB$RELATION_NAME').AsString));
3248	>	Next;
3249		end;
3250	<	Line := Line + ')' + Term;
3251	<	FMetaData.Add(Line);
3252	<	qrySelect.Next;
3250	>	FMetaData.Add('/* Data Ends */');
3251	>	finally
3252	>	Free;
3253	>	end;
3254	>	end
3255	>	else
3256	>	begin
3257	>	FieldList := '*';
3258	>	with TIBSQL.Create(self) do
3259	>	try
3260	>	Database := FDatabase;
3261	>	SQL.Text := SelectFieldListSQL;
3262	>	Params[0].AsString := ObjectName;
3263	>	ExecQuery;
3264	>	try
3265	>	if not EOF then
3266	>	FieldList := Fields[0].AsString;
3267	>	finally
3268	>	Close;
3269	>	end;
3270	>	finally
3271	>	Free
3272	>	end;
3273	>
3274	>	with TIBInsertStmtsOut.Create(self) do
3275	>	try
3276	>	Database := FDatabase;
3277	>	if DataOut(Format('Select %s From %s',[FieldList,QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]),
3278	>	Add2MetaData) then
3279	>	FMetaData.Add('COMMIT;');
3280	>	finally
3281	>	Free
3282		end;
3077	–	finally
3078	–	qrySelect.Free;
3283		end;
3284		end;
3285
3286		procedure TIBExtract.ListRoles(ObjectName: String);
3287		const
3288		RolesSQL =
3289	<	'select * from RDB$ROLES ' +
3289	>	'select * from RDB$ROLES WHERE RDB$SYSTEM_FLAG = 0 ' +
3290		'order by RDB$ROLE_NAME';
3291
3292		RolesByNameSQL =

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines