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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

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

Diff Legend

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