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 39 by tony, Tue May 17 08:14:52 2016 UTC vs.
Revision 140 by tony, Wed Jan 24 16:31:11 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	+	DDL Triggers (3.0)
35	+	}
36	+
37		unit IBExtract;
38
39		{$Mode Delphi}
29	–	{$IF FPC_FULLVERSION >= 20700 }
40		{$codepage UTF8}
31	–	{$ENDIF}
41
42		interface
43
#	Line 39 | 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 53 | Line 62 | type
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 61 | 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);
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; IncludeData: boolean =
92	>	false): Boolean;
93	>	function ExtractListTable(RelationName, NewName: String; DomainFlag: Boolean): Boolean;
94		procedure ExtractListView (ViewName : String);
95		procedure ListData(ObjectName : String);
96		procedure ListRoles(ObjectName : String = '');
97		procedure ListGrants;
98	<	procedure ListProcs(ProcedureName : String = '');
98	>	procedure ListProcs(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
99	>	IncludeGrants:boolean=false);
100		procedure ListAllTables(flag : Boolean);
101	<	procedure ListTriggers(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 88 | 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 101 | Line 121 | type
121		function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
122		FieldPrec, FieldLen : Integer) : String;
123		function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
104	–	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
124		procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
125		ExtractTypes : TExtractTypes = []);
126		property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
#	Line 124 | 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 135 | 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 158 | 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 171 | Line 193 | const
193		'TRANSACTION_DESCRIPTION',  { NTX: keyword }
194		'EXTERNAL_FILE_DESCRIPTION');       { NTX: keyword }
195
174	–	TriggerTypes : Array[0..6] of String = (
175	–	'',
176	–	'BEFORE INSERT',                    { NTX: keyword }
177	–	'AFTER INSERT',                             { NTX: keyword }
178	–	'BEFORE UPDATE',                    { NTX: keyword }
179	–	'AFTER UPDATE',                             { NTX: keyword }
180	–	'BEFORE DELETE',                    { NTX: keyword }
181	–	'AFTER DELETE');                    { NTX: keyword }
182	–
196		IntegralSubtypes : Array[0..2] of String = (
197		'UNKNOWN',                  { Defined type, NTX: keyword }
198		'NUMERIC',                  { NUMERIC, NTX: keyword }
#	Line 192 | 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 230 | Line 244 | const
244
245		implementation
246
247	+	uses FBMessages, IBDataOutput;
248	+
249		const
234	–	NEWLINE = #13#10;
250		TERM = ';';
251		ProcTerm = '^';
252
#	Line 260 | 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 273 | 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
292	–	Result := Result + '] ';
343		qryArray.Free;
344
345		end;
#	Line 313 | Line 363 | begin
363		inherited;
364		end;
365
366	<	function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String) : Boolean;
366	>	function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean = false) : Boolean;
367		var
368		DidConnect : Boolean;
369		DidStart : Boolean;
#	Line 329 | Line 379 | begin
379		end;
380
381		FMetaData.Add(Format('SET SQL DIALECT %d;', [FDatabase.SQLDialect]));
382	+	FMetaData.Add('SET AUTODDL ON;');
383		FMetaData.Add('');
384
385		if not FTransaction.Active then
#	Line 349 | Line 400 | begin
400		ListFunctions;
401		ListDomains;
402		ListAllTables(flag);
403	+	if IncludeData then
404	+	ListData('');
405		ListIndex;
406		ListForeign;
407	<	ListGenerators;
407	>	if IncludeData then
408	>	ListGenerators('',[etData])
409	>	else
410	>	ListGenerators;
411		ListViews;
412		ListCheck;
413		ListException;
414	<	ListProcs;
414	>	ListProcs(pdCreateStub);
415		ListTriggers;
416	+	ListProcs(pdAlterProc);
417		ListGrants;
418		end;
419
#	Line 378 | Line 435 | end;
435		domain_flag -- extract needed domains before the table }
436
437		function TIBExtract.ExtractListTable(RelationName, NewName: String;
438	<	DomainFlag: Boolean) : Boolean;
438	>	DomainFlag: Boolean): Boolean;
439		const
440		TableListSQL =
441		'SELECT * FROM RDB$RELATIONS REL JOIN RDB$RELATION_FIELDS RFR ON ' + {Do Not Localize}
#	Line 403 | Line 460 | const
460		'  (RELC.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR ' +
461		'  RELC.RDB$CONSTRAINT_TYPE = ''UNIQUE'') AND ' +
462		'  RELC.RDB$RELATION_NAME = :RELATIONNAME ' +
463	<	'ORDER BY RELC.RDB$CONSTRAINT_NAME';
463	>	'ORDER BY RELC.RDB$CONSTRAINT_TYPE desc, RELC.RDB$CONSTRAINT_NAME';
464	>
465	>	GetGeneratorSQL =
466	>	'SELECT * FROM RDB$GENERATORS WHERE RDB$GENERATOR_NAME = :GENERATOR';
467
468		var
469		Collation, CharSetId : integer;
470		i : integer;
471	<	ColList, Column, Constraint : String;
471	>	Column, Constraint : String;
472		SubType : integer;
473		IntChar : integer;
474	<	qryTables, qryPrecision, qryConstraints, qryRelConstraints : TIBSQL;
474	>	qryTables, qryPrecision, qryConstraints, qryRelConstraints, qryGenerators : TIBSQL;
475		PrecisionKnown, ValidRelation : Boolean;
476		FieldScale, FieldType : Integer;
477	+	CreateTable: string;
478	+	TableType: integer;
479		begin
480		Result := true;
419	–	ColList := '';
481		IntChar := 0;
482		ValidRelation := false;
483
#	Line 426 | Line 487 | begin
487		qryPrecision := TIBSQL.Create(FDatabase);
488		qryConstraints := TIBSQL.Create(FDatabase);
489		qryRelConstraints := TIBSQL.Create(FDatabase);
490	+	qryGenerators := TIBSQL.Create(FDatabase);
491		try
492		qryTables.SQL.Add(TableListSQL);
493	+	RelationName := trim(RelationName);
494		qryTables.Params.ByName('RelationName').AsString := RelationName;
495		qryTables.ExecQuery;
496		qryPrecision.SQL.Add(PrecisionSQL);
497		qryConstraints.SQL.Add(ConstraintSQL);
498		qryRelConstraints.SQL.Add(RelConstraintsSQL);
499	+	qryGenerators.SQL.Add(GetGeneratorSQL);
500		if not qryTables.Eof then
501		begin
502		ValidRelation := true;
503	+	TableType := qryTables.FieldByName('RDB$RELATION_TYPE').AsInteger;
504		if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and
505		(Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsString) <> '') then
506		FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',
507	<	[NEWLINE, RelationName,
508	<	qryTables.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
507	>	[LineEnding, RelationName,
508	>	qryTables.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
509	>	if TableType > 3 then
510	>	CreateTable := 'CREATE GLOBAL TEMPORARY TABLE'
511	>	else
512	>	CreateTable := 'CREATE TABLE';
513		if NewName <> '' then
514	<	FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
514	>	FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
515		else
516	<	FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
516	>	FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
517		if not qryTables.FieldByName('RDB$EXTERNAL_FILE').IsNull then
518		FMetaData.Add(Format('EXTERNAL FILE %s ',
519		[QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsString)]));
#	Line 474 | Line 543 | begin
543		(qryTables.FieldByName('RDB$FIELD_NAME1').AsString[5] in ['0'..'9'])) and
544		(qryTables.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
545		begin
546	<	Column := Column + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME1').AsString);
546	>	Column := Column + QuoteIdentifier(FDatabase.SQLDialect, trim(qryTables.FieldByName('RDB$FIELD_NAME1').AsString));
547		{ International character sets }
548		if (qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying])
549		and (not qryTables.FieldByName('RDB$COLLATION_ID').IsNull)
#	Line 546 | Line 615 | begin
615
616		{ Catch arrays after printing the type  }
617
618	<	if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull then
619	<	Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_NAME').AsString);
618	>	if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull and (qryTables.FieldByName('RDB$DIMENSIONS').AsInteger > 0) then
619	>	Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_SOURCE').AsString);
620
621		if FieldType = blr_blob then
622		begin
#	Line 578 | Line 647 | begin
647		end;
648		end;
649
650	+	{Firebird 3 introduces IDENTITY columns. We need to check for them here}
651	+	if qryTables.HasField('RDB$GENERATOR_NAME') and not qryTables.FieldByName('RDB$GENERATOR_NAME').IsNull then
652	+	begin
653	+	qryGenerators.ParamByName('GENERATOR').AsString :=  qryTables.FieldByName('RDB$GENERATOR_NAME').AsString;
654	+	qryGenerators.ExecQuery;
655	+	if not qryGenerators.Eof then
656	+	begin
657	+	Column := Column + Format(' GENERATED BY DEFAULT AS IDENTITY START WITH %d',
658	+	[qryGenerators.FieldByName('RDB$INITIAL_VALUE').AsInteger]);
659	+	end;
660	+	qryGenerators.Close;
661	+	end;
662	+
663		{ Handle defaults for columns }
664		{ Originally This called PrintMetadataTextBlob,
665		should no longer need }
#	Line 664 | Line 746 | begin
746		qryRelConstraints.Next;
747		end;
748		if ValidRelation then
749	<	FMetaData.Add(')' + Term);
749	>	begin
750	>	if TableType = 4 then
751	>	FMetaData.Add(' ) ON COMMIT PRESERVE ROWS ' + TERM)
752	>	else
753	>	FMetaData.Add(')' + TERM);
754	>	end;
755		finally
756		qryTables.Free;
757		qryPrecision.Free;
758		qryConstraints.Free;
759		qryRelConstraints.Free;
760	+	qryGenerators.Free;
761		end;
762		end;
763
#	Line 698 | Line 786 | var
786		qryViews, qryColumns : TIBSQL;
787		RelationName, ColList : String;
788		begin
789	+	ColList := '';
790		qryViews := TIBSQL.Create(FDatabase);
791		qryColumns := TIBSQL.Create(FDatabase);
792		try
#	Line 743 | Line 832 | var
832		CharSetSQL : TIBSQL;
833		DidActivate : Boolean;
834		begin
835	+	Result := '';
836		if not FTransaction.Active then
837		begin
838		FTransaction.StartTransaction;
#	Line 790 | Line 880 | begin
880		FTransaction.Commit;
881		end;
882
883	+	procedure TIBExtract.Add2MetaData(const Msg: string; IsError: boolean);
884	+	begin
885	+	FMetaData.Add(Msg);
886	+	end;
887	+
888		function TIBExtract.GetDatabase: TIBDatabase;
889		begin
890		result := FDatabase;
#	Line 799 | Line 894 | end;
894		Functional description
895		returns the list of columns in an index. }
896
897	<	function TIBExtract.GetIndexSegments(IndexName: String): String;
897	>	function TIBExtract.GetIndexSegments(indexname: String): String;
898		const
899		IndexNamesSQL =
900		'SELECT * FROM RDB$INDEX_SEGMENTS SEG ' +
#	Line 836 | Line 931 | begin
931		Result := FTransaction;
932		end;
933
934	+	function TIBExtract.GetTriggerType(TypeID: Int64): string;
935	+	const
936	+	AllDDLTriggers = $7FFFFFFFFFFFDFFF shr 1;
937	+	var separator: string;
938	+	i: integer;
939	+
940	+	function GetDDLEvent(Phase: TTriggerPhase; ObjectName: string): string;
941	+	begin
942	+	Result := '';
943	+	case Phase of
944	+	tpCreate:
945	+	Result := separator + 'CREATE ' + ObjectName;
946	+	tpAlter:
947	+	Result := separator + 'ALTER ' + ObjectName;
948	+	tpDrop:
949	+	Result := separator + 'Drop ' + ObjectName;
950	+	end;
951	+	if Result <> '' then
952	+	separator := ' OR ';
953	+	end;
954	+
955	+	begin
956	+	if TypeID and $2000 <> 0 then
957	+	{database trigger}
958	+	begin
959	+	Result := 'ON ';
960	+	case TypeID of
961	+	$2000:
962	+	Result += 'CONNECT';
963	+	$2001:
964	+	Result += 'DISCONNECT';
965	+	$2002:
966	+	Result +='TRANSACTION START';
967	+	$2003:
968	+	Result += 'TRANSACTION COMMIT';
969	+	$2004:
970	+	Result += 'TRANSACTION ROLLBACK';
971	+	end;
972	+	end
973	+	else
974	+	if TypeID and $4000 <> 0 then
975	+	{DDL Trigger}
976	+	begin
977	+	if TypeID and $01 <> 0 then
978	+	Result := 'AFTER '
979	+	else
980	+	Result := 'BEFORE ';
981	+	TypeID := TypeID shr 1;
982	+	separator := '';
983	+	i := 0;
984	+	if TypeID = AllDDLTriggers then
985	+	Result += 'ANY DDL STATEMENT'
986	+	else
987	+	repeat
988	+	if (DDLTriggers[i].Bits > 0) and (TypeID and $01 <> 0) then
989	+	Result += GetDDLEvent(DDLTriggers[i].Bit1,DDLTriggers[i].ObjectName);
990	+
991	+	if (DDLTriggers[i].Bits > 1) and (TypeID and $02 <> 0) then
992	+	Result += GetDDLEvent(DDLTriggers[i].Bit2,DDLTriggers[i].ObjectName);
993	+
994	+	if (DDLTriggers[i].Bits > 2) and (TypeID and $04 <> 0) then
995	+	Result += GetDDLEvent(DDLTriggers[i].Bit3,DDLTriggers[i].ObjectName);
996	+	TypeID := TypeID shr DDLTriggers[i].Bits;
997	+	Inc(i);
998	+	until TypeID = 0;
999	+	end
1000	+	else
1001	+	{Normal Trigger}
1002	+	begin
1003	+	Inc(TypeID);
1004	+	if TypeID and $01 <> 0 then
1005	+	Result := 'AFTER '
1006	+	else
1007	+	Result := 'BEFORE ';
1008	+	TypeID := TypeID shr 1;
1009	+	separator := '';
1010	+	repeat
1011	+	Result += separator;
1012	+	separator := ' or ';
1013	+	case TypeID and $03 of
1014	+	1:
1015	+	Result += 'INSERT';
1016	+	2:
1017	+	Result += 'UPDATE';
1018	+	3:
1019	+	Result += 'DELETE';
1020	+	end;
1021	+	TypeID := TypeID shr 2;
1022	+	until TypeID = 0
1023	+	end
1024	+	end;
1025	+
1026		{          ListAllGrants
1027		Functional description
1028		Print the permissions on all user tables.
#	Line 849 | Line 1036 | const
1036		'  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
1037		'ORDER BY RDB$RELATION_NAME';
1038
1039	<	ProcedureSQL = 'select * from RDB$PROCEDURES ' +
1039	>	ProcedureSQL = 'select * from RDB$PROCEDURES '+
1040	>	'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1041		'Order BY RDB$PROCEDURE_NAME';
1042
1043	+	ExceptionSQL = 'select * from RDB$EXCEPTIONS '+
1044	+	'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1045	+	'Order BY RDB$EXCEPTION_NAME';
1046	+
1047	+	GeneratorSQL = 'select * from RDB$GENERATORS '+
1048	+	'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1049	+	'Order BY RDB$GENERATOR_NAME';
1050	+
1051		var
1052		qryRoles : TIBSQL;
1053		RelationName : String;
#	Line 881 | Line 1077 | begin
1077
1078		ShowGrantRoles(Term);
1079
1080	+	qryRoles.SQL.Text := ExceptionSQL;
1081	+	qryRoles.ExecQuery;
1082	+	try
1083	+	while not qryRoles.Eof do
1084	+	begin
1085	+	ShowGrants(Trim(qryRoles.FieldByName('RDB$EXCEPTION_NAME').AsString), Term);
1086	+	qryRoles.Next;
1087	+	end;
1088	+	finally
1089	+	qryRoles.Close;
1090	+	end;
1091	+
1092	+	qryRoles.SQL.Text := GeneratorSQL;
1093	+	qryRoles.ExecQuery;
1094	+	try
1095	+	while not qryRoles.Eof do
1096	+	begin
1097	+	ShowGrants(Trim(qryRoles.FieldByName('RDB$GENERATOR_NAME').AsString), Term);
1098	+	qryRoles.Next;
1099	+	end;
1100	+	finally
1101	+	qryRoles.Close;
1102	+	end;
1103	+
1104		qryRoles.SQL.Text := ProcedureSQL;
1105		qryRoles.ExecQuery;
1106		try
#	Line 908 | Line 1128 | end;
1128
1129		procname -- Name of procedure to investigate }
1130
1131	<	procedure TIBExtract.ListProcs(ProcedureName : String);
1131	>	procedure TIBExtract.ListProcs(ProcDDLType: TProcDDLType;
1132	>	ProcedureName: String; IncludeGrants: boolean);
1133		const
1134		CreateProcedureStr1 = 'CREATE PROCEDURE %s ';
1135		CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';
1136	<	ProcedureSQL =
1137	<	'SELECT * FROM RDB$PROCEDURES ' +
1138	<	'ORDER BY RDB$PROCEDURE_NAME';
1136	>	ProcedureSQL =  {Order procedures by dependency order and then procedure name}
1137	>	'with recursive Procs as ( ' +
1138	>	'Select RDB$PROCEDURE_NAME, 1 as ProcLevel from RDB$PROCEDURES ' +
1139	>	'UNION ALL ' +
1140	>	'Select D.RDB$DEPENDED_ON_NAME, ProcLevel + 1 From RDB$DEPENDENCIES D ' +
1141	>	'JOIN Procs on Procs.RDB$PROCEDURE_NAME = D.RDB$DEPENDENT_NAME ' +
1142	>	'  and Procs.RDB$PROCEDURE_NAME <> D.RDB$DEPENDED_ON_NAME ' +
1143	>	'JOIN RDB$PROCEDURES P On P.RDB$PROCEDURE_NAME = D.RDB$DEPENDED_ON_NAME ' +
1144	>	'  ) ' +
1145	>	'SELECT * FROM RDB$PROCEDURES P ' +
1146	>	'JOIN ( ' +
1147	>	'Select RDB$PROCEDURE_NAME, max(ProcLevel) as ProcLevel From Procs ' +
1148	>	'Group By RDB$PROCEDURE_NAME) A On A.RDB$PROCEDURE_NAME = P.RDB$PROCEDURE_NAME ' +
1149	>	'Order by A.ProcLevel desc, P.RDB$PROCEDURE_NAME asc';
1150
1151		ProcedureNameSQL =
1152		'SELECT * FROM RDB$PROCEDURES ' +
#	Line 926 | Line 1158 | var
1158		ProcName : String;
1159		SList : TStrings;
1160		Header : Boolean;
1161	+
1162		begin
1163
1164		Header := true;
1165		qryProcedures := TIBSQL.Create(FDatabase);
1166		SList := TStringList.Create;
1167		try
935	–	{  First the dummy procedures
936	–	create the procedures with their parameters }
1168		if ProcedureName = '' then
1169		qryProcedures.SQL.Text := ProcedureSQL
1170		else
#	Line 941 | Line 1172 | begin
1172		qryProcedures.SQL.Text := ProcedureNameSQL;
1173		qryProcedures.Params.ByName('ProcedureName').AsString := ProcedureName;
1174		end;
1175	+
1176		qryProcedures.ExecQuery;
1177		while not qryProcedures.Eof do
1178		begin
#	Line 949 | Line 1181 | begin
1181		FMetaData.Add('COMMIT WORK;');
1182		FMetaData.Add('SET AUTODDL OFF;');
1183		FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term]));
1184	<	FMetaData.Add(Format('%s/* Stored procedures */%s', [NEWLINE, NEWLINE]));
1184	>	FMetaData.Add(Format('%s/* Stored procedures */%s', [LineEnding, LineEnding]));
1185		Header := false;
1186		end;
1187		ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
956	–	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
957	–	ProcName)]));
958	–	GetProcedureArgs(ProcName);
959	–	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, NEWLINE]));
960	–	qryProcedures.Next;
961	–	end;
1188
1189	<	qryProcedures.Close;
1190	<	qryProcedures.ExecQuery;
1191	<	while not qryProcedures.Eof do
1192	<	begin
1193	<	SList.Clear;
1194	<	ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
1195	<	FMetaData.Add(Format('%sALTER PROCEDURE %s ', [NEWLINE,
1196	<	QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1197	<	GetProcedureArgs(ProcName);
1198	<
1199	<	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1200	<	SList.Text := SList.Text + qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1201	<	SList.Add(Format(' %s%s', [ProcTerm, NEWLINE]));
1202	<	FMetaData.AddStrings(SList);
1189	>	case ProcDDLType of
1190	>	pdCreateStub:
1191	>	begin
1192	>	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1193	>	ProcName)]));
1194	>	GetProcedureArgs(ProcName);
1195	>	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1196	>	end;
1197	>
1198	>	pdCreateProc:
1199	>	begin
1200	>	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
1201	>	ProcName)]));
1202	>	GetProcedureArgs(ProcName);
1203	>	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1204	>	begin
1205	>	SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1206	>	SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1207	>	FMetaData.AddStrings(SList);
1208	>	end
1209	>	else
1210	>	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1211	>	end;
1212	>
1213	>	pdAlterProc:
1214	>	begin
1215	>	FMetaData.Add(Format('%sALTER PROCEDURE %s ', [LineEnding,
1216	>	QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
1217	>	GetProcedureArgs(ProcName);
1218	>
1219	>	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
1220	>	begin
1221	>	SList.Text := qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
1222	>	SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1223	>	FMetaData.AddStrings(SList);
1224	>	end
1225	>	else
1226	>	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1227	>	end;
1228	>	end;
1229	>	if IncludeGrants then
1230	>	ShowGrantsTo(ProcName,obj_procedure,ProcTerm);
1231		qryProcedures.Next;
1232		end;
1233	<
980	<	{ This query gets the procedure name and the source.  We then nest a query
981	<	to retrieve the parameters. Alter is used, because the procedures are
982	<	already there}
1233	>	qryProcedures.Close;
1234
1235		if not Header then
1236		begin
#	Line 1040 | Line 1291 | end;
1291		Lists triggers in general on non-system
1292		tables with sql source only. }
1293
1294	<	procedure TIBExtract.ListTriggers(ObjectName : String; ExtractType : TExtractType);
1294	>	procedure TIBExtract.ListTriggers(ObjectName: String; ExtractTypes: TExtractTypes
1295	>	);
1296		const
1297		{ Query gets the trigger info for non-system triggers with
1298		source that are not part of an SQL constraint }
1299
1300		TriggerSQL =
1301	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1301	>	'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1302		'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1303		'WHERE ' +
1304		' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
#	Line 1067 | Line 1319 | const
1319		'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1320
1321		TriggerByNameSQL =
1322	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1322	>	'SELECT * FROM RDB$TRIGGERS TRG Left Outer JOIN RDB$RELATIONS REL ON ' +
1323		'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1324		'WHERE ' +
1325		' TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
#	Line 1091 | Line 1343 | begin
1343		qryTriggers.SQL.Text := TriggerSQL
1344		else
1345		begin
1346	<	if ExtractType = etTable then
1346	>	if etTable in ExtractTypes  then
1347		begin
1348		qryTriggers.SQL.Text := TriggerNameSQL;
1349		qryTriggers.Params.ByName('TableName').AsString := ObjectName;
#	Line 1108 | Line 1360 | begin
1360		SList.Clear;
1361		if Header then
1362		begin
1363	<	FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, NEWLINE]));
1363	>	FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, LineEnding]));
1364		FMetaData.Add(Format('%s/* Triggers only will work for SQL triggers */%s',
1365	<	[NEWLINE, NEWLINE]));
1365	>	[LineEnding, LineEnding]));
1366		Header := false;
1367		end;
1368		TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsString;
#	Line 1126 | Line 1378 | begin
1378		if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1379		SList.Add('/* ');
1380
1381	<	SList.Add(Format('CREATE TRIGGER %s FOR %s %s%s %s POSITION %d',
1382	<	[QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1383	<	QuoteIdentifier(FDatabase.SQLDialect, RelationName),
1384	<	NEWLINE, InActive,
1385	<	TriggerTypes[qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger],
1386	<	qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1381	>	{Database or Transaction trigger}
1382	>	SList.Add(Format('CREATE TRIGGER %s%s%s %s POSITION %d',
1383	>	[QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1384	>	LineEnding, InActive,
1385	>	GetTriggerType(qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInt64),
1386	>	qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1387	>
1388	>	if RelationName <> '' then
1389	>	SList.Add('ON ' + QuoteIdentifier(FDatabase.SQLDialect, RelationName));
1390	>
1391		if not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1392	<	SList.Text := SList.Text +
1393	<	qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1394	<	SList.Add(' ' + ProcTerm + NEWLINE);
1392	>	SList.Add(qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString)
1393	>	else
1394	>	SList.Add('AS BEGIN EXIT; END');
1395	>	SList.Add(' ' + ProcTerm);
1396		if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1397		SList.Add(' */');
1398		FMetaData.AddStrings(SList);
1399	+	if etGrant in ExtractTypes then
1400	+	ShowGrantsTo(TriggerName,obj_trigger,ProcTerm);
1401		qryTriggers.Next;
1402		end;
1403		if not Header then
#	Line 1223 | Line 1482 | begin
1482		if not qryChecks.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1483		SList.Text := SList.Text + qryChecks.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1484
1485	<	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + NEWLINE;
1485	>	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + LineEnding;
1486		FMetaData.AddStrings(SList);
1487		qryChecks.Next;
1488		end;
#	Line 1243 | Line 1502 | const
1502		CharInfoSQL =
1503		'SELECT * FROM RDB$DATABASE DBP ' +
1504		'WHERE NOT DBP.RDB$CHARACTER_SET_NAME IS NULL ' +
1505	<	'  AND DBP.RDB$CHARACTER_SET_NAME != '' ''';
1505	>	'  AND DBP.RDB$CHARACTER_SET_NAME <> '' ''';
1506
1507		FilesSQL =
1508		'select * from RDB$FILES ' +
#	Line 1260 | Line 1519 | var
1519		FileFlags, FileLength, FileSequence, FileStart : Integer;
1520
1521		function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
1263	–	var
1264	–	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
1265	–	length: Integer;
1266	–	_DatabaseInfoCommand: Char;
1522		begin
1523	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
1524	<	FDatabaseInfo.Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
1525	<	IBLocalBufferLength, local_buffer), True);
1526	<	length := isc_vax_integer(@local_buffer[1], 2);
1527	<	result := isc_vax_integer(@local_buffer[3], length);
1523	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
1524	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
1525	>	Result := Items[0].AsInteger
1526	>	else
1527	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
1528		end;
1529
1530		begin
1531	<	NoDb := FALSE;
1531	>	NoDb := FALSE;
1532		First := TRUE;
1533		FirstFile := TRUE;
1534		HasWal := FALSE;
#	Line 1286 | Line 1541 | begin
1541		NoDb := true;
1542		end;
1543		Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +
1544	<	IntToStr(FDatabaseInfo.PageSize) + NEWLINE;
1544	>	IntToStr(FDatabaseInfo.PageSize) + LineEnding;
1545		FMetaData.Add(Buffer);
1546		Buffer := '';
1547
#	Line 1295 | Line 1550 | begin
1550		qryDB.SQL.Text := CharInfoSQL;
1551		qryDB.ExecQuery;
1552
1553	<	Buffer := Format(' DEFAULT CHARACTER SET %s',
1554	<	[qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
1553	>	if not qryDB.EOF then
1554	>	Buffer := Format(' DEFAULT CHARACTER SET %s',
1555	>	[trim(qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString)]);
1556		if NoDB then
1557	<	Buffer := Buffer + ' */'
1557	>	Buffer := Buffer + Term + ' */'
1558		else
1559		Buffer := Buffer + Term;
1560		FMetaData.Add(Buffer);
#	Line 1311 | Line 1567 | begin
1567		begin
1568		if First then
1569		begin
1570	<	FMetaData.Add(NEWLINE + '/* Add secondary files in comments ');
1570	>	FMetaData.Add(LineEnding + '/* Add secondary files in comments ');
1571		First := false;
1572		end; //end_if
1573
#	Line 1336 | Line 1592 | begin
1592		if FileFlags = 0 then
1593		begin
1594		Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',
1595	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1595	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1596		if FileStart <> 0 then
1597		Buffer := Buffer + Format(' STARTING %d', [FileStart]);
1598		if FileLength <> 0 then
#	Line 1345 | Line 1601 | begin
1601		end; //end_if
1602		if (FileFlags and FILE_cache) <> 0 then
1603		FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',
1604	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1604	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1605
1606		Buffer := '';
1607		if (FileFlags and FILE_shadow) <> 0 then
#	Line 1356 | Line 1612 | begin
1612		else
1613		begin
1614		Buffer := Format('%sCREATE SHADOW %d ''%s'' ',
1615	<	[NEWLINE, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1615	>	[LineEnding, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1616		qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1617		if (FileFlags and FILE_inactive) <> 0 then
1618		Buffer := Buffer + 'INACTIVE ';
#	Line 1397 | Line 1653 | begin
1653		begin
1654		if NoDB then
1655		Buffer := '/* ';
1656	<	Buffer := Buffer + NEWLINE + 'ALTER DATABASE ADD ';
1656	>	Buffer := Buffer + LineEnding + 'ALTER DATABASE ADD ';
1657		First := false;
1658		end; //end_if
1659		if FirstFile then
#	Line 1407 | Line 1663 | begin
1663		begin
1664		if (FileFlags and LOG_overflow) <> 0 then
1665		Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',
1666	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1666	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1667		else
1668		if (FileFlags and LOG_serial) <> 0 then
1669		Buffer := Buffer + Format('%s  BASE_NAME ''%s''',
1670	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1670	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1671		{ Since we are fetching order by FILE_FLAGS, the LOG_0verflow will
1672		be last.  It will only appear if there were named round robin,
1673		so we must close the parens first }
#	Line 1422 | Line 1678 | begin
1678		if FirstFile then
1679		Buffer := Buffer + '('
1680		else
1681	<	Buffer := Buffer + Format(',%s  ', [NEWLINE]);
1681	>	Buffer := Buffer + Format(',%s  ', [LineEnding]);
1682		FirstFile := false;
1683
1684		Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsString]);
#	Line 1456 | Line 1712 | begin
1712		if not First then
1713		begin
1714		if NoDB then
1715	<	FMetaData.Add(Format('%s */%s', [NEWLINE, NEWLINE]))
1715	>	FMetaData.Add(Format('%s */%s', [LineEnding, LineEnding]))
1716		else
1717	<	FMetaData.Add(Format('%s%s%s', [Term, NEWLINE, NEWLINE]));
1717	>	FMetaData.Add(Format('%s%s%s', [Term, LineEnding, LineEnding]));
1718		end;
1719		finally
1720		qryDB.Free;
#	Line 1560 | Line 1816 | var
1816		Result := Result + Format(' SEGMENT SIZE %d', [qryDomains.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
1817		end //end_if
1818		else
1819	<	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
1820	<	(not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
1821	<	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1819	>	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
1820	>	begin
1821	>	if not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
1822	>	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
1823	>	else
1824	>	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1825	>	end;
1826
1827		{ since the character set is part of the field type, display that
1828		information now. }
#	Line 1570 | Line 1830 | var
1830		Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1831		0, FALSE);
1832		if not qryDomains.FieldByName('RDB$DIMENSIONS').IsNull then
1833	<	Result := GetArrayField(FieldName);
1833	>	Result := GetArrayField(qryDomains.FieldByName('RDB$FIELD_SOURCE').AsString);
1834
1835		if not qryDomains.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
1836	<	Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1836	>	Result := Result + Format('%s%s %s', [LineEnding, TAB,
1837		qryDomains.FieldByName('RDB$DEFAULT_SOURCE').AsString]);
1838
1839		if not qryDomains.FieldByName('RDB$VALIDATION_SOURCE').IsNull then
1840		if Pos('CHECK', AnsiUpperCase(qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString)) = 1 then
1841	<	Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1841	>	Result := Result + Format('%s%s %s', [LineEnding, TAB,
1842		qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString])
1843		else
1844	<	Result := Result + Format('%s%s /* %s */', [NEWLINE, TAB,
1844	>	Result := Result + Format('%s%s /* %s */', [LineEnding, TAB,
1845		qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString]);
1846
1847		if qryDomains.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
#	Line 1897 | Line 2157 | end;
2157		procedure TIBExtract.ListFunctions(FunctionName : String = '');
2158		const
2159		FunctionSQL =
2160	<	'SELECT * FROM RDB$FUNCTIONS ' +
2160	>	'SELECT * FROM RDB$FUNCTIONS WHERE RDB$SYSTEM_FLAG = 0 ' +
2161		'ORDER BY RDB$FUNCTION_NAME';
2162
2163		FunctionNameSQL =
#	Line 1950 | Line 2210 | begin
2210		if First then
2211		begin
2212		FMEtaData.Add(Format('%s/*  External Function declarations */%s',
2213	<	[NEWLINE, NEWLINE]));
2213	>	[LineEnding, LineEnding]));
2214		First := false;
2215		end; //end_if
2216		{ Start new function declaration }
#	Line 2077 | Line 2337 | begin
2337		FMetaData.Add(Format('ENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%s%s',
2338		[qryFunctions.FieldByName('RDB$ENTRYPOINT').AsString,
2339		qryFunctions.FieldByName('RDB$MODULE_NAME').AsString,
2340	<	Term, NEWLINE, NEWLINE]));
2340	>	Term, LineEnding, LineEnding]));
2341
2342		qryFunctions.Next;
2343		end;
#	Line 2093 | Line 2353 | end;
2353		Functional description
2354		Re create all non-system generators }
2355
2356	<	procedure TIBExtract.ListGenerators(GeneratorName : String = '');
2356	>	procedure TIBExtract.ListGenerators(GeneratorName: String;
2357	>	ExtractTypes: TExtractTypes);
2358		const
2359		GeneratorSQL =
2360		'SELECT RDB$GENERATOR_NAME ' +
#	Line 2109 | Line 2370 | const
2370		'  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2371		'ORDER BY RDB$GENERATOR_NAME';
2372
2373	+	GeneratorValueSQL =
2374	+	'SELECT GEN_ID(%s,0) as GENERATORVALUE From RDB$Database';
2375	+
2376		var
2377		qryGenerator : TIBSQL;
2378	+	qryValue: TIBSQL;
2379		GenName : String;
2380		begin
2381		qryGenerator := TIBSQL.Create(FDatabase);
2382	+	qryValue := TIBSQL.Create(FDatabase);
2383		try
2384		if GeneratorName = '' then
2385		qryGenerator.SQL.Text := GeneratorSQL
#	Line 2135 | Line 2401 | begin
2401		qryGenerator.Next;
2402		continue;
2403		end;
2404	<	FMetaData.Add(Format('CREATE GENERATOR %s%s',
2404	>	FMetaData.Add(Format('CREATE SEQUENCE %s%s',
2405		[QuoteIdentifier(FDatabase.SQLDialect, GenName),
2406		Term]));
2407	+	if etData in ExtractTypes then
2408	+	begin
2409	+	qryValue.SQL.Text := Format(GeneratorValueSQL,[GenName]);
2410	+	qryValue.ExecQuery;
2411	+	try
2412	+	if not qryValue.EOF then
2413	+	FMetaData.Add(Format('ALTER SEQUENCE %s RESTART WITH %d;',
2414	+	[QuoteIdentifier(FDatabase.SQLDialect, GenName),
2415	+	qryValue.FieldByName('GENERATORVALUE').AsInteger]));
2416	+	finally
2417	+	qryValue.Close;
2418	+	end;
2419	+	end;
2420		qryGenerator.Next;
2421		end;
2422		finally
2423		qryGenerator.Free;
2424	+	qryValue.Free;
2425		end;
2426		end;
2427
#	Line 2215 | Line 2495 | begin
2495		if First then
2496		begin
2497		if ObjectName = '' then
2498	<	FMetaData.Add(NEWLINE + '/*  Index definitions for all user tables */' + NEWLINE)
2498	>	FMetaData.Add(LineEnding + '/*  Index definitions for all user tables */' + LineEnding)
2499		else
2500	<	FMetaData.Add(NEWLINE + '/*  Index definitions for ' + ObjectName + ' */' + NEWLINE);
2500	>	FMetaData.Add(LineEnding + '/*  Index definitions for ' + ObjectName + ' */' + LineEnding);
2501		First := false;
2502		end; //end_if
2503
#	Line 2257 | Line 2537 | end;
2537		procedure TIBExtract.ListViews(ViewName : String);
2538		const
2539		ViewSQL =
2540	+	'with recursive Views as ( ' +
2541	+	'  Select RDB$RELATION_NAME, 1 as ViewLevel from RDB$RELATIONS ' +
2542	+	'    Where RDB$RELATION_TYPE = 1 and RDB$SYSTEM_FLAG = 0 '+
2543	+	'  UNION ALL ' +
2544	+	'  Select D.RDB$DEPENDED_ON_NAME, ViewLevel + 1 From RDB$DEPENDENCIES D ' +
2545	+	'  JOIN Views on Views.RDB$RELATION_NAME = D.RDB$DEPENDENT_NAME ' +
2546	+	'     and Views.RDB$RELATION_NAME <> D.RDB$DEPENDED_ON_NAME ' +
2547	+	'  JOIN RDB$RELATIONS R On R.RDB$RELATION_NAME = D.RDB$DEPENDED_ON_NAME ' +
2548	+	')' +
2549	+	'SELECT R.RDB$RELATION_NAME, R.RDB$OWNER_NAME, R.RDB$VIEW_SOURCE FROM RDB$RELATIONS R ' +
2550	+	'JOIN ( ' +
2551	+	'Select RDB$RELATION_NAME, max(ViewLevel) as ViewLevel From Views ' +
2552	+	'Group By RDB$RELATION_NAME) A On A.RDB$RELATION_NAME = R.RDB$RELATION_NAME ' +
2553	+	'Where R.RDB$RELATION_TYPE = 1 and R.RDB$SYSTEM_FLAG = 0 '+
2554	+	'Order by A.ViewLevel desc, R.RDB$RELATION_NAME asc';
2555	+
2556	+	{
2557		'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2558		'FROM RDB$RELATIONS ' +
2559		'WHERE ' +
2560		'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2561		'  NOT RDB$VIEW_BLR IS NULL AND ' +
2562		'  RDB$FLAGS = 1 ' +
2563	<	'ORDER BY RDB$RELATION_ID';
2563	>	'ORDER BY RDB$RELATION_ID'; }
2564
2565		ViewNameSQL =
2566		'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
#	Line 2301 | Line 2598 | begin
2598		while not qryView.Eof do
2599		begin
2600		SList.Add(Format('%s/* View: %s, Owner: %s */%s',
2601	<	[NEWLINE, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2602	<	qryView.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
2601	>	[LineEnding, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2602	>	qryView.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
2603
2604		SList.Add(Format('CREATE VIEW %s (', [QuoteIdentifier(FDatabase.SQLDialect,
2605		qryView.FieldByName('RDB$RELATION_NAME').AsString)]));
#	Line 2319 | Line 2616 | begin
2616		SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + ', ';
2617		end;
2618		qryColumns.Close;
2619	<	SList.Text := SList.Text + Format(') AS%s', [NEWLINE]);
2619	>	SList.Text := SList.Text + Format(') AS%s', [LineEnding]);
2620		if not qryView.FieldByName('RDB$VIEW_SOURCE').IsNull then
2621		SList.Text := SList.Text + qryView.FieldByName('RDB$VIEW_SOURCE').AsString;
2622	<	SList.Text := SList.Text + Format('%s%s', [Term, NEWLINE]);
2622	>	SList.Text := SList.Text + Format('%s%s', [Term, LineEnding]);
2623		FMetaData.AddStrings(SList);
2624		SList.Clear;
2625		qryView.Next;
#	Line 2351 | Line 2648 | begin
2648		Used := true;
2649		end
2650		else
2651	<	Result := Format(', %s      ', [NEWLINE]);
2651	>	Result := Format(', %s      ', [LineEnding]);
2652		end;
2653
2654		{
#	Line 2396 | Line 2693 | end;
2693
2694		procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2695		begin
2696	<	if FDatabase <> Value then
2696	>	if (csLoading in ComponentState) or (FDatabase <> Value) then
2697		begin
2698		FDatabase := Value;
2699		if (not Assigned(FTransaction)) and (FDatabase <> nil) then
#	Line 2428 | Line 2725 | begin
2725		end;
2726		FMetaData.Clear;
2727		case ObjectType of
2728	<	eoDatabase : ExtractDDL(true, '');
2728	>	eoDatabase : ExtractDDL(true, '', etData in ExtractTypes);
2729		eoDomain :
2730		if etTable in ExtractTypes then
2731		ListDomains(ObjectName, etTable)
#	Line 2448 | Line 2745 | begin
2745		if etCheck in ExtractTypes then
2746		ListCheck(ObjectName, etTable);
2747		if etTrigger in ExtractTypes then
2748	<	ListTriggers(ObjectName, etTable);
2748	>	begin
2749	>	if etGrant in ExtractTypes then
2750	>	ListTriggers(ObjectName, [etTable,etGrant])
2751	>	else
2752	>	ListTriggers(ObjectName, [etTable]);
2753	>	end;
2754		if etGrant in ExtractTypes then
2755		ShowGrants(ObjectName, Term);
2756		if etData in ExtractTypes then
#	Line 2457 | Line 2759 | begin
2759		else
2760		ListAllTables(true);
2761		end;
2762	<	eoView : ListViews(ObjectName);
2763	<	eoProcedure : ListProcs(ObjectName);
2762	>	eoView :
2763	>	begin
2764	>	ListViews(ObjectName);
2765	>	if ObjectName <> '' then
2766	>	begin
2767	>	if etTrigger in ExtractTypes then
2768	>	begin
2769	>	if etGrant in ExtractTypes then
2770	>	ListTriggers(ObjectName, [etTable,etGrant])
2771	>	else
2772	>	ListTriggers(ObjectName, [etTable]);
2773	>	end;
2774	>	if etGrant in ExtractTypes then
2775	>	ShowGrants(ObjectName, Term);
2776	>	end;
2777	>	end;
2778	>	eoProcedure :
2779	>	begin
2780	>	ListProcs(pdCreateProc,ObjectName,etGrant in ExtractTypes);
2781	>	if (ObjectName <> '' ) and (etGrant in ExtractTypes) then
2782	>	ShowGrants(ObjectName, Term);
2783	>	end;
2784		eoFunction : ListFunctions(ObjectName);
2785	<	eoGenerator : ListGenerators(ObjectName);
2785	>	eoGenerator : ListGenerators(ObjectName,ExtractTypes);
2786		eoException : ListException(ObjectName);
2787		eoBLOBFilter : ListFilters(ObjectName);
2788		eoRole : ListRoles(ObjectName);
2789		eoTrigger :
2790		if etTable in ExtractTypes then
2791	<	ListTriggers(ObjectName, etTable)
2791	>	begin
2792	>	if etGrant in ExtractTypes then
2793	>	ListTriggers(ObjectName, [etTable,etGrant])
2794	>	else
2795	>	ListTriggers(ObjectName, [etTable])
2796	>	end
2797	>	else
2798	>	if etGrant in ExtractTypes then
2799	>	ListTriggers(ObjectName,[etTrigger,etGrant])
2800		else
2801		ListTriggers(ObjectName);
2802		eoForeign :
#	Line 2553 | Line 2883 | end;
2883		It must extract granted privileges on tables/views to users,
2884		- these may be compound, so put them on the same line.
2885		Grant execute privilege on procedures to users
2886	<	Grant various privilegs to procedures.
2886	>	Grant various privileges to procedures.
2887		All privileges may have the with_grant option set. }
2888
2889	<	procedure TIBExtract.ShowGrants(MetaObject, Terminator: String);
2889	>	procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String);
2890		const
2891	<	{ This query only finds tables, eliminating owner privileges }
2892	<	OwnerPrivSQL =
2893	<	'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2894	<	'       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE ' +
2895	<	'FROM RDB$USER_PRIVILEGES PRV, RDB$RELATIONS REL ' +
2896	<	'WHERE ' +
2897	<	'  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2898	<	'  REL.RDB$RELATION_NAME = :METAOBJECT AND ' +
2899	<	'  PRV.RDB$PRIVILEGE <> ''M'' AND ' +
2900	<	'  REL.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2901	<	'ORDER BY  PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2902	<
2903	<	ProcPrivSQL =
2904	<	'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2905	<	'       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE, PRV.RDB$RELATION_NAME ' +
2906	<	'FROM RDB$USER_PRIVILEGES PRV, RDB$PROCEDURES PRC ' +
2907	<	'where ' +
2908	<	'  PRV.RDB$OBJECT_TYPE = 5 AND ' +
2909	<	'  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2910	<	'  PRC.RDB$PROCEDURE_NAME = :METAOBJECT AND ' +
2911	<	'  PRV.RDB$PRIVILEGE = ''X'' AND ' +
2912	<	'  PRC.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2913	<	'ORDER BY PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2914	<
2915	<	RolePrivSQL =
2916	<	'SELECT * FROM RDB$USER_PRIVILEGES ' +
2917	<	'WHERE ' +
2918	<	'  RDB$OBJECT_TYPE = 13 AND ' +
2919	<	'  RDB$USER_TYPE = 8  AND ' +
2920	<	'  RDB$RELATION_NAME = :METAOBJECT AND ' +
2921	<	'  RDB$PRIVILEGE = ''M'' ' +
2922	<	'ORDER BY RDB$USER';
2891	>	GrantsBaseSelect =
2892	>	'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
2893	>	'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
2894	>	'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
2895	>	'case  RDB$OBJECT_TYPE '+
2896	>	'When 0 then ''TABLE'' '+
2897	>	'When 5 then ''PROCEDURE'' '+
2898	>	'When 7 then ''EXCEPTION'' '+
2899	>	'When 11 then ''CHARACTER SET'' '+
2900	>	'When 14 then ''GENERATOR'' '+
2901	>	'ELSE NULL END as OBJECT_TYPE_NAME, '+
2902	>	'case RDB$USER_TYPE '+
2903	>	'When 5 then ''PROCEDURE'' '+
2904	>	'When 2 then ''TRIGGER'' '+
2905	>	'When 8 then ''USER'' '+
2906	>	'When 13 then ''ROLE'' '+
2907	>	'ELSE NULL END as USER_TYPE_NAME, '+
2908	>	'case '+
2909	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
2910	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
2911	>	'ELSE '''' End as GRANTOPTION '+
2912	>	'From (  '+
2913	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
2914	>	'When ''X'' then ''EXECUTE''  '+
2915	>	'When ''S'' then ''SELECT''  '+
2916	>	'When ''U'' then ''UPDATE''   '+
2917	>	'When ''D'' then ''DELETE''  '+
2918	>	'When ''R'' then ''REFERENCES''  '+
2919	>	'When ''G'' then ''USAGE''  '+
2920	>	'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
2921	>	'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE,OW.RDB$OWNER_NAME  '+
2922	>	'FROM RDB$USER_PRIVILEGES PR  '+
2923	>	'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
2924	>	'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
2925	>	'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  '+
2926	>	'UNION  '+
2927	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
2928	>	'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE, OW.RDB$OWNER_NAME   '+
2929	>	'FROM RDB$USER_PRIVILEGES PR  '+
2930	>	'JOIN ObjectOwners OW On OW.METAOBJECTNAME = PR.RDB$RELATION_NAME and OW.ObjectType = PR.RDB$OBJECT_TYPE '+
2931	>	'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
2932	>	'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)  '+
2933	>	'Where METAOBJECTNAME = :METAOBJECTNAME and RDB$USER <> RDB$OWNER_NAME  '+
2934	>	'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE,METAOBJECTNAME '+
2935	>	'ORDER BY RDB$USER, RDB$OBJECT_TYPE';
2936	>
2937	>	GrantsSQL12 =
2938	>	'with ObjectOwners As ( '+
2939	>	'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
2940	>	'From RDB$RELATIONS '+
2941	>	'UNION '+
2942	>	'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
2943	>	'From RDB$PROCEDURES '+
2944	>	'UNION '+
2945	>	'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 7 as ObjectType '+
2946	>	'From RDB$EXCEPTIONS '+
2947	>	'UNION '+
2948	>	'Select RDB$GENERATOR_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 14 as ObjectType '+
2949	>	'From RDB$GENERATORS '+
2950	>	'UNION '+
2951	>	'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 11 as ObjectType '+
2952	>	'From RDB$CHARACTER_SETS '+
2953	>	') '+ GrantsBaseSelect;
2954	>
2955	>	GrantsSQL =
2956	>	'with ObjectOwners As ( '+
2957	>	'Select RDB$RELATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 0 as ObjectType '+
2958	>	'From RDB$RELATIONS '+
2959	>	'UNION '+
2960	>	'Select RDB$PROCEDURE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 5 as ObjectType '+
2961	>	'From RDB$PROCEDURES '+
2962	>	'UNION '+
2963	>	'Select RDB$EXCEPTION_NAME as METAOBJECTNAME, ''SYSDBA'', 7 as ObjectType '+
2964	>	'From RDB$EXCEPTIONS '+
2965	>	'UNION '+
2966	>	'Select RDB$GENERATOR_NAME as METAOBJECTNAME, ''SYSDBA'', 14 as ObjectType '+
2967	>	'From RDB$GENERATORS '+
2968	>	'UNION '+
2969	>	'Select RDB$CHARACTER_SET_NAME as METAOBJECTNAME, ''SYSDBA'', 11 as ObjectType '+
2970	>	'From RDB$CHARACTER_SETS '+
2971	>	') '+ GrantsBaseSelect;
2972
2973	<	var
2595	<	PrevUser, PrevField,  WithOption,
2596	<	PrivString, ColString, UserString,
2597	<	FieldName, User : String;
2598	<	c : Char;
2599	<	PrevOption, PrivFlags, GrantOption : Integer;
2600	<	First, PrevFieldNull : Boolean;
2601	<	qryOwnerPriv : TIBSQL;
2602	<
2603	<	{  Given a bit-vector of privileges, turn it into a
2604	<	string list. }
2605	<	function MakePrivString(cflags : Integer) : String;
2606	<	var
2607	<	i : Integer;
2608	<	begin
2609	<	for i := Low(PrivTypes) to High(PrivTypes) do
2610	<	begin
2611	<	if (cflags and PrivTypes[i].PrivFlag) <> 0 then
2612	<	begin
2613	<	if Result <> '' then
2614	<	Result := Result + ', ';
2615	<	Result := Result + PrivTypes[i].PrivString;
2616	<	end; //end_if
2617	<	end; //end_for
2618	<	end; //end_fcn MakePrivDtring
2973	>	var qryOwnerPriv : TIBSQL;
2974
2975		begin
2976		if MetaObject = '' then
2977		exit;
2978
2624	–	First := true;
2625	–	PrevOption := -1;
2626	–	PrevUser := '';
2627	–	PrivString := '';
2628	–	ColString := '';
2629	–	WithOption := '';
2630	–	PrivFlags := 0;
2631	–	PrevFieldNull := false;
2632	–	PrevField := '';
2633	–
2979		qryOwnerPriv := TIBSQL.Create(FDatabase);
2980		try
2981	<	qryOwnerPriv.SQL.Text := OwnerPrivSQL;
2982	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2981	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
2982	>	qryOwnerPriv.SQL.Text := GrantsSQL12
2983	>	else
2984	>	qryOwnerPriv.SQL.Text := GrantsSQL;
2985	>	qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
2986		qryOwnerPriv.ExecQuery;
2987		while not qryOwnerPriv.Eof do
2988		begin
2989	<	{ Sometimes grant options are null, sometimes 0.  Both same }
2990	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').IsNull then
2991	<	GrantOption := 0
2992	<	else
2993	<	GrantOption := qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger;
2994	<
2995	<	if qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull then
2996	<	FieldName := ''
2649	<	else
2650	<	FieldName := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').AsString;
2651	<
2652	<	User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2653	<	{ Print a new grant statement for each new user or change of option }
2654	<
2655	<	if ((PrevUser <> '') and (PrevUser <> User)) or
2656	<	((Not First) and
2657	<	(PrevFieldNull <> qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull)) or
2658	<	((not PrevFieldNull) and (PrevField <> FieldName)) or
2659	<	((PrevOption <> -1) and (PrevOption <> GrantOption)) then
2660	<	begin
2661	<	PrivString := MakePrivString(PrivFlags);
2662	<
2663	<	First := false;
2664	<	FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2665	<	ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2666	<	UserString, WithOption, Terminator]));
2667	<	{ re-initialize strings }
2668	<
2669	<	PrivString := '';
2670	<	WithOption := '';
2671	<	ColString := '';
2672	<	PrivFlags := 0;
2673	<	end; //end_if
2674	<
2675	<	PrevUser := User;
2676	<	PrevOption := GrantOption;
2677	<	PrevFieldNull := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull;
2678	<	PrevField := FieldName;
2679	<
2680	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2681	<	obj_relation,
2682	<	obj_view,
2683	<	obj_trigger,
2684	<	obj_procedure,
2685	<	obj_sql_role:
2686	<	UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2687	<	else
2688	<	UserString := User;
2689	<	end; //end_case
2690	<
2691	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2692	<	obj_view :
2693	<	UserString := 'VIEW ' + UserString;
2694	<	obj_trigger :
2695	<	UserString := 'TRIGGER '+ UserString;
2696	<	obj_procedure :
2697	<	UserString := 'PROCEDURE ' + UserString;
2698	<	end; //end_case
2699	<
2700	<	c := qryOwnerPriv.FieldByName('RDB$PRIVILEGE').AsString[1];
2701	<
2702	<	case c of
2703	<	'S' : PrivFlags := PrivFlags or priv_SELECT;
2704	<	'I' : PrivFlags := PrivFlags or priv_INSERT;
2705	<	'U' : PrivFlags := PrivFlags or priv_UPDATE;
2706	<	'D' : PrivFlags := PrivFlags or priv_DELETE;
2707	<	'R' : PrivFlags := PrivFlags or priv_REFERENCES;
2708	<	'X' : ;
2709	<	{ Execute should not be here -- special handling below }
2710	<	else
2711	<	PrivFlags := PrivFlags or priv_UNKNOWN;
2712	<	end; //end_switch
2713	<
2714	<	{ Column level privileges for update only }
2715	<
2716	<	if FieldName = '' then
2717	<	ColString := ''
2718	<	else
2719	<	ColString := Format(' (%s)', [QuoteIdentifier(FDatabase.SQLDialect, FieldName)]);
2720	<
2721	<	if GrantOption <> 0 then
2722	<	WithOption := ' WITH GRANT OPTION';
2723	<
2989	>	FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
2990	>	qryOwnerPriv.FieldByName('Privileges').AsString,
2991	>	qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
2992	>	qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
2993	>	qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
2994	>	qryOwnerPriv.FieldByName('RDB$USER').AsString,
2995	>	qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
2996	>	Terminator]));
2997		qryOwnerPriv.Next;
2998		end;
2726	–	{ Print last case if there was anything to print }
2727	–	if PrevOption <> -1 then
2728	–	begin
2729	–	PrivString := MakePrivString(PrivFlags);
2730	–	First := false;
2731	–	FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2732	–	ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2733	–	UserString, WithOption, Terminator]));
2734	–	{ re-initialize strings }
2735	–	end; //end_if
2999		qryOwnerPriv.Close;
3000	+	finally
3001	+	qryOwnerPriv.Free;
3002	+	end;
3003	+	end;
3004
3005	<	if First then
3006	<	begin
3007	<	{ Part two is for stored procedures only }
3008	<	qryOwnerPriv.SQL.Text := ProcPrivSQL;
3009	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3010	<	qryOwnerPriv.ExecQuery;
3011	<	while not qryOwnerPriv.Eof do
3012	<	begin
3013	<	First := false;
3014	<	User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
3015	<
3016	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
3017	<	obj_relation,
3018	<	obj_view,
3019	<	obj_trigger,
3020	<	obj_procedure,
3021	<	obj_sql_role:
3022	<	UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
3023	<	else
3024	<	UserString := User;
3025	<	end; //end_case
3026	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
3027	<	obj_view :
3028	<	UserString := 'VIEW ' + UserString;
3029	<	obj_trigger :
3030	<	UserString := 'TRIGGER '+ UserString;
3031	<	obj_procedure :
3032	<	UserString := 'PROCEDURE ' + UserString;
3033	<	end; //end_case
3005	>	procedure TIBExtract.ShowGrantsTo(MetaObject: String; ObjectType: integer; Terminator: String);
3006	>	const
3007	>	GrantsSQL =
3008	>	'Select Trim(RDB$USER) as RDB$USER,List("Privileges") as Privileges, '+
3009	>	'coalesce(RDB$GRANT_OPTION,0) as RDB$GRANT_OPTION,METAOBJECTNAME, '+
3010	>	'RDB$USER_TYPE, RDB$OBJECT_TYPE, '+
3011	>	'case  RDB$OBJECT_TYPE '+
3012	>	'When 0 then ''TABLE'' '+
3013	>	'When 5 then ''PROCEDURE'' '+
3014	>	'When 7 then ''EXCEPTION'' '+
3015	>	'When 11 then ''CHARACTER SET'' '+
3016	>	'ELSE NULL END as OBJECT_TYPE_NAME, '+
3017	>	'case RDB$USER_TYPE '+
3018	>	'When 5 then ''PROCEDURE'' '+
3019	>	'When 2 then ''TRIGGER'' '+
3020	>	'When 8 then ''USER'' '+
3021	>	'When 13 then ''ROLE'' '+
3022	>	'ELSE NULL END as USER_TYPE_NAME, '+
3023	>	'case '+
3024	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE = 13 then '' WITH ADMIN OPTION'' '+
3025	>	'When coalesce(RDB$GRANT_OPTION,0) <> 0 and RDB$USER_TYPE <> 13 then '' WITH GRANT OPTION'' '+
3026	>	'ELSE '''' End as GRANTOPTION '+
3027	>	'From (  '+
3028	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME as METAOBJECTNAME, LIST(DISTINCT Trim(Case PR.RDB$PRIVILEGE  '+
3029	>	'When ''X'' then ''EXECUTE''  '+
3030	>	'When ''S'' then ''SELECT''  '+
3031	>	'When ''U'' then ''UPDATE''   '+
3032	>	'When ''D'' then ''DELETE''  '+
3033	>	'When ''R'' then ''REFERENCES''  '+
3034	>	'When ''G'' then ''USAGE''  '+
3035	>	'When ''I'' then ''INSERT'' end )) as "Privileges",  '+
3036	>	'PR.RDB$GRANT_OPTION,  PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
3037	>	'FROM RDB$USER_PRIVILEGES PR  '+
3038	>	'Where PR.RDB$PRIVILEGE <> ''M'' and (PR.RDB$PRIVILEGE <> ''U'' or PR.RDB$FIELD_NAME is null)  '+
3039	>	'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE  '+
3040	>	'UNION  '+
3041	>	'Select PR.RDB$USER,PR.RDB$RELATION_NAME, ''Update('' || List(Trim(PR.RDB$FIELD_NAME)) || '')'',  '+
3042	>	'PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE   '+
3043	>	'FROM RDB$USER_PRIVILEGES PR  '+
3044	>	'Where PR.RDB$PRIVILEGE = ''U'' and PR.RDB$FIELD_NAME is not null   '+
3045	>	'Group By PR.RDB$USER,PR.RDB$RELATION_NAME,PR.RDB$GRANT_OPTION, PR.RDB$USER_TYPE, PR.RDB$OBJECT_TYPE)  '+
3046	>	'Where RDB$USER = :METAOBJECTNAME and RDB$USER_TYPE = :USERTYPE '+
3047	>	'Group By RDB$USER,RDB$GRANT_OPTION,  RDB$USER_TYPE, RDB$OBJECT_TYPE, METAOBJECTNAME '+
3048	>	'ORDER BY METAOBJECTNAME';
3049
3050	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2769	<	WithOption := ' WITH GRANT OPTION'
2770	<	else
2771	<	WithOption := '';
3050	>	var qryOwnerPriv : TIBSQL;
3051
3052	<	FMetaData.Add(Format('GRANT EXECUTE ON PROCEDURE %s TO %s%s%s',
3053	<	[QuoteIdentifier(FDatabase.SQLDialect, MetaObject), UserString,
3054	<	WithOption, terminator]));
3052	>	begin
3053	>	if MetaObject = '' then
3054	>	exit;
3055
3056	<	qryOwnerPriv.Next;
3057	<	end;
3058	<	qryOwnerPriv.Close;
3059	<	end;
3060	<	if First then
3056	>	qryOwnerPriv := TIBSQL.Create(FDatabase);
3057	>	try
3058	>	qryOwnerPriv.SQL.Text := GrantsSQL;
3059	>	qryOwnerPriv.Params.ByName('METAOBJECTNAME').AsString := MetaObject;
3060	>	qryOwnerPriv.Params.ByName('USERTYPE').AsInteger := ObjectType;
3061	>	qryOwnerPriv.ExecQuery;
3062	>	while not qryOwnerPriv.Eof do
3063		begin
3064	<	qryOwnerPriv.SQL.Text := RolePrivSQL;
3065	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
3066	<	qryOwnerPriv.ExecQuery;
3067	<	while not qryOwnerPriv.Eof do
3068	<	begin
3069	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
3070	<	WithOption := ' WITH ADMIN OPTION'
3071	<	else
3072	<	WithOption := '';
2792	<
2793	<	FMetaData.Add(Format('GRANT %s TO %s%s%s',
2794	<	[QuoteIdentifier(FDatabase.SQLDialect, qryOwnerPriv.FieldByName('RDB$RELATION_NAME').AsString),
2795	<	qryOwnerPriv.FieldByName('RDB$USER_NAME').AsString,
2796	<	WithOption, terminator]));
2797	<
2798	<	qryOwnerPriv.Next;
2799	<	end;
3064	>	FMetaData.Add(Format('GRANT %s ON %s "%s" TO %s "%s" %s%s', [
3065	>	qryOwnerPriv.FieldByName('Privileges').AsString,
3066	>	qryOwnerPriv.FieldByName('OBJECT_TYPE_NAME').AsString,
3067	>	qryOwnerPriv.FieldByName('METAOBJECTNAME').AsString,
3068	>	qryOwnerPriv.FieldByName('USER_TYPE_NAME').AsString,
3069	>	qryOwnerPriv.FieldByName('RDB$USER').AsString,
3070	>	qryOwnerPriv.FieldByName('GRANTOPTION').AsString,
3071	>	Terminator]));
3072	>	qryOwnerPriv.Next;
3073		end;
3074		qryOwnerPriv.Close;
3075		finally
3076		qryOwnerPriv.Free;
3077		end;
3078	+	FMetaData.Add('');
3079		end;
3080
3081		{         ShowGrantRoles
#	Line 2841 | Line 3115 | begin
3115		WithOption := '';
3116		FMetaData.Add(Format('GRANT %s TO %s%s%s%s',
3117		[ QuoteIdentifier(FDatabase.SQLDialect, qryRole.FieldByName('RDB$RELATION_NAME').AsString),
3118	<	UserString, WithOption, Terminator, NEWLINE]));
3118	>	UserString, WithOption, Terminator, LineEnding]));
3119
3120		qryRole.Next;
3121		end;
#	Line 2921 | Line 3195 | var
3195		end;
3196		break;
3197		end;
3198	<	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
3199	<	(not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
3200	<	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3198	>	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) then
3199	>	begin
3200	>	if not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
3201	>	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$CHARACTER_LENGTH').AsInteger])
3202	>	else
3203	>	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
3204	>	end;
3205
3206		{ Show international character sets and collations }
3207
#	Line 2984 | Line 3262 | begin
3262		if FirstTime then
3263		begin
3264		FirstTime := false;
3265	<	FMetaData.Add('RETURNS' + NEWLINE + '(');
3265	>	FMetaData.Add('RETURNS' + LineEnding + '(');
3266		end;
3267
3268		Line := FormatParamStr;
#	Line 3019 | Line 3297 | end;
3297
3298		procedure TIBExtract.ListData(ObjectName: String);
3299		const
3300	<	SelectSQL = 'SELECT * FROM %s';
3301	<	var
3302	<	qrySelect : TIBSQL;
3303	<	Line : String;
3304	<	i : Integer;
3300	>	SelectFieldListSQL = 'Select List(RDB$FIELD_NAME) From ( '+
3301	>	'Select RF.RDB$FIELD_NAME From RDB$RELATION_FIELDS RF '+
3302	>	'JOIN RDB$FIELDS F On F.RDB$FIELD_NAME = RF.RDB$FIELD_SOURCE '+
3303	>	'Where F.RDB$COMPUTED_BLR is NULL and RF.RDB$RELATION_NAME = Upper(:Relation) '+
3304	>	'Order by RF.RDB$FIELD_POSITION asc)';
3305	>
3306	>	TableSQL =
3307	>	'SELECT * FROM RDB$RELATIONS ' +
3308	>	'WHERE ' +
3309	>	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
3310	>	'  RDB$VIEW_BLR IS NULL ' +
3311	>	'ORDER BY RDB$RELATION_NAME';
3312	>
3313	>	var FieldList: string;
3314	>
3315		begin
3316	<	qrySelect := TIBSQL.Create(FDatabase);
3317	<	try
3318	<	qrySelect.SQL.Text := Format(SelectSQL,
3319	<	[QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]);
3320	<	qrySelect.ExecQuery;
3321	<	while not qrySelect.Eof do
3322	<	begin
3323	<	Line := 'INSERT INTO ' + QuoteIdentifier(FDatabase.SQLDialect, ObjectName) + ' (';
3324	<	for i := 0 to qrySelect.Current.Count - 1 do
3037	<	if (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3038	<	(qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3039	<	begin
3040	<	Line := Line + QuoteIdentifier(FDatabase.SQLDialect, qrySelect.Fields[i].Name);
3041	<	if i <> (qrySelect.Current.Count - 1) then
3042	<	Line := Line + ', ';
3043	<	end;
3044	<	Line := Line + ') VALUES (';
3045	<	for i := 0 to qrySelect.Current.Count - 1 do
3316	>	if ObjectName = '' then {List all}
3317	>	begin
3318	>	with TIBSQL.Create(self) do
3319	>	try
3320	>	Database := FDatabase;
3321	>	SQL.Text := TableSQL;
3322	>	ExecQuery;
3323	>	FMetaData.Add('/* Data Starts */');
3324	>	while not EOF do
3325		begin
3326	<	if qrySelect.Fields[i].IsNull and
3327	<	(qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3049	<	(qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3050	<	begin
3051	<	Line := Line + 'NULL';
3052	<	if i <> (qrySelect.Current.Count - 1) then
3053	<	Line := Line + ', ';
3054	<	end
3055	<	else
3056	<	case qrySelect.Fields[i].SQLType of
3057	<	SQL_TEXT, SQL_VARYING, SQL_TYPE_DATE,
3058	<	SQL_TYPE_TIME, SQL_TIMESTAMP :
3059	<	begin
3060	<	Line := Line + QuotedStr(qrySelect.Fields[i].AsString);
3061	<	if i <> (qrySelect.Current.Count - 1) then
3062	<	Line := Line + ', ';
3063	<	end;
3064	<	SQL_SHORT, SQL_LONG, SQL_INT64,
3065	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN:
3066	<	begin
3067	<	Line := Line + qrySelect.Fields[i].AsString;
3068	<	if i <> (qrySelect.Current.Count - 1) then
3069	<	Line := Line + ', ';
3070	<	end;
3071	<	SQL_ARRAY, SQL_BLOB : ;
3072	<	else
3073	<	IBError(ibxeInvalidDataConversion, [nil]);
3074	<	end;
3326	>	ListData(Trim(FieldByName('RDB$RELATION_NAME').AsString));
3327	>	Next;
3328		end;
3329	<	Line := Line + ')' + Term;
3330	<	FMetaData.Add(Line);
3331	<	qrySelect.Next;
3329	>	FMetaData.Add('/* Data Ends */');
3330	>	finally
3331	>	Free;
3332	>	end;
3333	>	end
3334	>	else
3335	>	begin
3336	>	FieldList := '*';
3337	>	with TIBSQL.Create(self) do
3338	>	try
3339	>	Database := FDatabase;
3340	>	SQL.Text := SelectFieldListSQL;
3341	>	Params[0].AsString := ObjectName;
3342	>	ExecQuery;
3343	>	try
3344	>	if not EOF then
3345	>	FieldList := Fields[0].AsString;
3346	>	finally
3347	>	Close;
3348	>	end;
3349	>	finally
3350	>	Free
3351	>	end;
3352	>
3353	>	with TIBInsertStmtsOut.Create(self) do
3354	>	try
3355	>	Database := FDatabase;
3356	>	if DataOut(Format('Select %s From %s',[FieldList,QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]),
3357	>	Add2MetaData) then
3358	>	FMetaData.Add('COMMIT;');
3359	>	finally
3360	>	Free
3361		end;
3080	–	finally
3081	–	qrySelect.Free;
3362		end;
3363		end;
3364
3365		procedure TIBExtract.ListRoles(ObjectName: String);
3366		const
3367		RolesSQL =
3368	<	'select * from RDB$ROLES ' +
3368	>	'select * from RDB$ROLES WHERE RDB$SYSTEM_FLAG = 0 ' +
3369		'order by RDB$ROLE_NAME';
3370
3371		RolesByNameSQL =

Diff Legend

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