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 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

#	Line 1 | Line 1
1	<	{************************************************************************}
2	<	{                                                                        }
3	<	{    The contents of this file are subject to the InterBase              }
4	<	{    Public License Version 1.0 (the "License"); you may not             }
5	<	{    use this file except in compliance with the License. You            }
6	<	{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
7	<	{    Software distributed under the License is distributed on            }
8	<	{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
9	<	{    express or implied. See the License for the specific language       }
10	<	{    governing rights and limitations under the License.                 }
11	<	{                                                                        }
12	<	{    The Original Code was created by Jeff Overcash.                     }
13	<	{    Portions based upon code by Inprise Corporation are Copyright (C)   }
14	<	{       Inprise Corporation. All Rights Reserved.                        }
15	<	{                                                                        }
16	<	{    IBX Version 4.2 or higher required                                  }
17	<	{    Contributor(s): Jeff Overcash                                       }
18	<	{                                                                        }
19	<	{    IBX For Lazarus (Firebird Express)                                  }
20	<	{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
21	<	{    Portions created by MWA Software are copyright McCallum Whyman      }
22	<	{    Associates Ltd 2011                                                 }
23	<	{                                                                        }
24	<	{************************************************************************}
25	<
26	<	unit IBExtract;
27	<
28	<	{$Mode Delphi}
29	<
30	<	interface
31	<
32	<	uses
33	<	{$IFDEF WINDOWS }
34	<	Windows,
35	<	{$ELSE}
36	<	unix,
37	<	{$ENDIF}
38	<	SysUtils, Classes, IBDatabase, IBDatabaseInfo,
39	<	IBSQL, IBUtils, IBHeader, IB, IBIntf;
40	<
41	<	type
42	<	TExtractObjectTypes =
43	<	(eoDatabase, eoDomain, eoTable, eoView, eoProcedure, eoFunction,
44	<	eoGenerator, eoException, eoBLOBFilter, eoRole, eoTrigger, eoForeign,
45	<	eoIndexes, eoChecks, eoData);
46	<
47	<	TExtractType =
48	<	(etDomain, etTable, etRole, etTrigger, etForeign,
49	<	etIndex, etData, etGrant, etCheck);
50	<
51	<	TExtractTypes = Set of TExtractType;
52	<
53	<	TIBExtract = class(TComponent)
54	<	private
55	<	FDatabase : TIBDatabase;
56	<	FTransaction : TIBTransaction;
57	<	FMetaData: TStrings;
58	<	FDatabaseInfo: TIBDatabaseInfo;
59	<	FShowSystem: Boolean;
60	<	{ Private declarations }
61	<	function GetDatabase: TIBDatabase;
62	<	function GetIndexSegments ( indexname : String) : String;
63	<	function GetTransaction: TIBTransaction;
64	<	procedure SetDatabase(const Value: TIBDatabase);
65	<	procedure SetTransaction(const Value: TIBTransaction);
66	<	function PrintValidation(ToValidate : String;       flag : Boolean) : String;
67	<	procedure ShowGrants(MetaObject: String; Terminator : String);
68	<	procedure ShowGrantRoles(Terminator : String);
69	<	procedure GetProcedureArgs(Proc : String);
70	<	protected
71	<	function ExtractDDL(Flag : Boolean; TableName : String) : Boolean;
72	<	function ExtractListTable(RelationName, NewName : String; DomainFlag : Boolean) : Boolean;
73	<	procedure ExtractListView (ViewName : String);
74	<	procedure ListData(ObjectName : String);
75	<	procedure ListRoles(ObjectName : String = '');
76	<	procedure ListGrants;
77	<	procedure ListProcs(ProcedureName : String = '');
78	<	procedure ListAllTables(flag : Boolean);
79	<	procedure ListTriggers(ObjectName : String = ''; ExtractType : TExtractType = etTrigger);
80	<	procedure ListCheck(ObjectName : String = ''; ExtractType : TExtractType = etCheck);
81	<	function PrintSet(var Used : Boolean) : String;
82	<	procedure ListCreateDb(TargetDb : String = '');
83	<	procedure ListDomains(ObjectName : String = ''; ExtractType : TExtractType = etDomain);
84	<	procedure ListException(ExceptionName : String = '');
85	<	procedure ListFilters(FilterName : String = '');
86	<	procedure ListForeign(ObjectName : String = ''; ExtractType : TExtractType = etForeign);
87	<	procedure ListFunctions(FunctionName : String = '');
88	<	procedure ListGenerators(GeneratorName : String = '');
89	<	procedure ListIndex(ObjectName : String = ''; ExtractType : TExtractType = etIndex);
90	<	procedure ListViews(ViewName : String = '');
91	<
92	<	{ Protected declarations }
93	<	public
94	<	{ Public declarations }
95	<	constructor Create(AOwner : TComponent); override;
96	<	destructor Destroy; override;
97	<	function GetArrayField(FieldName : String) : String;
98	<	function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
99	<	FieldPrec, FieldLen : Integer) : String;
100	<	function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
101	<	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
102	<	procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
103	<	ExtractTypes : TExtractTypes = []);
104	<	property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
105	<	property Items : TStrings read FMetaData;
106	<
107	<	published
108	<	{ Published declarations }
109	<	property Database : TIBDatabase read GetDatabase write SetDatabase;
110	<	property Transaction : TIBTransaction read GetTransaction write SetTransaction;
111	<	property ShowSystem: Boolean read FShowSystem write FShowSystem;
112	<	end;
113	<
114	<	TSQLType = record
115	<	SqlType : Integer;
116	<	TypeName : String;
117	<	end;
118	<
119	<	TPrivTypes = record
120	<	PrivFlag : Integer;
121	<	PrivString : String;
122	<	end;
123	<
124	<	TSQLTypes = Array[0..13] of TSQLType;
125	<
126	<	const
127	<
128	<	priv_UNKNOWN = 1;
129	<	priv_SELECT = 2;
130	<	priv_INSERT = 4;
131	<	priv_UPDATE = 8;
132	<	priv_DELETE = 16;
133	<	priv_EXECUTE = 32;
134	<	priv_REFERENCES = 64;
135	<
136	<	PrivTypes : Array[0..5] of TPrivTypes = (
137	<	(PrivFlag : priv_DELETE; PrivString : 'DELETE' ),
138	<	(PrivFlag : priv_EXECUTE; PrivString : 'EXECUTE' ),
139	<	(PrivFlag : priv_INSERT; PrivString : 'INSERT' ),
140	<	(PrivFlag : priv_SELECT; PrivString : 'SELECT' ),
141	<	(PrivFlag : priv_UPDATE; PrivString : 'UPDATE' ),
142	<	(PrivFlag : priv_REFERENCES; PrivString : 'REFERENCES'));
143	<
144	<	ColumnTypes : TSQLTypes = (
145	<	(SqlType : blr_short; TypeName :    'SMALLINT'),            { NTX: keyword }
146	<	(SqlType : blr_long; TypeName : 'INTEGER'),         { NTX: keyword }
147	<	(SqlType : blr_quad; TypeName : 'QUAD'),            { NTX: keyword }
148	<	(SqlType : blr_float; TypeName : 'FLOAT'),          { NTX: keyword }
149	<	(SqlType : blr_text; TypeName : 'CHAR'),            { NTX: keyword }
150	<	(SqlType : blr_double; TypeName : 'DOUBLE PRECISION'),      { NTX: keyword }
151	<	(SqlType : blr_varying; TypeName : 'VARCHAR'),              { NTX: keyword }
152	<	(SqlType : blr_cstring; TypeName : 'CSTRING'),              { NTX: keyword }
153	<	(SqlType : blr_blob_id; TypeName : 'BLOB_ID'),              { NTX: keyword }
154	<	(SqlType : blr_blob; TypeName : 'BLOB'),            { NTX: keyword }
155	<	(SqlType : blr_sql_time; TypeName : 'TIME'),                { NTX: keyword }
156	<	(SqlType : blr_sql_date; TypeName : 'DATE'),                { NTX: keyword }
157	<	(SqlType : blr_timestamp; TypeName : 'TIMESTAMP'),          { NTX: keyword }
158	<	(SqlType : blr_int64; TypeName : 'INT64'));
159	<
160	<	SubTypes : Array[0..8] of String = (
161	<	'UNKNOWN',                  { NTX: keyword }
162	<	'TEXT',                             { NTX: keyword }
163	<	'BLR',                              { NTX: keyword }
164	<	'ACL',                              { NTX: keyword }
165	<	'RANGES',                   { NTX: keyword }
166	<	'SUMMARY',                  { NTX: keyword }
167	<	'FORMAT',                   { NTX: keyword }
168	<	'TRANSACTION_DESCRIPTION',  { NTX: keyword }
169	<	'EXTERNAL_FILE_DESCRIPTION');       { NTX: keyword }
170	<
171	<	TriggerTypes : Array[0..6] of String = (
172	<	'',
173	<	'BEFORE INSERT',                    { NTX: keyword }
174	<	'AFTER INSERT',                             { NTX: keyword }
175	<	'BEFORE UPDATE',                    { NTX: keyword }
176	<	'AFTER UPDATE',                             { NTX: keyword }
177	<	'BEFORE DELETE',                    { NTX: keyword }
178	<	'AFTER DELETE');                    { NTX: keyword }
179	<
180	<	IntegralSubtypes : Array[0..2] of String = (
181	<	'UNKNOWN',                  { Defined type, NTX: keyword }
182	<	'NUMERIC',                  { NUMERIC, NTX: keyword }
183	<	'DECIMAL');                         { DECIMAL, NTX: keyword }
184	<
185	<	ODS_VERSION6 = 6;     { on-disk structure as of v3.0 }
186	<	ODS_VERSION7 = 7;     { new on disk structure for fixing index bug }
187	<	ODS_VERSION8 =        8;      { new btree structure to support pc semantics }
188	<	ODS_VERSION9 =        9;      { btree leaf pages are always propogated up }
189	<	ODS_VERSION10 = 10; { V6.0 features. SQL delimited idetifier,
190	<	SQLDATE, and 64-bit exact numeric
191	<	type }
192	<
193	<	{ flags for RDB$FILE_FLAGS }
194	<	FILE_shadow = 1;
195	<	FILE_inactive = 2;
196	<	FILE_manual = 4;
197	<	FILE_cache = 8;
198	<	FILE_conditional = 16;
199	<
200	<	{ flags for RDB$LOG_FILES }
201	<	LOG_serial = 1;
202	<	LOG_default = 2;
203	<	LOG_raw = 4;
204	<	LOG_overflow = 8;
205	<
206	<
207	<
208	<	MAX_INTSUBTYPES = 2;
209	<	MAXSUBTYPES = 8;     { Top of subtypes array }
210	<
211	<	{ Object types used in RDB$DEPENDENCIES and RDB$USER_PRIVILEGES }
212	<
213	<	obj_relation = 0;
214	<	obj_view = 1;
215	<	obj_trigger = 2;
216	<	obj_computed = 3;
217	<	obj_validation = 4;
218	<	obj_procedure = 5;
219	<	obj_expression_index = 6;
220	<	obj_exception = 7;
221	<	obj_user = 8;
222	<	obj_field = 9;
223	<	obj_index = 10;
224	<	obj_count = 11;
225	<	obj_user_group = 12;
226	<	obj_sql_role = 13;
227	<
228	<	implementation
229	<
230	<	const
231	<	NEWLINE = #13#10;
232	<	TERM = ';';
233	<	ProcTerm = '^';
234	<
235	<	CollationSQL =
236	<	'SELECT CST.RDB$CHARACTER_SET_NAME, COL.RDB$COLLATION_NAME, CST.RDB$DEFAULT_COLLATE_NAME ' +
237	<	'FROM RDB$COLLATIONS COL JOIN RDB$CHARACTER_SETS CST ON ' +
238	<	'  COL.RDB$CHARACTER_SET_ID = CST.RDB$CHARACTER_SET_ID ' +
239	<	'WHERE ' +
240	<	'  COL.RDB$COLLATION_ID = :COLLATION AND ' +
241	<	'  CST.RDB$CHARACTER_SET_ID = :CHAR_SET_ID ' +
242	<	'ORDER BY COL.RDB$COLLATION_NAME, CST.RDB$CHARACTER_SET_NAME';
243	<
244	<	NonCollationSQL =
245	<	'SELECT CST.RDB$CHARACTER_SET_NAME ' +
246	<	'FROM RDB$CHARACTER_SETS CST ' +
247	<	'WHERE CST.RDB$CHARACTER_SET_ID = :CHARSETID ' +
248	<	'ORDER BY CST.RDB$CHARACTER_SET_NAME';
249	<
250	<	PrecisionSQL =
251	<	'SELECT * FROM RDB$FIELDS ' +
252	<	'WHERE RDB$FIELD_NAME = :FIELDNAME';
253	<
254	<	ArraySQL =
255	<	'SELECT * FROM RDB$FIELD_DIMENSIONS FDIM ' +
256	<	'WHERE ' +
257	<	'  FDIM.RDB$FIELD_NAME = :FIELDNAME ' +
258	<	'ORDER BY FDIM.RDB$DIMENSION';
259	<
260	<	{ TIBExtract }
261	<
262	<	{                       ArrayDimensions
263	<	Functional description
264	<	Retrieves the dimensions of arrays and prints them.
265	<
266	<	Parameters:  fieldname -- the actual name of the array field }
267	<
268	<	function TIBExtract.GetArrayField(FieldName: String): String;
269	<	var
270	<	qryArray : TIBSQL;
271	<	begin
272	<	qryArray := TIBSQL.Create(FDatabase);
273	<	Result := '[';
274	<	qryArray.SQL.Add(ArraySQL);
275	<	qryArray.Params.ByName('FieldName').AsString := FieldName;
276	<	qryArray.ExecQuery;
277	<
278	<	{  Format is [lower:upper, lower:upper,..]  }
279	<
280	<	while not qryArray.Eof do
281	<	begin
282	<	if (qryArray.FieldByName('RDB$DIMENSION').AsInteger > 0) then
283	<	Result := Result + ', ';
284	<	Result := Result + qryArray.FieldByName('RDB$LOWER_BOUND').AsString + ':' +
285	<	qryArray.FieldByName('RDB$UPPER_BOUND').AsString;
286	<	qryArray.Next;
287	<	end;
288	<
289	<	Result := Result + '] ';
290	<	qryArray.Free;
291	<
292	<	end;
293	<
294	<	constructor TIBExtract.Create(AOwner: TComponent);
295	<	begin
296	<	inherited;
297	<	FMetaData := TStringList.Create;
298	<	FDatabaseInfo := TIBDatabaseInfo.Create(nil);
299	<	FDatabaseInfo.Database := FDatabase;
300	<	if AOwner is TIBDatabase then
301	<	Database := TIBDatabase(AOwner);
302	<	if AOwner is TIBTransaction then
303	<	Transaction := TIBTransaction(AOwner);
304	<	end;
305	<
306	<	destructor TIBExtract.Destroy;
307	<	begin
308	<	FMetaData.Free;
309	<	FDatabasEInfo.Free;
310	<	inherited;
311	<	end;
312	<
313	<	function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String) : Boolean;
314	<	var
315	<	DidConnect : Boolean;
316	<	DidStart : Boolean;
317	<	begin
318	<	Result := true;
319	<	DidConnect := false;
320	<	DidStart := false;
321	<
322	<	if not FDatabase.Connected then
323	<	begin
324	<	FDatabase.Connected := true;
325	<	didConnect := true;
326	<	end;
327	<
328	<	FMetaData.Add(Format('SET SQL DIALECT %d;', [FDatabase.SQLDialect]));
329	<	FMetaData.Add('');
330	<
331	<	if not FTransaction.Active then
332	<	begin
333	<	FTransaction.StartTransaction;
334	<	DidStart := true;
335	<	end;
336	<
337	<	if TableName <> '' then
338	<	begin
339	<	if not ExtractListTable(TableName, '', true) then
340	<	Result := false;
341	<	end
342	<	else
343	<	begin
344	<	ListCreateDb;
345	<	ListFilters;
346	<	ListFunctions;
347	<	ListDomains;
348	<	ListAllTables(flag);
349	<	ListIndex;
350	<	ListForeign;
351	<	ListGenerators;
352	<	ListViews;
353	<	ListCheck;
354	<	ListException;
355	<	ListProcs;
356	<	ListTriggers;
357	<	ListGrants;
358	<	end;
359	<
360	<	if DidStart then
361	<	FTransaction.Commit;
362	<
363	<	if DidConnect then
364	<	FDatabase.Connected := false;
365	<	end;
366	<
367	<	{                   ExtractListTable
368	<	Functional description
369	<	Shows columns, types, info for a given table name
370	<	and text of views.
371	<	If a new_name is passed, substitute it for relation_name
372	<
373	<	relation_name -- Name of table to investigate
374	<	new_name -- Name of a new name for a replacement table
375	<	domain_flag -- extract needed domains before the table }
376	<
377	<	function TIBExtract.ExtractListTable(RelationName, NewName: String;
378	<	DomainFlag: Boolean) : Boolean;
379	<	const
380	<	TableListSQL =
381	<	'SELECT * FROM RDB$RELATIONS REL JOIN RDB$RELATION_FIELDS RFR ON ' + {Do Not Localize}
382	<	'  RFR.RDB$RELATION_NAME = REL.RDB$RELATION_NAME JOIN RDB$FIELDS FLD ON ' +
383	<	'  RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +
384	<	'WHERE REL.RDB$RELATION_NAME = :RelationName ' +
385	<	'ORDER BY RFR.RDB$FIELD_POSITION, RFR.RDB$FIELD_NAME';
386	<
387	<	ConstraintSQL =
388	<	'SELECT RCO.RDB$CONSTRAINT_NAME, RDB$CONSTRAINT_TYPE, RDB$RELATION_NAME, ' +
389	<	'RDB$DEFERRABLE, RDB$INITIALLY_DEFERRED, RDB$INDEX_NAME, RDB$TRIGGER_NAME ' +
390	<	'FROM RDB$RELATION_CONSTRAINTS RCO, RDB$CHECK_CONSTRAINTS CON ' +
391	<	'WHERE ' +
392	<	'  CON.RDB$TRIGGER_NAME = :FIELDNAME AND ' +
393	<	'  CON.RDB$CONSTRAINT_NAME = RCO.RDB$CONSTRAINT_NAME AND ' +
394	<	'  RCO.RDB$CONSTRAINT_TYPE = ''NOT NULL'' AND ' +
395	<	'  RCO.RDB$RELATION_NAME = :RELATIONNAME';
396	<
397	<	RelConstraintsSQL =
398	<	'SELECT * FROM RDB$RELATION_CONSTRAINTS RELC ' +
399	<	'WHERE ' +
400	<	'  (RELC.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR ' +
401	<	'  RELC.RDB$CONSTRAINT_TYPE = ''UNIQUE'') AND ' +
402	<	'  RELC.RDB$RELATION_NAME = :RELATIONNAME ' +
403	<	'ORDER BY RELC.RDB$CONSTRAINT_NAME';
404	<
405	<	var
406	<	Collation, CharSetId : integer;
407	<	i : integer;
408	<	ColList, Column, Constraint : String;
409	<	SubType : integer;
410	<	IntChar : integer;
411	<	qryTables, qryPrecision, qryConstraints, qryRelConstraints : TIBSQL;
412	<	PrecisionKnown, ValidRelation : Boolean;
413	<	FieldScale, FieldType : Integer;
414	<	begin
415	<	Result := true;
416	<	ColList := '';
417	<	IntChar := 0;
418	<	ValidRelation := false;
419	<
420	<	if DomainFlag then
421	<	ListDomains(RelationName);
422	<	qryTables := TIBSQL.Create(FDatabase);
423	<	qryPrecision := TIBSQL.Create(FDatabase);
424	<	qryConstraints := TIBSQL.Create(FDatabase);
425	<	qryRelConstraints := TIBSQL.Create(FDatabase);
426	<	try
427	<	qryTables.SQL.Add(TableListSQL);
428	<	qryTables.Params.ByName('RelationName').AsString := RelationName;
429	<	qryTables.ExecQuery;
430	<	qryPrecision.SQL.Add(PrecisionSQL);
431	<	qryConstraints.SQL.Add(ConstraintSQL);
432	<	qryRelConstraints.SQL.Add(RelConstraintsSQL);
433	<	if not qryTables.Eof then
434	<	begin
435	<	ValidRelation := true;
436	<	if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and
437	<	(Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsString) <> '') then
438	<	FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',
439	<	[NEWLINE, RelationName,
440	<	qryTables.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
441	<	if NewName <> '' then
442	<	FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
443	<	else
444	<	FMetaData.Add(Format('CREATE TABLE %s ', [QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
445	<	if not qryTables.FieldByName('RDB$EXTERNAL_FILE').IsNull then
446	<	FMetaData.Add(Format('EXTERNAL FILE %s ',
447	<	[QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsString)]));
448	<	FMetaData.Add('(');
449	<	end;
450	<
451	<	while not qryTables.Eof do
452	<	begin
453	<	Column := '  ' + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME').AsString) + TAB;
454	<
455	<	{  Check first for computed fields, then domains.
456	<	If this is a known domain, then just print the domain rather than type
457	<	Domains won't have length, array, or blob definitions, but they
458	<	may have not null, default and check overriding their definitions }
459	<
460	<	if not qryTables.FieldByName('rdb$computed_blr').IsNull then
461	<	begin
462	<	Column := Column + ' COMPUTED BY ';
463	<	if not qryTables.FieldByName('RDB$COMPUTED_SOURCE').IsNull then
464	<	Column := Column + PrintValidation(qryTables.FieldByName('RDB$COMPUTED_SOURCE').AsString, true);
465	<	end
466	<	else
467	<	begin
468	<	FieldType := qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger;
469	<	FieldScale := qryTables.FieldByName('RDB$FIELD_SCALE').AsInteger;
470	<	if not ((Copy(qryTables.FieldByName('RDB$FIELD_NAME1').AsString, 1, 4) = 'RDB$') and
471	<	(qryTables.FieldByName('RDB$FIELD_NAME1').AsString[5] in ['0'..'9'])) and
472	<	(qryTables.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
473	<	begin
474	<	Column := Column + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME1').AsString);
475	<	{ International character sets }
476	<	if (qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying])
477	<	and (not qryTables.FieldByName('RDB$COLLATION_ID').IsNull)
478	<	and (qryTables.FieldByName('RDB$COLLATION_ID').AsInteger <> 0) then
479	<	begin
480	<	Collation := qryTables.FieldByName('RDB$COLLATION_ID').AsInteger;
481	<	Column := Column + GetCharacterSets(qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsShort,
482	<	Collation, true);
483	<	end;
484	<	end
485	<	else
486	<	begin
487	<	{ Look through types array }
488	<	for i := Low(Columntypes) to High(ColumnTypes) do
489	<	begin
490	<	PrecisionKnown := false;
491	<	if qryTables.FieldByname('RDB$FIELD_TYPE').AsShort = ColumnTypes[i].SQLType then
492	<	begin
493	<
494	<	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
495	<	begin
496	<	{ Handle Integral subtypes NUMERIC and DECIMAL }
497	<	if qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in
498	<	[blr_short, blr_long, blr_int64] then
499	<	begin
500	<	qryPrecision.Params.ByName('FIELDNAME').AsString :=
501	<	qryTables.FieldByName('RDB$FIELD_NAME1').AsString;
502	<	qryPrecision.ExecQuery;
503	<
504	<	{ We are ODS >= 10 and could be any Dialect }
505	<	if not qryPrecision.FieldByName('RDB$FIELD_PRECISION').IsNull then
506	<	begin
507	<	{ We are Dialect >=3 since FIELD_PRECISION is non-NULL }
508	<	if (qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
509	<	(qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
510	<	begin
511	<	Column := column + Format('%s(%d, %d)',
512	<	[IntegralSubtypes[qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
513	<	qryPrecision.FieldByName('RDB$FIELD_PRECISION').AsInteger,
514	<	-qryPrecision.FieldByName('RDB$FIELD_SCALE').AsInteger]);
515	<	PrecisionKnown := TRUE;
516	<	end;
517	<	end;
518	<	qryPrecision.Close;
519	<	end;
520	<	end;
521	<
522	<	if PrecisionKnown = FALSE then
523	<	begin
524	<	{ Take a stab at numerics and decimals }
525	<	if (FieldType = blr_short) and (FieldScale < 0) then
526	<	Column := Column + Format('NUMERIC(4, %d)', [-FieldScale])
527	<	else
528	<	if (FieldType = blr_long) and (FieldScale < 0) then
529	<	Column := Column + Format('NUMERIC(9, %d)', [-FieldScale])
530	<	else
531	<	if (FieldType = blr_double) and (FieldScale < 0) then
532	<	Column := Column + Format('NUMERIC(15, %d)', [-FieldScale])
533	<	else
534	<	Column := Column + ColumnTypes[i].TypeName;
535	<	end;
536	<	end;
537	<	end;
538	<	if FieldType in [blr_text, blr_varying] then
539	<	if qryTables.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
540	<	Column := Column + Format('(%d)', [qryTables.FieldByName('RDB$FIELD_LENGTH').AsInteger])
541	<	else
542	<	Column := Column + Format('(%d)', [qryTables.FieldByName('RDB$CHARACTER_LENGTH').AsInteger]);
543	<
544	<	{ Catch arrays after printing the type  }
545	<
546	<	if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull then
547	<	Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_NAME').AsString);
548	<
549	<	if FieldType = blr_blob then
550	<	begin
551	<	subtype := qryTables.FieldByName('RDB$FIELD_SUB_TYPE').AsShort;
552	<	Column := Column + ' SUB_TYPE ';
553	<	if (subtype > 0) and (subtype <= MAXSUBTYPES) then
554	<	Column := Column + SubTypes[subtype]
555	<	else
556	<	Column := Column + IntToStr(subtype);
557	<	column := Column + Format(' SEGMENT SIZE %d',
558	<	[qryTables.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
559	<	end;
560	<
561	<	{ International character sets }
562	<	if ((FieldType in [blr_text, blr_varying]) or
563	<	(FieldType = blr_blob)) and
564	<	(not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull) and
565	<	(qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) then
566	<	begin
567	<	{ Override rdb$fields id with relation_fields if present }
568	<
569	<	CharSetId := 0;
570	<	if not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
571	<	CharSetId := qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger;
572	<
573	<	Column := Column + GetCharacterSets(CharSetId, 0, false);
574	<	intchar := 1;
575	<	end;
576	<	end;
577	<
578	<	{ Handle defaults for columns }
579	<	{ Originally This called PrintMetadataTextBlob,
580	<	should no longer need }
581	<	if not qryTables.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
582	<	Column := Column + ' ' + qryTables.FieldByName('RDB$DEFAULT_SOURCE').AsString;
583	<
584	<
585	<	{ The null flag is either 1 or null (for nullable) .  if there is
586	<	a constraint name, print that too.  Domains cannot have named
587	<	constraints.  The column name is in rdb$trigger_name in
588	<	rdb$check_constraints.  We hope we get at most one row back. }
589	<
590	<	if qryTables.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
591	<	begin
592	<	qryConstraints.Params.ByName('FIELDNAME').AsString := qryTables.FieldByName('RDB$FIELD_NAME').AsString;
593	<	qryConstraints.Params.ByName('RELATIONNAME').AsString := qryTables.FieldByName('RDB$RELATION_NAME').AsString;
594	<	qryConstraints.ExecQuery;
595	<
596	<	while not qryConstraints.Eof do
597	<	begin
598	<	if Pos('INTEG', qryConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString) <> 1 then
599	<	Column := Column + Format(' CONSTRAINT %s',
600	<	[ QuoteIdentifier( FDatabase.SQLDialect,
601	<	qryConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString)]);
602	<	qryConstraints.Next;
603	<	end;
604	<	qryConstraints.Close;
605	<	Column := Column + ' NOT NULL';
606	<	end;
607	<
608	<	if ((FieldType in [blr_text, blr_varying]) or
609	<	(FieldType = blr_blob)) and
610	<	(not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull) and
611	<	(qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) and
612	<	(intchar <> 0) then
613	<	begin
614	<	Collation := 0;
615	<	if not qryTables.FieldByName('RDB$COLLATION_ID1').IsNull then
616	<	Collation := qryTables.FieldByName('RDB$COLLATION_ID1').AsInteger
617	<	else
618	<	if not qryTables.FieldByName('RDB$COLLATION_ID').IsNull then
619	<	Collation := qryTables.FieldByName('RDB$COLLATION_ID').AsInteger;
620	<
621	<	CharSetId := 0;
622	<	if not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
623	<	CharSetId := qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger;
624	<
625	<	if Collation <> 0 then
626	<	Column := Column + GetCharacterSets(CharSetId, Collation, true);
627	<	end;
628	<	end;
629	<	qryTables.Next;
630	<	if not qryTables.Eof then
631	<	Column := Column + ',';
632	<	FMetaData.Add(Column);
633	<	end;
634	<
635	<	{ Do primary and unique keys only. references come later }
636	<
637	<	qryRelConstraints.Params.ByName('relationname').AsString := RelationName;
638	<	qryRelConstraints.ExecQuery;
639	<	while not qryRelConstraints.Eof do
640	<	begin
641	<	Constraint := '';
642	<	FMetaData.Strings[FMetaData.Count - 1] := FMetaData.Strings[FMetaData.Count - 1]  + ',';
643	<	{ If the name of the constraint is not INTEG..., print it }
644	<	if Pos('INTEG', qryRelConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString) <> 1 then
645	<	Constraint := Constraint + 'CONSTRAINT ' +
646	<	QuoteIdentifier(FDatabase.SQLDialect,
647	<	qryRelConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString);
648	<
649	<
650	<	if Pos('PRIMARY', qryRelConstraints.FieldByName('RDB$CONSTRAINT_TYPE').AsString) = 1 then
651	<	begin
652	<	FMetaData.Add(Constraint + Format(' PRIMARY KEY (%s)',
653	<	[GetIndexSegments(qryRelConstraints.FieldByName('RDB$INDEX_NAME').AsString)]));
654	<	end
655	<	else
656	<	if Pos('UNIQUE', qryRelConstraints.FieldByName('RDB$CONSTRAINT_TYPE').AsString) = 1 then
657	<	begin
658	<	FMetaData.Add(Constraint + Format(' UNIQUE (%s)',
659	<	[GetIndexSegments(qryRelConstraints.FieldByName('RDB$INDEX_NAME').AsString)]));
660	<	end;
661	<	qryRelConstraints.Next;
662	<	end;
663	<	if ValidRelation then
664	<	FMetaData.Add(')' + Term);
665	<	finally
666	<	qryTables.Free;
667	<	qryPrecision.Free;
668	<	qryConstraints.Free;
669	<	qryRelConstraints.Free;
670	<	end;
671	<	end;
672	<
673	<	{                  ExtractListView
674	<	Functional description
675	<	Show text of the specified view.
676	<	Use a SQL query to get the info and print it.
677	<	Note: This should also contain check option }
678	<
679	<	procedure TIBExtract.ExtractListView(ViewName: String);
680	<	const
681	<	ViewsSQL = 'SELECT * FROM RDB$RELATIONS REL ' +
682	<	' WHERE ' +
683	<	'  (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
684	<	'  NOT REL.RDB$VIEW_BLR IS NULL AND ' +
685	<	'  REL.RDB$RELATION_NAME = :VIEWNAME AND ' +
686	<	'  REL.RDB$FLAGS = 1 ' +
687	<	'ORDER BY REL.RDB$RELATION_ID ';
688	<
689	<	ColumnsSQL = 'SELECT * FROM RDB$RELATION_FIELDS RFR ' +
690	<	'WHERE ' +
691	<	'  RFR.RDB$RELATION_NAME = :RELATIONNAME ' +
692	<	'ORDER BY RFR.RDB$FIELD_POSITION ';
693	<
694	<	var
695	<	qryViews, qryColumns : TIBSQL;
696	<	RelationName, ColList : String;
697	<	begin
698	<	qryViews := TIBSQL.Create(FDatabase);
699	<	qryColumns := TIBSQL.Create(FDatabase);
700	<	try
701	<	qryViews.SQL.Add(ViewsSQL);
702	<	qryViews.Params.ByName('viewname').AsString := ViewName;
703	<	qryViews.ExecQuery;
704	<	while not qryViews.Eof do
705	<	begin
706	<	FMetaData.Add('');
707	<	RelationName := QuoteIdentifier(FDatabase.SQLDialect,
708	<	qryViews.FieldByName('RDB$RELATION_NAME').AsString);
709	<	FMetaData.Add(Format('%s/* View: %s, Owner: %s */%s', [
710	<	RelationName,
711	<	Trim(qryViews.FieldByName('RDB$OWNER_NAME').AsString)]));
712	<	FMetaData.Add('');
713	<	FMetaData.Add(Format('CREATE VIEW %s (', [RelationName]));
714	<
715	<	{ Get Column List}
716	<	qryColumns.SQL.Add(ColumnsSQL);
717	<	qryColumns.Params.ByName('relationname').AsString := RelationName;
718	<	qryColumns.ExecQuery;
719	<	while not qryColumns.Eof do
720	<	begin
721	<	ColList := ColList + QuoteIdentifier(FDatabase.SQLDialect,
722	<	qryColumns.FieldByName('RDB$FIELD_NAME').AsString);
723	<	qryColumns.Next;
724	<	if not qryColumns.Eof then
725	<	ColList := ColList + ', ';
726	<	end;
727	<	FMetaData.Add(ColList + ') AS');
728	<	FMetaData.Add(qryViews.FieldByName('RDB$VIEW_SOURCE').AsString + Term);
729	<	qryViews.Next;
730	<	end;
731	<	finally
732	<	qryViews.Free;
733	<	qryColumns.Free;
734	<	end;
735	<	end;
736	<
737	<	function TIBExtract.GetCharacterSets(CharSetId, Collation: integer;
738	<	CollateOnly: Boolean): String;
739	<	var
740	<	CharSetSQL : TIBSQL;
741	<	DidActivate : Boolean;
742	<	begin
743	<	if not FTransaction.Active then
744	<	begin
745	<	FTransaction.StartTransaction;
746	<	DidActivate := true;
747	<	end
748	<	else
749	<	DidActivate := false;
750	<	CharSetSQL := TIBSQL.Create(FDatabase);
751	<	try
752	<	if Collation <> 0 then
753	<	begin
754	<	CharSetSQL.SQL.Add(CollationSQL);
755	<	CharSetSQL.Params.ByName('Char_Set_Id').AsInteger := CharSetId;
756	<	CharSetSQL.Params.ByName('Collation').AsInteger := Collation;
757	<	CharSetSQL.ExecQuery;
758	<
759	<	{ Is specified collation the default collation for character set? }
760	<	if (Trim(CharSetSQL.FieldByName('RDB$DEFAULT_COLLATE_NAME').AsString) =
761	<	Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsString)) then
762	<	begin
763	<	if not CollateOnly then
764	<	Result := ' CHARACTER SET ' + Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
765	<	end
766	<	else
767	<	if CollateOnly then
768	<	Result := ' COLLATE ' + Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsString)
769	<	else
770	<	Result := ' CHARACTER SET ' +
771	<	Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsString) +
772	<	' COLLATE ' +
773	<	Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsString);
774	<	end
775	<	else
776	<	if CharSetId <> 0 then
777	<	begin
778	<	CharSetSQL.SQL.Add(NonCollationSQL);
779	<	CharSetSQL.Params.ByName('CharSetId').AsShort := CharSetId;
780	<	CharSetSQL.ExecQuery;
781	<	Result := ' CHARACTER SET ' + Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
782	<	end;
783	<	finally
784	<	CharSetSQL.Free;
785	<	end;
786	<	if DidActivate then
787	<	FTransaction.Commit;
788	<	end;
789	<
790	<	function TIBExtract.GetDatabase: TIBDatabase;
791	<	begin
792	<	result := FDatabase;
793	<	end;
794	<
795	<	{                GetIndexSegments
796	<	Functional description
797	<	returns the list of columns in an index. }
798	<
799	<	function TIBExtract.GetIndexSegments(IndexName: String): String;
800	<	const
801	<	IndexNamesSQL =
802	<	'SELECT * FROM RDB$INDEX_SEGMENTS SEG ' +
803	<	'WHERE SEG.RDB$INDEX_NAME = :INDEXNAME ' +
804	<	'ORDER BY SEG.RDB$FIELD_POSITION';
805	<
806	<	var
807	<	qryColNames : TIBSQL;
808	<	begin
809	<	{ Query to get column names }
810	<	Result := '';
811	<	qryColNames := TIBSQL.Create(FDatabase);
812	<	try
813	<	qryColNames.SQL.Add(IndexNamesSQL);
814	<	qryColNames.Params.ByName('IndexName').AsString := IndexName;
815	<	qryColNames.ExecQuery;
816	<	while not qryColNames.Eof do
817	<	begin
818	<	{ Place a comma and a blank between each segment column name }
819	<
820	<	Result := Result + QuoteIdentifier(FDatabase.SQLDialect,
821	<	qryColNames.FieldByName('RDB$FIELD_NAME').AsString);
822	<	qryColNames.Next;
823	<	if not qryColNames.Eof then
824	<	Result := Result + ', ';
825	<	end;
826	<	finally
827	<	qryColNames.Free;
828	<	end;
829	<	end;
830	<
831	<	function TIBExtract.GetTransaction: TIBTransaction;
832	<	begin
833	<	Result := FTransaction;
834	<	end;
835	<
836	<	{          ListAllGrants
837	<	Functional description
838	<	Print the permissions on all user tables.
839	<	Get separate permissions on table/views and then procedures }
840	<
841	<	procedure TIBExtract.ListGrants;
842	<	const
843	<	SecuritySQL = 'SELECT * FROM RDB$RELATIONS ' +
844	<	'WHERE ' +
845	<	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
846	<	'  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
847	<	'ORDER BY RDB$RELATION_NAME';
848	<
849	<	ProcedureSQL = 'select * from RDB$PROCEDURES ' +
850	<	'Order BY RDB$PROCEDURE_NAME';
851	<
852	<	var
853	<	qryRoles : TIBSQL;
854	<	RelationName : String;
855	<	begin
856	<	ListRoles;
857	<	qryRoles := TIBSQL.Create(FDatabase);
858	<	try
859	<	{ This version of cursor gets only sql tables identified by security class
860	<	and misses views, getting only null view_source }
861	<
862	<	FMetaData.Add('');
863	<	FMetaData.Add('/* Grant permissions for this database */');
864	<	FMetaData.Add('');
865	<
866	<	try
867	<	qryRoles.SQL.Text := SecuritySQL;
868	<	qryRoles.ExecQuery;
869	<	while not qryRoles.Eof do
870	<	begin
871	<	RelationName := Trim(qryRoles.FieldByName('rdb$relation_Name').AsString);
872	<	ShowGrants(RelationName, Term);
873	<	qryRoles.Next;
874	<	end;
875	<	finally
876	<	qryRoles.Close;
877	<	end;
878	<
879	<	ShowGrantRoles(Term);
880	<
881	<	qryRoles.SQL.Text := ProcedureSQL;
882	<	qryRoles.ExecQuery;
883	<	try
884	<	while not qryRoles.Eof do
885	<	begin
886	<	ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsString), Term);
887	<	qryRoles.Next;
888	<	end;
889	<	finally
890	<	qryRoles.Close;
891	<	end;
892	<	finally
893	<	qryRoles.Free;
894	<	end;
895	<	end;
896	<
897	<	{         ListAllProcs
898	<	Functional description
899	<	Shows text of a stored procedure given a name.
900	<	or lists procedures if no argument.
901	<	Since procedures may reference each other, we will create all
902	<	dummy procedures of the correct name, then alter these to their
903	<	correct form.
904	<	Add the parameter names when these procedures are created.
905	<
906	<	procname -- Name of procedure to investigate }
907	<
908	<	procedure TIBExtract.ListProcs(ProcedureName : String);
909	<	const
910	<	CreateProcedureStr1 = 'CREATE PROCEDURE %s ';
911	<	CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';
912	<	ProcedureSQL =
913	<	'SELECT * FROM RDB$PROCEDURES ' +
914	<	'ORDER BY RDB$PROCEDURE_NAME';
915	<
916	<	ProcedureNameSQL =
917	<	'SELECT * FROM RDB$PROCEDURES ' +
918	<	'WHERE RDB$PROCEDURE_NAME = :ProcedureName ' +
919	<	'ORDER BY RDB$PROCEDURE_NAME';
920	<
921	<	var
922	<	qryProcedures : TIBSQL;
923	<	ProcName : String;
924	<	SList : TStrings;
925	<	Header : Boolean;
926	<	begin
927	<
928	<	Header := true;
929	<	qryProcedures := TIBSQL.Create(FDatabase);
930	<	SList := TStringList.Create;
931	<	try
932	<	{  First the dummy procedures
933	<	create the procedures with their parameters }
934	<	if ProcedureName = '' then
935	<	qryProcedures.SQL.Text := ProcedureSQL
936	<	else
937	<	begin
938	<	qryProcedures.SQL.Text := ProcedureNameSQL;
939	<	qryProcedures.Params.ByName('ProcedureName').AsString := ProcedureName;
940	<	end;
941	<	qryProcedures.ExecQuery;
942	<	while not qryProcedures.Eof do
943	<	begin
944	<	if Header then
945	<	begin
946	<	FMetaData.Add('COMMIT WORK;');
947	<	FMetaData.Add('SET AUTODDL OFF;');
948	<	FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term]));
949	<	FMetaData.Add(Format('%s/* Stored procedures */%s', [NEWLINE, NEWLINE]));
950	<	Header := false;
951	<	end;
952	<	ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
953	<	FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(FDatabase.SQLDialect,
954	<	ProcName)]));
955	<	GetProcedureArgs(ProcName);
956	<	FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, NEWLINE]));
957	<	qryProcedures.Next;
958	<	end;
959	<
960	<	qryProcedures.Close;
961	<	qryProcedures.ExecQuery;
962	<	while not qryProcedures.Eof do
963	<	begin
964	<	SList.Clear;
965	<	ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
966	<	FMetaData.Add(Format('%sALTER PROCEDURE %s ', [NEWLINE,
967	<	QuoteIdentifier(FDatabase.SQLDialect, ProcName)]));
968	<	GetProcedureArgs(ProcName);
969	<
970	<	if not qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').IsNull then
971	<	SList.Text := SList.Text + qryProcedures.FieldByName('RDB$PROCEDURE_SOURCE').AsString;
972	<	SList.Add(Format(' %s%s', [ProcTerm, NEWLINE]));
973	<	FMetaData.AddStrings(SList);
974	<	qryProcedures.Next;
975	<	end;
976	<
977	<	{ This query gets the procedure name and the source.  We then nest a query
978	<	to retrieve the parameters. Alter is used, because the procedures are
979	<	already there}
980	<
981	<	if not Header then
982	<	begin
983	<	FMetaData.Add(Format('SET TERM %s %s', [Term, ProcTerm]));
984	<	FMetaData.Add('COMMIT WORK;');
985	<	FMetaData.Add('SET AUTODDL ON;');
986	<	end;
987	<	finally
988	<	qryProcedures.Free;
989	<	SList.Free;
990	<	end;
991	<	end;
992	<
993	<	{                 ListAllTables
994	<	Functional description
995	<	Extract the names of all user tables from
996	<	rdb$relations.  Filter SQL tables by
997	<	security class after we fetch them
998	<	Parameters:  flag -- 0, get all tables }
999	<
1000	<	procedure TIBExtract.ListAllTables(flag: Boolean);
1001	<	const
1002	<	TableSQL =
1003	<	'SELECT * FROM RDB$RELATIONS ' +
1004	<	'WHERE ' +
1005	<	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
1006	<	'  RDB$VIEW_BLR IS NULL ' +
1007	<	'ORDER BY RDB$RELATION_NAME';
1008	<
1009	<	var
1010	<	qryTables : TIBSQL;
1011	<	begin
1012	<	{ This version of cursor gets only sql tables identified by security class
1013	<	and misses views, getting only null view_source }
1014	<
1015	<	qryTables := TIBSQL.Create(FDatabase);
1016	<	try
1017	<	qryTables.SQL.Text := TableSQL;
1018	<	qryTables.ExecQuery;
1019	<	while not qryTables.Eof do
1020	<	begin
1021	<	if ((qryTables.FieldByName('RDB$FLAGS').AsInteger <> 1) and
1022	<	(not Flag)) then
1023	<	continue;
1024	<	if flag or (Pos('SQL$', qryTables.FieldByName('RDB$SECURITY_CLASS').AsString) <> 1) then
1025	<	ExtractListTable(qryTables.FieldByName('RDB$RELATION_NAME').AsString,
1026	<	'', false);
1027	<
1028	<	qryTables.Next;
1029	<	end;
1030	<	finally
1031	<	qryTables.Free;
1032	<	end;
1033	<	end;
1034	<
1035	<	{        ListAllTriggers
1036	<	Functional description
1037	<	Lists triggers in general on non-system
1038	<	tables with sql source only. }
1039	<
1040	<	procedure TIBExtract.ListTriggers(ObjectName : String; ExtractType : TExtractType);
1041	<	const
1042	<	{ Query gets the trigger info for non-system triggers with
1043	<	source that are not part of an SQL constraint }
1044	<
1045	<	TriggerSQL =
1046	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1047	<	'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1048	<	'WHERE ' +
1049	<	' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
1050	<	'  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +
1051	<	'     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +
1052	<	'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +
1053	<	'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1054	<
1055	<	TriggerNameSQL =
1056	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1057	<	'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1058	<	'WHERE ' +
1059	<	' REL.RDB$RELATION_NAME = :TableName AND ' +
1060	<	' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
1061	<	'  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +
1062	<	'     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +
1063	<	'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +
1064	<	'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1065	<
1066	<	TriggerByNameSQL =
1067	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1068	<	'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1069	<	'WHERE ' +
1070	<	' TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
1071	<	' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
1072	<	'  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +
1073	<	'     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +
1074	<	'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +
1075	<	'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1076	<
1077	<	var
1078	<	Header : Boolean;
1079	<	TriggerName, RelationName, InActive: String;
1080	<	qryTriggers : TIBSQL;
1081	<	SList : TStrings;
1082	<	begin
1083	<	Header := true;
1084	<	SList := TStringList.Create;
1085	<	qryTriggers := TIBSQL.Create(FDatabase);
1086	<	try
1087	<	if ObjectName = '' then
1088	<	qryTriggers.SQL.Text := TriggerSQL
1089	<	else
1090	<	begin
1091	<	if ExtractType = etTable then
1092	<	begin
1093	<	qryTriggers.SQL.Text := TriggerNameSQL;
1094	<	qryTriggers.Params.ByName('TableName').AsString := ObjectName;
1095	<	end
1096	<	else
1097	<	begin
1098	<	qryTriggers.SQL.Text := TriggerByNameSQL;
1099	<	qryTriggers.Params.ByName('TriggerName').AsString := ObjectName;
1100	<	end;
1101	<	end;
1102	<	qryTriggers.ExecQuery;
1103	<	while not qryTriggers.Eof do
1104	<	begin
1105	<	SList.Clear;
1106	<	if Header then
1107	<	begin
1108	<	FMetaData.Add(Format('SET TERM %s %s%s', [Procterm, Term, NEWLINE]));
1109	<	FMetaData.Add(Format('%s/* Triggers only will work for SQL triggers */%s',
1110	<	[NEWLINE, NEWLINE]));
1111	<	Header := false;
1112	<	end;
1113	<	TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsString;
1114	<	RelationName := qryTriggers.FieldByName('RDB$RELATION_NAME').AsString;
1115	<	if qryTriggers.FieldByName('RDB$TRIGGER_INACTIVE').IsNull then
1116	<	InActive := 'INACTIVE'
1117	<	else
1118	<	if qryTriggers.FieldByName('RDB$TRIGGER_INACTIVE').AsInteger = 1 then
1119	<	InActive := 'INACTIVE'
1120	<	else
1121	<	InActive := 'ACTIVE';
1122	<
1123	<	if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1124	<	SList.Add('/* ');
1125	<
1126	<	SList.Add(Format('CREATE TRIGGER %s FOR %s %s%s %s POSITION %d',
1127	<	[QuoteIdentifier(FDatabase.SQLDialect, TriggerName),
1128	<	QuoteIdentifier(FDatabase.SQLDialect, RelationName),
1129	<	NEWLINE, InActive,
1130	<	TriggerTypes[qryTriggers.FieldByName('RDB$TRIGGER_TYPE').AsInteger],
1131	<	qryTriggers.FieldByName('RDB$TRIGGER_SEQUENCE').AsInteger]));
1132	<	if not qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1133	<	SList.Text := SList.Text +
1134	<	qryTriggers.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1135	<	SList.Add(' ' + ProcTerm + NEWLINE);
1136	<	if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1137	<	SList.Add(' */');
1138	<	FMetaData.AddStrings(SList);
1139	<	qryTriggers.Next;
1140	<	end;
1141	<	if not Header then
1142	<	begin
1143	<	FMetaData.Add('COMMIT WORK ' + ProcTerm);
1144	<	FMetaData.Add('SET TERM ' + Term + ProcTerm);
1145	<	end;
1146	<	finally
1147	<	qryTriggers.Free;
1148	<	SList.Free;
1149	<	end;
1150	<	end;
1151	<
1152	<	{                      ListCheck
1153	<	Functional description
1154	<	List check constraints for all objects to allow forward references }
1155	<
1156	<	procedure TIBExtract.ListCheck(ObjectName : String; ExtractType : TExtractType);
1157	<	const
1158	<	{ Query gets the check clauses for triggers stored for check constraints }
1159	<	CheckSQL =
1160	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +
1161	<	'  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +
1162	<	'WHERE ' +
1163	<	'  TRG.RDB$TRIGGER_TYPE = 1 AND ' +
1164	<	'  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +
1165	<	'    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +
1166	<	'ORDER BY CHK.RDB$CONSTRAINT_NAME';
1167	<
1168	<	CheckNameSQL =
1169	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +
1170	<	'  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +
1171	<	'WHERE ' +
1172	<	'  TRG.RDB$RELATION_NAME = :TableName AND ' +
1173	<	'  TRG.RDB$TRIGGER_TYPE = 1 AND ' +
1174	<	'  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +
1175	<	'    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +
1176	<	'ORDER BY CHK.RDB$CONSTRAINT_NAME';
1177	<
1178	<	CheckByNameSQL =
1179	<	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +
1180	<	'  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +
1181	<	'WHERE ' +
1182	<	'  TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
1183	<	'  TRG.RDB$TRIGGER_TYPE = 1 AND ' +
1184	<	'  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +
1185	<	'    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +
1186	<	'ORDER BY CHK.RDB$CONSTRAINT_NAME';
1187	<
1188	<	var
1189	<	qryChecks : TIBSQL;
1190	<	SList : TStrings;
1191	<	RelationName : String;
1192	<	begin
1193	<	qryChecks := TIBSQL.Create(FDatabase);
1194	<	SList := TStringList.Create;
1195	<	try
1196	<	if ObjectName = '' then
1197	<	qryChecks.SQL.Text := CheckSQL
1198	<	else
1199	<	if ExtractType = etTable then
1200	<	begin
1201	<	qryChecks.SQL.Text := CheckNameSQL;
1202	<	qryChecks.Params.ByName('TableName').AsString := ObjectName;
1203	<	end
1204	<	else
1205	<	begin
1206	<	qryChecks.SQL.Text := CheckByNameSQL;
1207	<	qryChecks.Params.ByName('TriggerName').AsString := ObjectName;
1208	<	end;
1209	<	qryChecks.ExecQuery;
1210	<	while not qryChecks.Eof do
1211	<	begin
1212	<	SList.Clear;
1213	<	RelationName := qryChecks.FieldByName('RDB$RELATION_NAME').AsString;
1214	<	SList.Add(Format('ALTER TABLE %s ADD',
1215	<	[QuoteIdentifier(FDatabase.SQLDialect, RelationName)]));
1216	<	if Pos('INTEG', qryChecks.FieldByName('RDB$CONSTRAINT_NAME').AsString) <> 1 then
1217	<	SList.Add(Format('%sCONSTRAINT %s ', [TAB,
1218	<	QuoteIdentifier(FDatabase.SQLDialect, qryChecks.FieldByName('RDB$CONSTRAINT_NAME').AsString)]));
1219	<
1220	<	if not qryChecks.FieldByName('RDB$TRIGGER_SOURCE').IsNull then
1221	<	SList.Text := SList.Text + qryChecks.FieldByName('RDB$TRIGGER_SOURCE').AsString;
1222	<
1223	<	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + (Term) + NEWLINE;
1224	<	FMetaData.AddStrings(SList);
1225	<	qryChecks.Next;
1226	<	end;
1227	<	finally
1228	<	qryChecks.Free;
1229	<	SList.Free;
1230	<	end;
1231	<	end;
1232	<
1233	<	{             ListCreateDb
1234	<	Functional description
1235	<	Print the create database command if requested.  At least put
1236	<	the page size in a comment with the extracted db name }
1237	<
1238	<	procedure TIBExtract.ListCreateDb(TargetDb : String);
1239	<	const
1240	<	CharInfoSQL =
1241	<	'SELECT * FROM RDB$DATABASE DBP ' +
1242	<	'WHERE NOT DBP.RDB$CHARACTER_SET_NAME IS NULL ' +
1243	<	'  AND DBP.RDB$CHARACTER_SET_NAME != '' ''';
1244	<
1245	<	FilesSQL =
1246	<	'select * from RDB$FILES ' +
1247	<	'order BY RDB$SHADOW_NUMBER, RDB$FILE_SEQUENCE';
1248	<
1249	<	LogsSQL =
1250	<	'SELECT * FROM RDB$LOG_FILES ' +
1251	<	'ORDER BY RDB$FILE_FLAGS, RDB$FILE_SEQUENCE';
1252	<
1253	<	var
1254	<	NoDb, First, FirstFile, HasWal, SetUsed : Boolean;
1255	<	Buffer : String;
1256	<	qryDB : TIBSQL;
1257	<	FileFlags, FileLength, FileSequence, FileStart : Integer;
1258	<
1259	<	function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
1260	<	var
1261	<	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
1262	<	length: Integer;
1263	<	_DatabaseInfoCommand: Char;
1264	<	begin
1265	<	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
1266	<	FDatabaseInfo.Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
1267	<	IBLocalBufferLength, local_buffer), True);
1268	<	length := isc_vax_integer(@local_buffer[1], 2);
1269	<	result := isc_vax_integer(@local_buffer[3], length);
1270	<	end;
1271	<
1272	<	begin
1273	<	NoDb := FALSE;
1274	<	First := TRUE;
1275	<	FirstFile := TRUE;
1276	<	HasWal := FALSE;
1277	<	SetUsed := FALSE;
1278	<	Buffer := '';
1279	<	if TargetDb = '' then
1280	<	begin
1281	<	Buffer := '/* ';
1282	<	TargetDb := FDatabase.DatabaseName;
1283	<	NoDb := true;
1284	<	end;
1285	<	Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +
1286	<	IntToStr(FDatabaseInfo.PageSize) + NEWLINE;
1287	<	FMetaData.Add(Buffer);
1288	<	Buffer := '';
1289	<
1290	<	qryDB := TIBSQL.Create(FDatabase);
1291	<	try
1292	<	qryDB.SQL.Text := CharInfoSQL;
1293	<	qryDB.ExecQuery;
1294	<
1295	<	Buffer := Format(' DEFAULT CHARACTER SET %s',
1296	<	[qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
1297	<	if NoDB then
1298	<	Buffer := Buffer + ' */'
1299	<	else
1300	<	Buffer := Buffer + Term;
1301	<	FMetaData.Add(Buffer);
1302	<	qryDB.Close;
1303	<	{List secondary files and shadows as
1304	<	alter db and create shadow in comment}
1305	<	qryDB.SQL.Text := FilesSQL;
1306	<	qryDB.ExecQuery;
1307	<	while not qryDB.Eof do
1308	<	begin
1309	<	if First then
1310	<	begin
1311	<	FMetaData.Add(NEWLINE + '/* Add secondary files in comments ');
1312	<	First := false;
1313	<	end; //end_if
1314	<
1315	<	if qryDB.FieldByName('RDB$FILE_FLAGS').IsNull then
1316	<	FileFlags := 0
1317	<	else
1318	<	FileFlags := qryDB.FieldByName('RDB$FILE_FLAGS').AsInteger;
1319	<	if qryDB.FieldByName('RDB$FILE_LENGTH').IsNull then
1320	<	FileLength := 0
1321	<	else
1322	<	FileLength := qryDB.FieldByName('RDB$FILE_LENGTH').AsInteger;
1323	<	if qryDB.FieldByName('RDB$FILE_SEQUENCE').IsNull then
1324	<	FileSequence := 0
1325	<	else
1326	<	FileSequence := qryDB.FieldByName('RDB$FILE_SEQUENCE').AsInteger;
1327	<	if qryDB.FieldByName('RDB$FILE_START').IsNull then
1328	<	FileStart := 0
1329	<	else
1330	<	FileStart := qryDB.FieldByName('RDB$FILE_START').AsInteger;
1331	<
1332	<	{ Pure secondary files }
1333	<	if FileFlags = 0 then
1334	<	begin
1335	<	Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',
1336	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1337	<	if FileStart <> 0 then
1338	<	Buffer := Buffer + Format(' STARTING %d', [FileStart]);
1339	<	if FileLength <> 0 then
1340	<	Buffer := Buffer + Format(' LENGTH %d', [FileLength]);
1341	<	FMetaData.Add(Buffer);
1342	<	end; //end_if
1343	<	if (FileFlags and FILE_cache) <> 0 then
1344	<	FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',
1345	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1346	<
1347	<	Buffer := '';
1348	<	if (FileFlags and FILE_shadow) <> 0 then
1349	<	begin
1350	<	if FileSequence <> 0 then
1351	<	Buffer := Format('%sFILE ''%s''',
1352	<	[TAB, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1353	<	else
1354	<	begin
1355	<	Buffer := Format('%sCREATE SHADOW %d ''%s'' ',
1356	<	[NEWLINE, qryDB.FieldByName('RDB$SHADOW_NUMBER').AsInteger,
1357	<	qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1358	<	if (FileFlags and FILE_inactive) <> 0 then
1359	<	Buffer := Buffer + 'INACTIVE ';
1360	<	if (FileFlags and FILE_manual) <> 0 then
1361	<	Buffer := Buffer + 'MANUAL '
1362	<	else
1363	<	Buffer := Buffer + 'AUTO ';
1364	<	if (FileFlags and FILE_conditional) <> 0 then
1365	<	Buffer := Buffer + 'CONDITIONAL ';
1366	<	end; //end_else
1367	<	if FileLength <> 0 then
1368	<	Buffer := Buffer + Format('LENGTH %d ', [FileLength]);
1369	<	if FileStart <> 0 then
1370	<	Buffer := Buffer + Format('STARTING %d ', [FileStart]);
1371	<	FMetaData.Add(Buffer);
1372	<	end; //end_if
1373	<	qryDB.Next;
1374	<	end;
1375	<	qryDB.Close;
1376	<
1377	<	qryDB.SQL.Text := LogsSQL;
1378	<	qryDB.ExecQuery;
1379	<	while not qryDB.Eof do
1380	<	begin
1381	<
1382	<	if qryDB.FieldByName('RDB$FILE_FLAGS').IsNull then
1383	<	FileFlags := 0
1384	<	else
1385	<	FileFlags := qryDB.FieldByName('RDB$FILE_FLAGS').AsInteger;
1386	<	if qryDB.FieldByName('RDB$FILE_LENGTH').IsNull then
1387	<	FileLength := 0
1388	<	else
1389	<	FileLength := qryDB.FieldByName('RDB$FILE_LENGTH').AsInteger;
1390	<
1391	<	Buffer := '';
1392	<	HasWal := true;
1393	<	if First then
1394	<	begin
1395	<	if NoDB then
1396	<	Buffer := '/* ';
1397	<	Buffer := Buffer + NEWLINE + 'ALTER DATABASE ADD ';
1398	<	First := false;
1399	<	end; //end_if
1400	<	if FirstFile then
1401	<	Buffer := Buffer + 'LOGFILE ';
1402	<	{ Overflow files also have the serial bit set }
1403	<	if (FileFlags and LOG_default) = 0 then
1404	<	begin
1405	<	if (FileFlags and LOG_overflow) <> 0 then
1406	<	Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',
1407	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1408	<	else
1409	<	if (FileFlags and LOG_serial) <> 0 then
1410	<	Buffer := Buffer + Format('%s  BASE_NAME ''%s''',
1411	<	[NEWLINE, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1412	<	{ Since we are fetching order by FILE_FLAGS, the LOG_0verflow will
1413	<	be last.  It will only appear if there were named round robin,
1414	<	so we must close the parens first }
1415	<
1416	<	{ We have round robin and overflow file specifications }
1417	<	else
1418	<	begin
1419	<	if FirstFile then
1420	<	Buffer := Buffer + '('
1421	<	else
1422	<	Buffer := Buffer + Format(',%s  ', [NEWLINE]);
1423	<	FirstFile := false;
1424	<
1425	<	Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1426	<	end; //end_else
1427	<	end;
1428	<	{ Any file can have a length }
1429	<	if FileLength <> 0 then
1430	<	Buffer := Buffer + Format(' SIZE %d ', [FileLength]);
1431	<	FMetaData.Add(Buffer);
1432	<	qryDB.Next;
1433	<	end;
1434	<	qryDB.Close;
1435	<	Buffer := '';
1436	<	if HasWal then
1437	<	begin
1438	<	Buffer := Buffer + PrintSet(SetUsed);
1439	<	Buffer := Buffer + Format('NUM_LOG_BUFFERS = %d',
1440	<	[GetLongDatabaseInfo(isc_info_num_wal_buffers)]);
1441	<	Buffer := Buffer + PrintSet(SetUsed);
1442	<	Buffer := Buffer + Format('LOG_BUFFER_SIZE = %d',
1443	<	[GetLongDatabaseInfo(isc_info_wal_buffer_size)]);
1444	<	Buffer := Buffer + PrintSet(SetUsed);
1445	<	Buffer := Buffer + Format('GROUP_COMMIT_WAIT_TIME = %d',
1446	<	[GetLongDatabaseInfo(isc_info_wal_grpc_wait_usecs)]);
1447	<	Buffer := Buffer + PrintSet(SetUsed);
1448	<	Buffer := Buffer + Format('CHECK_POINT_LENGTH = %d',
1449	<	[GetLongDatabaseInfo(isc_info_wal_ckpt_length)]);
1450	<	FMetaData.Add(Buffer);
1451	<
1452	<	end;
1453	<	if not First then
1454	<	begin
1455	<	if NoDB then
1456	<	FMetaData.Add(Format('%s */%s', [NEWLINE, NEWLINE]))
1457	<	else
1458	<	FMetaData.Add(Format('%s%s%s', [Term, NEWLINE, NEWLINE]));
1459	<	end;
1460	<	finally
1461	<	qryDB.Free;
1462	<	end;
1463	<
1464	<	(*
1465	<	*)
1466	<	end;
1467	<
1468	<	{                    ListDomainTable
1469	<	Functional description
1470	<	List domains as identified by fields with any constraints on them
1471	<	for the named table
1472	<
1473	<	Parameters:  table_name == only extract domains for this table }
1474	<
1475	<	procedure TIBExtract.ListDomains(ObjectName: String; ExtractType : TExtractType);
1476	<	const
1477	<	DomainSQL =
1478	<	'SELECT distinct fld.* FROM RDB$FIELDS FLD JOIN RDB$RELATION_FIELDS RFR ON ' +
1479	<	'  RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +
1480	<	'WHERE RFR.RDB$RELATION_NAME = :TABLE_NAME ' +
1481	<	'ORDER BY FLD.RDB$FIELD_NAME';
1482	<
1483	<	DomainByNameSQL =
1484	<	'SELECT * FROM RDB$FIELDS FLD ' +
1485	<	'WHERE FLD.RDB$FIELD_NAME = :DomainName ' +
1486	<	'ORDER BY FLD.RDB$FIELD_NAME';
1487	<
1488	<	AllDomainSQL =
1489	<	'select * from RDB$FIELDS ' +
1490	<	'where RDB$SYSTEM_FLAG <> 1 ' +
1491	<	'order BY RDB$FIELD_NAME';
1492	<
1493	<	var
1494	<	First : Boolean;
1495	<	qryDomains : TIBSQL;
1496	<	FieldName, Line : String;
1497	<
1498	<	function FormatDomainStr : String;
1499	<	var
1500	<	i, SubType : Integer;
1501	<	PrecisionKnown : Boolean;
1502	<	begin
1503	<	Result := '';
1504	<	for i := Low(ColumnTypes) to High(ColumnTypes) do
1505	<	if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = ColumnTypes[i].SQLType then
1506	<	begin
1507	<	PrecisionKnown := FALSE;
1508	<	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
1509	<	begin
1510	<	if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_short, blr_long, blr_int64] then
1511	<	begin
1512	<	{ We are ODS >= 10 and could be any Dialect }
1513	<	if (FDatabaseInfo.DBSQLDialect >= 3) and
1514	<	(not qryDomains.FieldByName('RDB$FIELD_PRECISION').IsNull) and
1515	<	(qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
1516	<	(qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
1517	<	begin
1518	<	Result := Result + Format('%s(%d, %d)', [
1519	<	IntegralSubtypes [qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
1520	<	qryDomains.FieldByName('RDB$FIELD_PRECISION').AsInteger,
1521	<	-1 * qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger]);
1522	<	PrecisionKnown := true;
1523	<	end;
1524	<	end;
1525	<	end;
1526	<	if PrecisionKnown = false then
1527	<	begin
1528	<	{ Take a stab at numerics and decimals }
1529	<	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_short) and
1530	<	(qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
1531	<	Result := Result + Format('NUMERIC(4, %d)',
1532	<	[-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )
1533	<	else
1534	<	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_long) and
1535	<	(qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
1536	<	Result := Result + Format('NUMERIC(9, %d)',
1537	<	[-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )
1538	<	else
1539	<	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_double) and
1540	<	(qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger  < 0) then
1541	<	Result := Result + Format('NUMERIC(15, %d)',
1542	<	[-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )
1543	<	else
1544	<	Result := Result + ColumnTypes[i].TypeName;
1545	<	end;
1546	<	break;
1547	<	end;
1548	<
1549	<	if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_blob then
1550	<	begin
1551	<	subtype := qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger;
1552	<	Result := Result + ' SUB_TYPE ';
1553	<	if (subtype > 0) and (subtype <= MAXSUBTYPES) then
1554	<	Result := Result + SubTypes[subtype]
1555	<	else
1556	<	Result := Result + Format('%d', [subtype]);
1557	<	Result := Result + Format(' SEGMENT SIZE %d', [qryDomains.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
1558	<	end //end_if
1559	<	else
1560	<	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
1561	<	(not qryDomains.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
1562	<	Result := Result + Format('(%d)', [qryDomains.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1563	<
1564	<	{ since the character set is part of the field type, display that
1565	<	information now. }
1566	<	if not qryDomains.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
1567	<	Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1568	<	0, FALSE);
1569	<	if not qryDomains.FieldByName('RDB$DIMENSIONS').IsNull then
1570	<	Result := GetArrayField(FieldName);
1571	<
1572	<	if not qryDomains.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
1573	<	Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1574	<	qryDomains.FieldByName('RDB$DEFAULT_SOURCE').AsString]);
1575	<
1576	<	if not qryDomains.FieldByName('RDB$VALIDATION_SOURCE').IsNull then
1577	<	if Pos('CHECK', AnsiUpperCase(qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString)) = 1 then
1578	<	Result := Result + Format('%s%s %s', [NEWLINE, TAB,
1579	<	qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString])
1580	<	else
1581	<	Result := Result + Format('%s%s /* %s */', [NEWLINE, TAB,
1582	<	qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString]);
1583	<
1584	<	if qryDomains.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
1585	<	Result := Result + ' NOT NULL';
1586	<
1587	<	{ Show the collation order if one has been specified.  If the collation
1588	<	order is the default for the character set being used, then no collation
1589	<	order will be shown ( because it isn't needed ).
1590	<
1591	<	If the collation id is 0, then the default for the character set is
1592	<	being used so there is no need to retrieve the collation information.}
1593	<
1594	<	if (not qryDomains.FieldByName('RDB$COLLATION_ID').IsNull) and
1595	<	(qryDomains.FieldByName('RDB$COLLATION_ID').AsInteger <> 0) then
1596	<	Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1597	<	qryDomains.FieldByName('RDB$COLLATION_ID').AsInteger, true);
1598	<	end;
1599	<
1600	<	begin
1601	<	First := true;
1602	<	qryDomains := TIBSQL.Create(FDatabase);
1603	<	try
1604	<	if ObjectName <> '' then
1605	<	begin
1606	<	if ExtractType = etTable then
1607	<	begin
1608	<	qryDomains.SQL.Text := DomainSQL;
1609	<	qryDomains.Params.ByName('table_name').AsString := ObjectName;
1610	<	end
1611	<	else
1612	<	begin
1613	<	qryDomains.SQL.Text := DomainByNameSQL;
1614	<	qryDomains.Params.ByName('DomainName').AsString := ObjectName;
1615	<	end;
1616	<	end
1617	<	else
1618	<	qryDomains.SQL.Text := AllDomainSQL;
1619	<
1620	<	qryDomains.ExecQuery;
1621	<	while not qryDomains.Eof do
1622	<	begin
1623	<	FieldName := qryDomains.FieldByName('RDB$FIELD_NAME').AsString;
1624	<	{ Skip over artifical domains }
1625	<	if (Pos('RDB$',FieldName) = 1) and
1626	<	(FieldName[5] in ['0'..'9']) and
1627	<	(qryDomains.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
1628	<	begin
1629	<	qryDomains.Next;
1630	<	continue;
1631	<	end;
1632	<
1633	<	if First then
1634	<	begin
1635	<	FMetaData.Add('/* Domain definitions */');
1636	<	First := false;
1637	<	end;
1638	<
1639	<	Line := Format('CREATE DOMAIN %s AS ', [FieldName]);
1640	<	Line := Line + FormatDomainStr + Term;
1641	<	FMetaData.Add(Line);
1642	<	qryDomains.Next;
1643	<	end;
1644	<	finally
1645	<	qryDomains.Free;
1646	<	end;
1647	<	end;
1648	<
1649	<	{          ListException
1650	<	Functional description
1651	<	List all exceptions defined in the database
1652	<
1653	<	Parameters:  none }
1654	<
1655	<	procedure TIBExtract.ListException(ExceptionName : String = '');
1656	<	const
1657	<	ExceptionSQL =
1658	<	'select * from RDB$EXCEPTIONS ' +
1659	<	'ORDER BY RDB$EXCEPTION_NAME';
1660	<
1661	<	ExceptionNameSQL =
1662	<	'select * from RDB$EXCEPTIONS ' +
1663	<	'WHERE RDB$EXCEPTION_NAME = :ExceptionName ' +
1664	<	'ORDER BY RDB$EXCEPTION_NAME';
1665	<
1666	<	var
1667	<	First : Boolean;
1668	<	qryException : TIBSQL;
1669	<	begin
1670	<	First := true;
1671	<	qryException := TIBSQL.Create(FDatabase);
1672	<	try
1673	<	if ExceptionName = '' then
1674	<	qryException.SQL.Text := ExceptionSQL
1675	<	else
1676	<	begin
1677	<	qryException.SQL.Text := ExceptionNameSQL;
1678	<	qryException.Params.ByName('ExceptionName').AsString := ExceptionName;
1679	<	end;
1680	<
1681	<	qryException.ExecQuery;
1682	<	while not qryException.Eof do
1683	<	begin
1684	<	if First then
1685	<	begin
1686	<	FMetaData.Add('');
1687	<	FMetaData.Add('/*  Exceptions */');
1688	<	FMetaData.Add('');
1689	<	First := false;
1690	<	end; //end_if
1691	<
1692	<	FMetaData.Add(Format('CREATE EXCEPTION %s %s%s',
1693	<	[QuoteIdentifier(FDatabase.SQLDialect, qryException.FieldByName('RDB$EXCEPTION_NAME').AsString),
1694	<	QuotedStr(qryException.FieldByName('RDB$MESSAGE').AsString), Term]));
1695	<	qryException.Next;
1696	<	end;
1697	<	finally
1698	<	qryException.Free;
1699	<	end;
1700	<	end;
1701	<
1702	<	{              ListFilters
1703	<
1704	<	Functional description
1705	<	List all blob filters
1706	<
1707	<	Parameters:  none
1708	<	Results in
1709	<	DECLARE FILTER <fname> INPUT_TYPE <blob_sub_type> OUTPUT_TYPE <blob_subtype>
1710	<	ENTRY_POINT <string> MODULE_NAME <string> }
1711	<
1712	<	procedure TIBExtract.ListFilters(FilterName : String = '');
1713	<	const
1714	<	FiltersSQL =
1715	<	'SELECT * FROM RDB$FILTERS ' +
1716	<	'ORDER BY RDB$FUNCTION_NAME';
1717	<	FilterNameSQL =
1718	<	'SELECT * FROM RDB$FILTERS ' +
1719	<	'WHERE RDB$FUNCTION_NAME = :FunctionName ' +
1720	<	'ORDER BY RDB$FUNCTION_NAME';
1721	<
1722	<	var
1723	<	First : Boolean;
1724	<	qryFilters : TIBSQL;
1725	<	begin
1726	<	First := true;
1727	<	qryFilters := TIBSQL.Create(FDatabase);
1728	<	try
1729	<	if FilterName = '' then
1730	<	qryFilters.SQL.Text := FiltersSQL
1731	<	else
1732	<	begin
1733	<	qryFilters.SQL.Text := FilterNameSQL;
1734	<	qryFilters.Params.ByName('FunctionName').AsString := FilterName;
1735	<	end;
1736	<	qryFilters.ExecQuery;
1737	<	while not qryFilters.Eof do
1738	<	begin
1739	<	if First then
1740	<	begin
1741	<	FMetaData.Add('');
1742	<	FMetaData.Add('/*  BLOB Filter declarations */');
1743	<	FMetaData.Add('');
1744	<	First := false;
1745	<	end; //end_if
1746	<
1747	<	FMetaData.Add(Format('DECLARE FILTER %s INPUT_TYPE %d OUTPUT_TYPE %d',
1748	<	[qryFilters.FieldByName('RDB$FUNCTION_NAME').AsString,
1749	<	qryFilters.FieldByName('RDB$INPUT_SUB_TYPE').AsInteger,
1750	<	qryFilters.FieldByName('RDB$OUTPUT_SUB_TYPE').AsInteger]));
1751	<	FMetaData.Add(Format('%sENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%',
1752	<	[TAB, qryFilters.FieldByName('RDB$ENTRYPOINT').AsString,
1753	<	qryFilters.FieldByName('RDB$MODULE_NAME').AsString, Term]));
1754	<	FMetaData.Add('');
1755	<
1756	<	qryFilters.Next;
1757	<	end;
1758	<
1759	<	finally
1760	<	qryFilters.Free;
1761	<	end;
1762	<	end;
1763	<
1764	<	{            ListForeign
1765	<	Functional description
1766	<	List all foreign key constraints and alter the tables }
1767	<
1768	<	procedure TIBExtract.ListForeign(ObjectName : String; ExtractType : TExtractType);
1769	<	const
1770	<	{ Static queries for obtaining foreign constraints, where RELC1 is the
1771	<	foreign key constraints, RELC2 is the primary key lookup and REFC
1772	<	is the join table }
1773	<	ForeignSQL =
1774	<	'SELECT REFC.RDB$UPDATE_RULE REFC_UPDATE_RULE, REFC.RDB$DELETE_RULE REFC_DELETE_RULE, ' +
1775	<	'  RELC1.RDB$RELATION_NAME RELC1_RELATION_NAME, RELC2.RDB$RELATION_NAME RELC2_RELATION_NAME, ' +
1776	<	'  RELC1.RDB$INDEX_NAME RELC1_INDEX_NAME, RELC1.RDB$CONSTRAINT_NAME RELC1_CONSTRAINT_NAME, ' +
1777	<	'  RELC2.RDB$INDEX_NAME RELC2_INDEX_NAME ' +
1778	<	'FROM RDB$REF_CONSTRAINTS REFC, RDB$RELATION_CONSTRAINTS RELC1, ' +
1779	<	'     RDB$RELATION_CONSTRAINTS RELC2 ' +
1780	<	'WHERE ' +
1781	<	'  RELC1.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'' AND ' +
1782	<	'  REFC.RDB$CONST_NAME_UQ = RELC2.RDB$CONSTRAINT_NAME AND ' +
1783	<	'  REFC.RDB$CONSTRAINT_NAME = RELC1.RDB$CONSTRAINT_NAME AND ' +
1784	<	'  (RELC2.RDB$CONSTRAINT_TYPE = ''UNIQUE'' OR ' +
1785	<	'    RELC2.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'') ' +
1786	<	'ORDER BY RELC1.RDB$RELATION_NAME, RELC1.RDB$CONSTRAINT_NAME';
1787	<
1788	<	ForeignNameSQL =
1789	<	'SELECT REFC.RDB$UPDATE_RULE REFC_UPDATE_RULE, REFC.RDB$DELETE_RULE REFC_DELETE_RULE, ' +
1790	<	'  RELC1.RDB$RELATION_NAME RELC1_RELATION_NAME, RELC2.RDB$RELATION_NAME RELC2_RELATION_NAME, ' +
1791	<	'  RELC1.RDB$INDEX_NAME RELC1_INDEX_NAME, RELC1.RDB$CONSTRAINT_NAME RELC1_CONSTRAINT_NAME, ' +
1792	<	'  RELC2.RDB$INDEX_NAME RELC2_INDEX_NAME ' +
1793	<	'FROM RDB$REF_CONSTRAINTS REFC, RDB$RELATION_CONSTRAINTS RELC1, ' +
1794	<	'     RDB$RELATION_CONSTRAINTS RELC2 ' +
1795	<	'WHERE ' +
1796	<	'  RELC1.RDB$RELATION_NAME = :TableName AND ' +
1797	<	'  RELC1.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'' AND ' +
1798	<	'  REFC.RDB$CONST_NAME_UQ = RELC2.RDB$CONSTRAINT_NAME AND ' +
1799	<	'  REFC.RDB$CONSTRAINT_NAME = RELC1.RDB$CONSTRAINT_NAME AND ' +
1800	<	'  (RELC2.RDB$CONSTRAINT_TYPE = ''UNIQUE'' OR ' +
1801	<	'    RELC2.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'') ' +
1802	<	'ORDER BY RELC1.RDB$RELATION_NAME, RELC1.RDB$CONSTRAINT_NAME';
1803	<
1804	<	ForeignByNameSQL =
1805	<	'SELECT REFC.RDB$UPDATE_RULE REFC_UPDATE_RULE, REFC.RDB$DELETE_RULE REFC_DELETE_RULE, ' +
1806	<	'  RELC1.RDB$RELATION_NAME RELC1_RELATION_NAME, RELC2.RDB$RELATION_NAME RELC2_RELATION_NAME, ' +
1807	<	'  RELC1.RDB$INDEX_NAME RELC1_INDEX_NAME, RELC1.RDB$CONSTRAINT_NAME RELC1_CONSTRAINT_NAME, ' +
1808	<	'  RELC2.RDB$INDEX_NAME RELC2_INDEX_NAME ' +
1809	<	'FROM RDB$REF_CONSTRAINTS REFC, RDB$RELATION_CONSTRAINTS RELC1, ' +
1810	<	'     RDB$RELATION_CONSTRAINTS RELC2 ' +
1811	<	'WHERE ' +
1812	<	'  RELC1.RDB$CONSTRAINT_NAME = :ConstraintName AND ' +
1813	<	'  RELC1.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'' AND ' +
1814	<	'  REFC.RDB$CONST_NAME_UQ = RELC2.RDB$CONSTRAINT_NAME AND ' +
1815	<	'  REFC.RDB$CONSTRAINT_NAME = RELC1.RDB$CONSTRAINT_NAME AND ' +
1816	<	'  (RELC2.RDB$CONSTRAINT_TYPE = ''UNIQUE'' OR ' +
1817	<	'    RELC2.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'') ' +
1818	<	'ORDER BY RELC1.RDB$RELATION_NAME, RELC1.RDB$CONSTRAINT_NAME';
1819	<
1820	<	var
1821	<	qryForeign : TIBSQL;
1822	<	Line : String;
1823	<
1824	<	begin
1825	<	qryForeign := TIBSQL.Create(FDatabase);
1826	<	try
1827	<	if ObjectName = '' then
1828	<	qryForeign.SQL.Text := ForeignSQL
1829	<	else
1830	<	begin
1831	<	if ExtractType = etTable then
1832	<	begin
1833	<	qryForeign.SQL.Text := ForeignNameSQL;
1834	<	qryForeign.Params.ByName('TableName').AsString := ObjectName;
1835	<	end
1836	<	else
1837	<	begin
1838	<	qryForeign.SQL.Text := ForeignByNameSQL;
1839	<	qryForeign.Params.ByName('ConstraintName').AsString := ObjectName;
1840	<	end;
1841	<	end;
1842	<	qryForeign.ExecQuery;
1843	<	while not qryForeign.Eof do
1844	<	begin
1845	<	Line := Format('ALTER TABLE %s ADD ', [QuoteIdentifier(FDatabase.SQLDialect,
1846	<	qryForeign.FieldByName('RELC1_RELATION_NAME').AsString)]);
1847	<
1848	<	{ If the name of the constraint is not INTEG..., print it.
1849	<	INTEG... are internally generated names. }
1850	<	if (not qryForeign.FieldByName('RELC1_CONSTRAINT_NAME').IsNull) and
1851	<	( Pos('INTEG', qryForeign.FieldByName('RELC1_CONSTRAINT_NAME').AsString) <> 1) then
1852	<	Line := Line + Format('CONSTRAINT %s ', [QuoteIdentifier(FDatabase.SQLDialect,
1853	<	Trim(qryForeign.FieldByName('RELC1_CONSTRAINT_NAME').AsString))]);
1854	<
1855	<	Line := Line + Format('FOREIGN KEY (%s) REFERENCES %s ', [
1856	<	GetIndexSegments(qryForeign.FieldByName('RELC1_INDEX_NAME').AsString),
1857	<	Trim(qryForeign.FieldByName('RELC2_RELATION_NAME').AsString)]);
1858	<
1859	<	Line := Line + Format('(%s)',
1860	<	[GetIndexSegments(qryForeign.FieldByName('RELC2_INDEX_NAME').AsString)]);
1861	<
1862	<	{ Add the referential actions, if any }
1863	<	if (not qryForeign.FieldByName('REFC_UPDATE_RULE').IsNull) and
1864	<	(Trim(qryForeign.FieldByName('REFC_UPDATE_RULE').AsString) <> 'RESTRICT') then
1865	<	Line := Line + Format(' ON UPDATE %s',
1866	<	[Trim(qryForeign.FieldByName('REFC_UPDATE_RULE').AsString)]);
1867	<
1868	<	if (not qryForeign.FieldByName('REFC_DELETE_RULE').IsNull) and
1869	<	(Trim(qryForeign.FieldByName('REFC_DELETE_RULE').AsString) <> 'RESTRICT') then
1870	<	Line := Line + Format(' ON DELETE %s',
1871	<	[Trim(qryForeign.FieldByName('REFC_DELETE_RULE').AsString)]);
1872	<
1873	<	Line := Line + Term;
1874	<	FMetaData.Add(Line);
1875	<	qryForeign.Next;
1876	<	end;
1877	<	finally
1878	<	qryForeign.Free;
1879	<	end;
1880	<	end;
1881	<
1882	<	{    ListFunctions
1883	<
1884	<	Functional description
1885	<	List all external functions
1886	<
1887	<	Parameters:  none
1888	<	Results in
1889	<	DECLARE EXTERNAL FUNCTION function_name
1890	<	CHAR [256] , INTEGER, ....
1891	<	RETURNS INTEGER BY VALUE
1892	<	ENTRY_POINT entrypoint MODULE_NAME module; }
1893	<
1894	<	procedure TIBExtract.ListFunctions(FunctionName : String = '');
1895	<	const
1896	<	FunctionSQL =
1897	<	'SELECT * FROM RDB$FUNCTIONS ' +
1898	<	'ORDER BY RDB$FUNCTION_NAME';
1899	<
1900	<	FunctionNameSQL =
1901	<	'SELECT * FROM RDB$FUNCTIONS ' +
1902	<	'WHERE RDB$FUNCTION_NAME = :FunctionName ' +
1903	<	'ORDER BY RDB$FUNCTION_NAME';
1904	<
1905	<	FunctionArgsSQL =
1906	<	'SELECT * FROM RDB$FUNCTION_ARGUMENTS ' +
1907	<	'WHERE ' +
1908	<	'  :FUNCTION_NAME = RDB$FUNCTION_NAME ' +
1909	<	'ORDER BY RDB$ARGUMENT_POSITION';
1910	<
1911	<	FuncArgsPosSQL =
1912	<	'SELECT * FROM RDB$FUNCTION_ARGUMENTS ' +
1913	<	'WHERE ' +
1914	<	'  RDB$FUNCTION_NAME = :RDB$FUNCTION_NAME AND ' +
1915	<	'  RDB$ARGUMENT_POSITION = :RDB$ARGUMENT_POSITION';
1916	<
1917	<	CharSetSQL =
1918	<	'SELECT * FROM RDB$CHARACTER_SETS ' +
1919	<	'WHERE ' +
1920	<	'  RDB$CHARACTER_SET_ID = :CHARACTER_SET_ID';
1921	<
1922	<	var
1923	<	qryFunctions, qryFuncArgs, qryCharSets, qryFuncPos : TIBSQL;
1924	<	First, FirstArg, DidCharset, PrecisionKnown : Boolean;
1925	<	ReturnBuffer, TypeBuffer, Line : String;
1926	<	i, FieldType : Integer;
1927	<	begin
1928	<	First := true;
1929	<	qryFunctions := TIBSQL.Create(FDatabase);
1930	<	qryFuncArgs := TIBSQL.Create(FDatabase);
1931	<	qryFuncPos := TIBSQL.Create(FDatabase);
1932	<	qryCharSets := TIBSQL.Create(FDatabase);
1933	<	try
1934	<	if FunctionName = '' then
1935	<	qryFunctions.SQL.Text := FunctionSQL
1936	<	else
1937	<	begin
1938	<	qryFunctions.SQL.Text := FunctionNameSQL;
1939	<	qryFunctions.Params.ByName('FunctionName').AsString := FunctionName;
1940	<	end;
1941	<	qryFuncArgs.SQL.Text := FunctionArgsSQL;
1942	<	qryFuncPos.SQL.Text := FuncArgsPosSQL;
1943	<	qryCharSets.SQL.Text := CharSetSQL;
1944	<	qryFunctions.ExecQuery;
1945	<	while not qryFunctions.Eof do
1946	<	begin
1947	<	if First then
1948	<	begin
1949	<	FMEtaData.Add(Format('%s/*  External Function declarations */%s',
1950	<	[NEWLINE, NEWLINE]));
1951	<	First := false;
1952	<	end; //end_if
1953	<	{ Start new function declaration }
1954	<	FMetaData.Add(Format('DECLARE EXTERNAL FUNCTION %s',
1955	<	[qryFunctions.FieldByName('RDB$FUNCTION_NAME').AsString]));
1956	<	Line := '';
1957	<
1958	<	FirstArg := true;
1959	<	qryFuncArgs.Params.ByName('FUNCTION_NAME').AsString :=
1960	<	qryFunctions.FieldByName('RDB$FUNCTION_NAME').AsString;
1961	<
1962	<	qryFuncArgs.ExecQuery;
1963	<	while not qryFuncArgs.Eof do
1964	<	begin
1965	<	{ Find parameter type }
1966	<	i := 0;
1967	<	FieldType := qryFuncArgs.FieldByName('RDB$FIELD_TYPE').AsInteger;
1968	<	while FieldType <> ColumnTypes[i].SQLType do
1969	<	Inc(i);
1970	<
1971	<	{ Print length where appropriate }
1972	<	if FieldType in [ blr_text, blr_varying, blr_cstring] then
1973	<	begin
1974	<	DidCharset := false;
1975	<
1976	<	qryCharSets.Params.ByName('CHARACTER_SET_ID').AsString :=
1977	<	qryFuncArgs.FieldByName('RDB$CHARACTER_SET_ID').AsString;
1978	<	qryCharSets.ExecQuery;
1979	<	while not qryCharSets.Eof do
1980	<	begin
1981	<	DidCharset := true;
1982	<	TypeBuffer := Format('%s(%d) CHARACTER SET %s',
1983	<	[ColumnTypes[i].TypeName,
1984	<	qryFuncArgs.FieldByName('RDB$FIELD_LENGTH').AsInteger div
1985	<	Max(1,qryCharSets.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger),
1986	<	qryCharSets.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
1987	<	qryCharSets.Next;
1988	<	end;
1989	<	qryCharSets.Close;
1990	<	if not DidCharset then
1991	<	TypeBuffer := Format('%s(%d)', [ColumnTypes[i].TypeName,
1992	<	qryFuncArgs.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
1993	<	end //end_if
1994	<	else
1995	<	begin
1996	<	PrecisionKnown := false;
1997	<	if (FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10) and
1998	<	(FieldType in [blr_short, blr_long, blr_int64]) then
1999	<	begin
2000	<	qryFuncPos.Params.ByName('RDB$FUNCTION_NAME').AsString :=
2001	<	qryFuncArgs.FieldByName('RDB$FUNCTION_NAME').AsString;
2002	<	qryFuncPos.Params.ByName('RDB$ARGUMENT_POSITION').AsInteger :=
2003	<	qryFuncArgs.FieldByName('RDB$ARGUMENT_POSITION').AsInteger;
2004	<
2005	<	qryFuncPos.ExecQuery;
2006	<	while not qryFuncPos.Eof do
2007	<	begin
2008	<	{ We are ODS >= 10 and could be any Dialect }
2009	<	if not qryFuncPos.FieldByName('RDB$FIELD_PRECISION').IsNull then
2010	<	begin
2011	<	{ We are Dialect >=3 since FIELD_PRECISION is non-NULL }
2012	<	if (qryFuncPos.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
2013	<	(qryFuncPos.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
2014	<	begin
2015	<	TypeBuffer := Format('%s(%d, %d)',
2016	<	[IntegralSubtypes[qryFuncPos.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
2017	<	qryFuncPos.FieldByName('RDB$FIELD_PRECISION').AsInteger,
2018	<	-qryFuncPos.FieldByName('RDB$FIELD_SCALE').AsInteger] );
2019	<	PrecisionKnown := true;
2020	<	end; //end_if
2021	<	end; { if field_precision is not null }
2022	<	qryFuncPos.Next;
2023	<	end;
2024	<	qryFuncPos.Close;
2025	<	end; { if major_ods >= ods_version10 && }
2026	<	if not PrecisionKnown then
2027	<	begin
2028	<	{ Take a stab at numerics and decimals }
2029	<	if (FieldType = blr_short) and
2030	<	(qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2031	<	TypeBuffer := Format('NUMERIC(4, %d)',
2032	<	[-qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger])
2033	<	else
2034	<	if (FieldType = blr_long) and
2035	<	(qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2036	<	TypeBuffer := Format('NUMERIC(9, %d)',
2037	<	[-qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger])
2038	<	else
2039	<	if (FieldType = blr_double) and
2040	<	(qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2041	<	TypeBuffer := Format('NUMERIC(15, %d)',
2042	<	[-qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger])
2043	<	else
2044	<	TypeBuffer := ColumnTypes[i].TypeName;
2045	<	end; { if  not PrecisionKnown  }
2046	<	end; { if FCHAR or VARCHAR or CSTRING ... else }
2047	<
2048	<	if qryFunctions.FieldByName('RDB$RETURN_ARGUMENT').AsInteger =
2049	<	qryFuncArgs.FieldByName('RDB$ARGUMENT_POSITION').AsInteger then
2050	<	begin
2051	<	ReturnBuffer := 'RETURNS ' + TypeBuffer;
2052	<	if qryFuncArgs.FieldByName('RDB$MECHANISM').AsInteger = 0 then
2053	<	ReturnBuffer := ReturnBuffer + ' BY VALUE ';
2054	<	if qryFuncArgs.FieldByName('RDB$MECHANISM').AsInteger < 0 then
2055	<	ReturnBuffer := ReturnBuffer + ' FREE_IT';
2056	<	end
2057	<	else
2058	<	begin
2059	<	{ First arg needs no comma }
2060	<	if FirstArg then
2061	<	begin
2062	<	Line := Line + TypeBuffer;
2063	<	FirstArg := false;
2064	<	end
2065	<	else
2066	<	Line := Line + ', ' + TypeBuffer;
2067	<	end; //end_else
2068	<	qryFuncArgs.Next;
2069	<	end;
2070	<	qryFuncArgs.Close;
2071	<
2072	<	FMetaData.Add(Line);
2073	<	FMetaData.Add(ReturnBuffer);
2074	<	FMetaData.Add(Format('ENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%s%s',
2075	<	[qryFunctions.FieldByName('RDB$ENTRYPOINT').AsString,
2076	<	qryFunctions.FieldByName('RDB$MODULE_NAME').AsString,
2077	<	Term, NEWLINE, NEWLINE]));
2078	<
2079	<	qryFunctions.Next;
2080	<	end;
2081	<	finally
2082	<	qryFunctions.Free;
2083	<	qryFuncArgs.Free;
2084	<	qryCharSets.Free;
2085	<	qryFuncPos.Free;
2086	<	end;
2087	<	end;
2088	<
2089	<	{  ListGenerators
2090	<	Functional description
2091	<	Re create all non-system generators }
2092	<
2093	<	procedure TIBExtract.ListGenerators(GeneratorName : String = '');
2094	<	const
2095	<	GeneratorSQL =
2096	<	'SELECT RDB$GENERATOR_NAME ' +
2097	<	'FROM RDB$GENERATORS ' +
2098	<	'WHERE ' +
2099	<	'  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2100	<	'ORDER BY RDB$GENERATOR_NAME';
2101	<
2102	<	GeneratorNameSQL =
2103	<	'SELECT RDB$GENERATOR_NAME ' +
2104	<	'FROM RDB$GENERATORS ' +
2105	<	'WHERE RDB$GENERATOR_NAME = :GeneratorName AND ' +
2106	<	'  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2107	<	'ORDER BY RDB$GENERATOR_NAME';
2108	<
2109	<	var
2110	<	qryGenerator : TIBSQL;
2111	<	GenName : String;
2112	<	begin
2113	<	qryGenerator := TIBSQL.Create(FDatabase);
2114	<	try
2115	<	if GeneratorName = '' then
2116	<	qryGenerator.SQL.Text := GeneratorSQL
2117	<	else
2118	<	begin
2119	<	qryGenerator.SQL.Text := GeneratorNameSQL;
2120	<	qryGenerator.Params.ByName('GeneratorName').AsString := GeneratorName;
2121	<	end;
2122	<	qryGenerator.ExecQuery;
2123	<	FMetaData.Add('');
2124	<	while not qryGenerator.Eof do
2125	<	begin
2126	<	GenName := qryGenerator.FieldByName('RDB$GENERATOR_NAME').AsString;
2127	<	if ((Pos('RDB$',GenName) = 1) and
2128	<	(GenName[5] in ['0'..'9'])) or
2129	<	((Pos('SQL$',GenName) = 1) and
2130	<	(GenName[5] in ['0'..'9'])) then
2131	<	begin
2132	<	qryGenerator.Next;
2133	<	continue;
2134	<	end;
2135	<	FMetaData.Add(Format('CREATE GENERATOR %s%s',
2136	<	[QuoteIdentifier(FDatabase.SQLDialect, GenName),
2137	<	Term]));
2138	<	qryGenerator.Next;
2139	<	end;
2140	<	finally
2141	<	qryGenerator.Free;
2142	<	end;
2143	<	end;
2144	<
2145	<	{       ListIndex
2146	<	Functional description
2147	<	Define all non-constraint indices
2148	<	Use a static SQL query to get the info and print it.
2149	<
2150	<	Uses get_index_segment to provide a key list for each index }
2151	<
2152	<	procedure TIBExtract.ListIndex(ObjectName : String; ExtractType : TExtractType);
2153	<	const
2154	<	IndexSQL =
2155	<	'SELECT IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, IDX.RDB$UNIQUE_FLAG, ' +
2156	<	'       IDX.RDB$INDEX_TYPE ' +
2157	<	'FROM RDB$INDICES IDX JOIN RDB$RELATIONS RELC ON ' +
2158	<	'  IDX.RDB$RELATION_NAME = RELC.RDB$RELATION_NAME ' +
2159	<	'WHERE (RELC.RDB$SYSTEM_FLAG <> 1 OR RELC.RDB$SYSTEM_FLAG IS NULL) AND ' +
2160	<	'  NOT EXISTS (SELECT * FROM RDB$RELATION_CONSTRAINTS RC ' +
2161	<	'    WHERE RC.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME) ' +
2162	<	'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME';
2163	<
2164	<	IndexNameSQL =
2165	<	'SELECT IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, IDX.RDB$UNIQUE_FLAG, ' +
2166	<	'       IDX.RDB$INDEX_TYPE ' +
2167	<	'FROM RDB$INDICES IDX JOIN RDB$RELATIONS RELC ON ' +
2168	<	'  IDX.RDB$RELATION_NAME = RELC.RDB$RELATION_NAME ' +
2169	<	'WHERE (RELC.RDB$SYSTEM_FLAG <> 1 OR RELC.RDB$SYSTEM_FLAG IS NULL) AND ' +
2170	<	'  RELC.RDB$RELATION_NAME = :RelationName AND ' +
2171	<	'  NOT EXISTS (SELECT * FROM RDB$RELATION_CONSTRAINTS RC ' +
2172	<	'    WHERE RC.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME) ' +
2173	<	'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME';
2174	<
2175	<	IndexByNameSQL =
2176	<	'SELECT IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, IDX.RDB$UNIQUE_FLAG, ' +
2177	<	'       IDX.RDB$INDEX_TYPE ' +
2178	<	'FROM RDB$INDICES IDX JOIN RDB$RELATIONS RELC ON ' +
2179	<	'  IDX.RDB$RELATION_NAME = RELC.RDB$RELATION_NAME ' +
2180	<	'WHERE (RELC.RDB$SYSTEM_FLAG <> 1 OR RELC.RDB$SYSTEM_FLAG IS NULL) AND ' +
2181	<	'  IDX.RDB$INDEX_NAME = :IndexName AND ' +
2182	<	'  NOT EXISTS (SELECT * FROM RDB$RELATION_CONSTRAINTS RC ' +
2183	<	'    WHERE RC.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME) ' +
2184	<	'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME';
2185	<
2186	<	var
2187	<	qryIndex : TIBSQL;
2188	<	First : Boolean;
2189	<	Unique, IdxType, Line : String;
2190	<	begin
2191	<	First := true;
2192	<	qryIndex := TIBSQL.Create(FDatabase);
2193	<	try
2194	<	if ObjectName = '' then
2195	<	qryIndex.SQL.Text := IndexSQL
2196	<	else
2197	<	begin
2198	<	if ExtractType = etTable then
2199	<	begin
2200	<	qryIndex.SQL.Text := IndexNameSQL;
2201	<	qryIndex.Params.ByName('RelationName').AsString := ObjectName;
2202	<	end
2203	<	else
2204	<	begin
2205	<	qryIndex.SQL.Text := IndexByNameSQL;
2206	<	qryIndex.Params.ByName('IndexName').AsString := ObjectName;
2207	<	end;
2208	<	end;
2209	<	qryIndex.ExecQuery;
2210	<	while not qryIndex.Eof do
2211	<	begin
2212	<	if First then
2213	<	begin
2214	<	if ObjectName = '' then
2215	<	FMetaData.Add(NEWLINE + '/*  Index definitions for all user tables */' + NEWLINE)
2216	<	else
2217	<	FMetaData.Add(NEWLINE + '/*  Index definitions for ' + ObjectName + ' */' + NEWLINE);
2218	<	First := false;
2219	<	end; //end_if
2220	<
2221	<	if qryIndex.FieldByName('RDB$UNIQUE_FLAG').AsInteger = 1 then
2222	<	Unique := ' UNIQUE'
2223	<	else
2224	<	Unique := '';
2225	<
2226	<	if qryIndex.FieldByName('RDB$INDEX_TYPE').AsInteger = 1 then
2227	<	IdxType := ' DESCENDING'
2228	<	else
2229	<	IdxType := '';
2230	<
2231	<	Line := Format('CREATE%s%s INDEX %s ON %s(', [Unique, IdxType,
2232	<	QuoteIdentifier(FDataBase.SQLDialect,
2233	<	qryIndex.FieldByName('RDB$INDEX_NAME').AsString),
2234	<	QuoteIdentifier(FDataBase.SQLDialect,
2235	<	qryIndex.FieldByName('RDB$RELATION_NAME').AsString)]);
2236	<
2237	<	Line := Line + GetIndexSegments(qryIndex.FieldByName('RDB$INDEX_NAME').AsString) +
2238	<	')' + Term;
2239	<
2240	<	FMetaData.Add(Line);
2241	<	qryIndex.Next;
2242	<	end;
2243	<	finally
2244	<	qryIndex.Free;
2245	<	end;
2246	<	end;
2247	<
2248	<	{    ListViews
2249	<	Functional description
2250	<	Show text of views.
2251	<	Use a SQL query to get the info and print it.
2252	<	Note: This should also contain check option }
2253	<
2254	<	procedure TIBExtract.ListViews(ViewName : String);
2255	<	const
2256	<	ViewSQL =
2257	<	'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2258	<	'FROM RDB$RELATIONS ' +
2259	<	'WHERE ' +
2260	<	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2261	<	'  NOT RDB$VIEW_BLR IS NULL AND ' +
2262	<	'  RDB$FLAGS = 1 ' +
2263	<	'ORDER BY RDB$RELATION_ID';
2264	<
2265	<	ViewNameSQL =
2266	<	'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2267	<	'FROM RDB$RELATIONS ' +
2268	<	'WHERE ' +
2269	<	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2270	<	'  NOT RDB$VIEW_BLR IS NULL AND ' +
2271	<	'  RDB$FLAGS = 1 AND ' +
2272	<	'  RDB$RELATION_NAME = :ViewName ' +
2273	<	'ORDER BY RDB$RELATION_ID';
2274	<
2275	<	ColumnSQL =
2276	<	'SELECT RDB$FIELD_NAME FROM RDB$RELATION_FIELDS ' +
2277	<	'WHERE ' +
2278	<	'  RDB$RELATION_NAME = :RELATION_NAME ' +
2279	<	'ORDER BY RDB$FIELD_POSITION';
2280	<
2281	<	var
2282	<	qryView, qryColumns : TIBSQL;
2283	<	SList : TStrings;
2284	<	begin
2285	<	qryView := TIBSQL.Create(FDatabase);
2286	<	qryColumns := TIBSQL.Create(FDatabase);
2287	<	SList := TStringList.Create;
2288	<	try
2289	<	if ViewName = '' then
2290	<	qryView.SQL.Text := ViewSQL
2291	<	else
2292	<	begin
2293	<	qryView.SQL.Text := ViewNameSQL;
2294	<	qryView.Params.ByName('ViewName').AsString := ViewName;
2295	<	end;
2296	<	qryColumns.SQL.Text := ColumnSQL;
2297	<	qryView.ExecQuery;
2298	<	while not qryView.Eof do
2299	<	begin
2300	<	SList.Add(Format('%s/* View: %s, Owner: %s */%s',
2301	<	[NEWLINE, qryView.FieldByName('RDB$RELATION_NAME').AsString,
2302	<	qryView.FieldByName('RDB$OWNER_NAME').AsString, NEWLINE]));
2303	<
2304	<	SList.Add(Format('CREATE VIEW %s (', [QuoteIdentifier(FDatabase.SQLDialect,
2305	<	qryView.FieldByName('RDB$RELATION_NAME').AsString)]));
2306	<
2307	<	qryColumns.Params.ByName('RELATION_NAME').AsString :=
2308	<	qryView.FieldByName('RDB$RELATION_NAME').AsString;
2309	<	qryColumns.ExecQuery;
2310	<	while not qryColumns.Eof do
2311	<	begin
2312	<	SList.Add('  ' + QuoteIdentifier(FDatabase.SQLDialect,
2313	<	qryColumns.FieldByName('RDB$FIELD_NAME').AsString));
2314	<	qryColumns.Next;
2315	<	if not qryColumns.Eof then
2316	<	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + ', ';
2317	<	end;
2318	<	qryColumns.Close;
2319	<	SList.Text := SList.Text + Format(') AS%s', [NEWLINE]);
2320	<	if not qryView.FieldByName('RDB$VIEW_SOURCE').IsNull then
2321	<	SList.Text := SList.Text + qryView.FieldByName('RDB$VIEW_SOURCE').AsString;
2322	<	SList.Text := SList.Text + Format('%s%s', [Term, NEWLINE]);
2323	<	FMetaData.AddStrings(SList);
2324	<	SList.Clear;
2325	<	qryView.Next;
2326	<	end;
2327	<	finally
2328	<	qryView.Free;
2329	<	qryColumns.Free;
2330	<	SList.Free;
2331	<	end;
2332	<	end;
2333	<
2334	<	{    PrintSet
2335	<	Functional description
2336	<	print (using ISQL_printf) the word "SET"
2337	<	if the first line of the ALTER DATABASE
2338	<	settings options. Also, add trailing
2339	<	comma for end of prior line if needed.
2340	<
2341	<	uses Print_buffer, a global }
2342	<
2343	<	function TIBExtract.PrintSet(var Used: Boolean) : String;
2344	<	begin
2345	<	if not Used then
2346	<	begin
2347	<	Result := '  SET ';
2348	<	Used := true;
2349	<	end
2350	<	else
2351	<	Result := Format(', %s      ', [NEWLINE]);
2352	<	end;
2353	<
2354	<	{
2355	<	PrintValidation
2356	<	Functional description
2357	<	This does some minor syntax adjustmet for extracting
2358	<	validation blobs and computed fields.
2359	<	if it does not start with the word CHECK
2360	<	if this is a computed field blob,look for () or insert them.
2361	<	if flag = false, this is a validation clause,
2362	<	if flag = true, this is a computed field }
2363	<
2364	<	function TIBExtract.PrintValidation(ToValidate: String;
2365	<	flag: Boolean): String;
2366	<	var
2367	<	IsSQL : Boolean;
2368	<	begin
2369	<	IsSql := false;
2370	<
2371	<	Result := '';
2372	<	ToValidate := Trim(ToValidate);
2373	<
2374	<	if flag then
2375	<	begin
2376	<	if ToValidate[1] = '(' then
2377	<	IsSQL := true;
2378	<	end
2379	<	else
2380	<	if (Pos(ToValidate, 'check') = 1) or (Pos(ToValidate, 'CHECK') = 1) then
2381	<	IsSQL := TRUE;
2382	<
2383	<	if not IsSQL then
2384	<	begin
2385	<	if Flag then
2386	<	Result := Result + '/* ' + ToValidate + ' */'
2387	<	else
2388	<	Result := Result + '(' + ToValidate + ')';
2389	<	end
2390	<	else
2391	<	Result := ToValidate;
2392	<	end;
2393	<
2394	<	procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2395	<	begin
2396	<	if FDatabase <> Value then
2397	<	begin
2398	<	FDatabase := Value;
2399	<	if (not Assigned(FTransaction)) and (FDatabase <> nil) then
2400	<	Transaction := FDatabase.DefaultTransaction;
2401	<	FDatabaseInfo.Database := FDatabase;
2402	<	end;
2403	<	end;
2404	<
2405	<	procedure TIBExtract.SetTransaction(const Value: TIBTransaction);
2406	<	begin
2407	<	if FTransaction <> Value then
2408	<	begin
2409	<	FTransaction := Value;
2410	<	if (not Assigned(FDatabase)) and (FTransaction <> nil) then
2411	<	Database := FTransaction.DefaultDatabase;
2412	<	end;
2413	<	end;
2414	<
2415	<	procedure TIBExtract.ExtractObject(ObjectType : TExtractObjectTypes;
2416	<	ObjectName : String = ''; ExtractTypes : TExtractTypes = []);
2417	<	var
2418	<	DidActivate : Boolean;
2419	<	begin
2420	<	DidActivate := false;
2421	<	if not FTransaction.Active then
2422	<	begin
2423	<	FTransaction.StartTransaction;
2424	<	DidActivate := true;
2425	<	end;
2426	<	FMetaData.Clear;
2427	<	case ObjectType of
2428	<	eoDatabase : ExtractDDL(true, '');
2429	<	eoDomain :
2430	<	if etTable in ExtractTypes then
2431	<	ListDomains(ObjectName, etTable)
2432	<	else
2433	<	ListDomains(ObjectName);
2434	<	eoTable :
2435	<	begin
2436	<	if ObjectName <> '' then
2437	<	begin
2438	<	if etDomain in ExtractTypes then
2439	<	ListDomains(ObjectName, etTable);
2440	<	ExtractListTable(ObjectName, '', false);
2441	<	if etIndex in ExtractTypes then
2442	<	ListIndex(ObjectName, etTable);
2443	<	if etForeign in ExtractTypes then
2444	<	ListForeign(ObjectName, etTable);
2445	<	if etCheck in ExtractTypes then
2446	<	ListCheck(ObjectName, etTable);
2447	<	if etTrigger in ExtractTypes then
2448	<	ListTriggers(ObjectName, etTable);
2449	<	if etGrant in ExtractTypes then
2450	<	ShowGrants(ObjectName, Term);
2451	<	if etData in ExtractTypes then
2452	<	ListData(ObjectName);
2453	<	end
2454	<	else
2455	<	ListAllTables(true);
2456	<	end;
2457	<	eoView : ListViews(ObjectName);
2458	<	eoProcedure : ListProcs(ObjectName);
2459	<	eoFunction : ListFunctions(ObjectName);
2460	<	eoGenerator : ListGenerators(ObjectName);
2461	<	eoException : ListException(ObjectName);
2462	<	eoBLOBFilter : ListFilters(ObjectName);
2463	<	eoRole : ListRoles(ObjectName);
2464	<	eoTrigger :
2465	<	if etTable in ExtractTypes then
2466	<	ListTriggers(ObjectName, etTable)
2467	<	else
2468	<	ListTriggers(ObjectName);
2469	<	eoForeign :
2470	<	if etTable in ExtractTypes then
2471	<	ListForeign(ObjectName, etTable)
2472	<	else
2473	<	ListForeign(ObjectName);
2474	<	eoIndexes :
2475	<	if etTable in ExtractTypes then
2476	<	ListIndex(ObjectName, etTable)
2477	<	else
2478	<	ListIndex(ObjectName);
2479	<	eoChecks :
2480	<	if etTable in ExtractTypes then
2481	<	ListCheck(ObjectName, etTable)
2482	<	else
2483	<	ListCheck(ObjectName);
2484	<	eoData : ListData(ObjectName);
2485	<	end;
2486	<	if DidActivate then
2487	<	FTransaction.Commit;
2488	<	end;
2489	<
2490	<	function TIBExtract.GetFieldType(FieldType, FieldSubType, FieldScale,
2491	<	FieldSize, FieldPrec, FieldLen: Integer): String;
2492	<	var
2493	<	i : Integer;
2494	<	PrecisionKnown : Boolean;
2495	<	begin
2496	<	Result := '';
2497	<	for i := Low(ColumnTypes) to High(ColumnTypes) do
2498	<	if FieldType = ColumnTypes[i].SQLType then
2499	<	begin
2500	<	PrecisionKnown := FALSE;
2501	<	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
2502	<	begin
2503	<	if FieldType in [blr_short, blr_long, blr_int64] then
2504	<	begin
2505	<	{ We are ODS >= 10 and could be any Dialect }
2506	<	if (FDatabaseInfo.DBSQLDialect >= 3) and
2507	<	(FieldPrec <> 0) and
2508	<	(FieldSubType > 0) and
2509	<	(FieldSubType <= MAX_INTSUBTYPES) then
2510	<	begin
2511	<	Result := Result + Format('%s(%d, %d)', [
2512	<	IntegralSubtypes [FieldSubType],
2513	<	FieldPrec,
2514	<	-1 * FieldScale]);
2515	<	PrecisionKnown := true;
2516	<	end;
2517	<	end;
2518	<	end;
2519	<	if PrecisionKnown = false then
2520	<	begin
2521	<	{ Take a stab at numerics and decimals }
2522	<	if (FieldType = blr_short) and
2523	<	(FieldScale < 0) then
2524	<	Result := Result + Format('NUMERIC(4, %d)',
2525	<	[-FieldScale] )
2526	<	else
2527	<	if (FieldType = blr_long) and
2528	<	(FieldScale < 0) then
2529	<	Result := Result + Format('NUMERIC(9, %d)',
2530	<	[-FieldScale] )
2531	<	else
2532	<	if (FieldType = blr_double) and
2533	<	(FieldScale  < 0) then
2534	<	Result := Result + Format('NUMERIC(15, %d)',
2535	<	[-FieldScale] )
2536	<	else
2537	<	Result := Result + ColumnTypes[i].TypeName;
2538	<	end;
2539	<	break;
2540	<	end;
2541	<	if (FieldType in [blr_text, blr_varying]) and
2542	<	(FieldSize <> 0) then
2543	<	Result := Result + Format('(%d)', [FieldSize]);
2544	<	end;
2545	<
2546	<	{  S H O W _ g r a n t s
2547	<	Functional description
2548	<	Show grants for given object name
2549	<	This function is also called by extract for privileges.
2550	<	It must extract granted privileges on tables/views to users,
2551	<	- these may be compound, so put them on the same line.
2552	<	Grant execute privilege on procedures to users
2553	<	Grant various privilegs to procedures.
2554	<	All privileges may have the with_grant option set. }
2555	<
2556	<	procedure TIBExtract.ShowGrants(MetaObject, Terminator: String);
2557	<	const
2558	<	{ This query only finds tables, eliminating owner privileges }
2559	<	OwnerPrivSQL =
2560	<	'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2561	<	'       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE ' +
2562	<	'FROM RDB$USER_PRIVILEGES PRV, RDB$RELATIONS REL ' +
2563	<	'WHERE ' +
2564	<	'  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2565	<	'  REL.RDB$RELATION_NAME = :METAOBJECT AND ' +
2566	<	'  PRV.RDB$PRIVILEGE <> ''M'' AND ' +
2567	<	'  REL.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2568	<	'ORDER BY  PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2569	<
2570	<	ProcPrivSQL =
2571	<	'SELECT PRV.RDB$USER, PRV.RDB$GRANT_OPTION, PRV.RDB$FIELD_NAME, ' +
2572	<	'       PRV.RDB$USER_TYPE, PRV.RDB$PRIVILEGE, PRV.RDB$RELATION_NAME ' +
2573	<	'FROM RDB$USER_PRIVILEGES PRV, RDB$PROCEDURES PRC ' +
2574	<	'where ' +
2575	<	'  PRV.RDB$OBJECT_TYPE = 5 AND ' +
2576	<	'  PRV.RDB$RELATION_NAME = :METAOBJECT AND ' +
2577	<	'  PRC.RDB$PROCEDURE_NAME = :METAOBJECT AND ' +
2578	<	'  PRV.RDB$PRIVILEGE = ''X'' AND ' +
2579	<	'  PRC.RDB$OWNER_NAME <> PRV.RDB$USER ' +
2580	<	'ORDER BY PRV.RDB$USER, PRV.RDB$FIELD_NAME, PRV.RDB$GRANT_OPTION';
2581	<
2582	<	RolePrivSQL =
2583	<	'SELECT * FROM RDB$USER_PRIVILEGES ' +
2584	<	'WHERE ' +
2585	<	'  RDB$OBJECT_TYPE = 13 AND ' +
2586	<	'  RDB$USER_TYPE = 8  AND ' +
2587	<	'  RDB$RELATION_NAME = :METAOBJECT AND ' +
2588	<	'  RDB$PRIVILEGE = ''M'' ' +
2589	<	'ORDER BY RDB$USER';
2590	<
2591	<	var
2592	<	PrevUser, PrevField,  WithOption,
2593	<	PrivString, ColString, UserString,
2594	<	FieldName, User : String;
2595	<	c : Char;
2596	<	PrevOption, PrivFlags, GrantOption : Integer;
2597	<	First, PrevFieldNull : Boolean;
2598	<	qryOwnerPriv : TIBSQL;
2599	<
2600	<	{  Given a bit-vector of privileges, turn it into a
2601	<	string list. }
2602	<	function MakePrivString(cflags : Integer) : String;
2603	<	var
2604	<	i : Integer;
2605	<	begin
2606	<	for i := Low(PrivTypes) to High(PrivTypes) do
2607	<	begin
2608	<	if (cflags and PrivTypes[i].PrivFlag) <> 0 then
2609	<	begin
2610	<	if Result <> '' then
2611	<	Result := Result + ', ';
2612	<	Result := Result + PrivTypes[i].PrivString;
2613	<	end; //end_if
2614	<	end; //end_for
2615	<	end; //end_fcn MakePrivDtring
2616	<
2617	<	begin
2618	<	if MetaObject = '' then
2619	<	exit;
2620	<
2621	<	First := true;
2622	<	PrevOption := -1;
2623	<	PrevUser := '';
2624	<	PrivString := '';
2625	<	ColString := '';
2626	<	WithOption := '';
2627	<	PrivFlags := 0;
2628	<	PrevFieldNull := false;
2629	<	PrevField := '';
2630	<
2631	<	qryOwnerPriv := TIBSQL.Create(FDatabase);
2632	<	try
2633	<	qryOwnerPriv.SQL.Text := OwnerPrivSQL;
2634	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2635	<	qryOwnerPriv.ExecQuery;
2636	<	while not qryOwnerPriv.Eof do
2637	<	begin
2638	<	{ Sometimes grant options are null, sometimes 0.  Both same }
2639	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').IsNull then
2640	<	GrantOption := 0
2641	<	else
2642	<	GrantOption := qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger;
2643	<
2644	<	if qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull then
2645	<	FieldName := ''
2646	<	else
2647	<	FieldName := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').AsString;
2648	<
2649	<	User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2650	<	{ Print a new grant statement for each new user or change of option }
2651	<
2652	<	if ((PrevUser <> '') and (PrevUser <> User)) or
2653	<	((Not First) and
2654	<	(PrevFieldNull <> qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull)) or
2655	<	((not PrevFieldNull) and (PrevField <> FieldName)) or
2656	<	((PrevOption <> -1) and (PrevOption <> GrantOption)) then
2657	<	begin
2658	<	PrivString := MakePrivString(PrivFlags);
2659	<
2660	<	First := false;
2661	<	FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2662	<	ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2663	<	UserString, WithOption, Terminator]));
2664	<	{ re-initialize strings }
2665	<
2666	<	PrivString := '';
2667	<	WithOption := '';
2668	<	ColString := '';
2669	<	PrivFlags := 0;
2670	<	end; //end_if
2671	<
2672	<	PrevUser := User;
2673	<	PrevOption := GrantOption;
2674	<	PrevFieldNull := qryOwnerPriv.FieldByName('RDB$FIELD_NAME').IsNull;
2675	<	PrevField := FieldName;
2676	<
2677	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2678	<	obj_relation,
2679	<	obj_view,
2680	<	obj_trigger,
2681	<	obj_procedure,
2682	<	obj_sql_role:
2683	<	UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2684	<	else
2685	<	UserString := User;
2686	<	end; //end_case
2687	<
2688	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2689	<	obj_view :
2690	<	UserString := 'VIEW ' + UserString;
2691	<	obj_trigger :
2692	<	UserString := 'TRIGGER '+ UserString;
2693	<	obj_procedure :
2694	<	UserString := 'PROCEDURE ' + UserString;
2695	<	end; //end_case
2696	<
2697	<	c := qryOwnerPriv.FieldByName('RDB$PRIVILEGE').AsString[1];
2698	<
2699	<	case c of
2700	<	'S' : PrivFlags := PrivFlags or priv_SELECT;
2701	<	'I' : PrivFlags := PrivFlags or priv_INSERT;
2702	<	'U' : PrivFlags := PrivFlags or priv_UPDATE;
2703	<	'D' : PrivFlags := PrivFlags or priv_DELETE;
2704	<	'R' : PrivFlags := PrivFlags or priv_REFERENCES;
2705	<	'X' : ;
2706	<	{ Execute should not be here -- special handling below }
2707	<	else
2708	<	PrivFlags := PrivFlags or priv_UNKNOWN;
2709	<	end; //end_switch
2710	<
2711	<	{ Column level privileges for update only }
2712	<
2713	<	if FieldName = '' then
2714	<	ColString := ''
2715	<	else
2716	<	ColString := Format(' (%s)', [QuoteIdentifier(FDatabase.SQLDialect, FieldName)]);
2717	<
2718	<	if GrantOption <> 0 then
2719	<	WithOption := ' WITH GRANT OPTION';
2720	<
2721	<	qryOwnerPriv.Next;
2722	<	end;
2723	<	{ Print last case if there was anything to print }
2724	<	if PrevOption <> -1 then
2725	<	begin
2726	<	PrivString := MakePrivString(PrivFlags);
2727	<	First := false;
2728	<	FMetaData.Add(Format('GRANT %s%s ON %s TO %s%s%s', [PrivString,
2729	<	ColString, QuoteIdentifier(FDatabase.SQLDialect, MetaObject),
2730	<	UserString, WithOption, Terminator]));
2731	<	{ re-initialize strings }
2732	<	end; //end_if
2733	<	qryOwnerPriv.Close;
2734	<
2735	<	if First then
2736	<	begin
2737	<	{ Part two is for stored procedures only }
2738	<	qryOwnerPriv.SQL.Text := ProcPrivSQL;
2739	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2740	<	qryOwnerPriv.ExecQuery;
2741	<	while not qryOwnerPriv.Eof do
2742	<	begin
2743	<	First := false;
2744	<	User := Trim(qryOwnerPriv.FieldByName('RDB$USER').AsString);
2745	<
2746	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2747	<	obj_relation,
2748	<	obj_view,
2749	<	obj_trigger,
2750	<	obj_procedure,
2751	<	obj_sql_role:
2752	<	UserString := QuoteIdentifier(FDatabase.SQLDialect, User);
2753	<	else
2754	<	UserString := User;
2755	<	end; //end_case
2756	<	case qryOwnerPriv.FieldByName('RDB$USER_TYPE').AsInteger of
2757	<	obj_view :
2758	<	UserString := 'VIEW ' + UserString;
2759	<	obj_trigger :
2760	<	UserString := 'TRIGGER '+ UserString;
2761	<	obj_procedure :
2762	<	UserString := 'PROCEDURE ' + UserString;
2763	<	end; //end_case
2764	<
2765	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2766	<	WithOption := ' WITH GRANT OPTION'
2767	<	else
2768	<	WithOption := '';
2769	<
2770	<	FMetaData.Add(Format('GRANT EXECUTE ON PROCEDURE %s TO %s%s%s',
2771	<	[QuoteIdentifier(FDatabase.SQLDialect, MetaObject), UserString,
2772	<	WithOption, terminator]));
2773	<
2774	<	qryOwnerPriv.Next;
2775	<	end;
2776	<	qryOwnerPriv.Close;
2777	<	end;
2778	<	if First then
2779	<	begin
2780	<	qryOwnerPriv.SQL.Text := RolePrivSQL;
2781	<	qryOwnerPriv.Params.ByName('metaobject').AsString := MetaObject;
2782	<	qryOwnerPriv.ExecQuery;
2783	<	while not qryOwnerPriv.Eof do
2784	<	begin
2785	<	if qryOwnerPriv.FieldByName('RDB$GRANT_OPTION').AsInteger = 1 then
2786	<	WithOption := ' WITH ADMIN OPTION'
2787	<	else
2788	<	WithOption := '';
2789	<
2790	<	FMetaData.Add(Format('GRANT %s TO %s%s%s',
2791	<	[QuoteIdentifier(FDatabase.SQLDialect, qryOwnerPriv.FieldByName('RDB$RELATION_NAME').AsString),
2792	<	qryOwnerPriv.FieldByName('RDB$USER_NAME').AsString,
2793	<	WithOption, terminator]));
2794	<
2795	<	qryOwnerPriv.Next;
2796	<	end;
2797	<	end;
2798	<	qryOwnerPriv.Close;
2799	<	finally
2800	<	qryOwnerPriv.Free;
2801	<	end;
2802	<	end;
2803	<
2804	<	{         ShowGrantRoles
2805	<	Functional description
2806	<	Show grants for given role name
2807	<	This function is also called by extract for privileges.
2808	<	All membership privilege may have the with_admin option set. }
2809	<
2810	<	procedure TIBExtract.ShowGrantRoles(Terminator: String);
2811	<	const
2812	<	RoleSQL =
2813	<	'SELECT RDB$USER, RDB$GRANT_OPTION, RDB$RELATION_NAME ' +
2814	<	'FROM RDB$USER_PRIVILEGES ' +
2815	<	'WHERE ' +
2816	<	'  RDB$OBJECT_TYPE = %d AND ' +
2817	<	'  RDB$USER_TYPE = %d AND ' +
2818	<	'  RDB$PRIVILEGE = ''M'' ' +
2819	<	'ORDER BY  RDB$RELATION_NAME, RDB$USER';
2820	<
2821	<	var
2822	<	WithOption, UserString : String;
2823	<	qryRole : TIBSQL;
2824	<
2825	<	begin
2826	<	qryRole := TIBSQL.Create(FDatabase);
2827	<	try
2828	<	qryRole.SQL.Text := Format(RoleSQL, [obj_sql_role, obj_user]);
2829	<	qryRole.ExecQuery;
2830	<	while not qryRole.Eof do
2831	<	begin
2832	<	UserString := Trim(qryRole.FieldByName('RDB$USER').AsString);
2833	<
2834	<	if (not qryRole.FieldByName('RDB$GRANT_OPTION').IsNull) and
2835	<	(qryRole.FieldByName('RDB$GRANT_OPTION').AsInteger = 1) then
2836	<	WithOption := ' WITH ADMIN OPTION'
2837	<	else
2838	<	WithOption := '';
2839	<	FMetaData.Add(Format('GRANT %s TO %s%s%s%s',
2840	<	[ QuoteIdentifier(FDatabase.SQLDialect, qryRole.FieldByName('RDB$RELATION_NAME').AsString),
2841	<	UserString, WithOption, Terminator, NEWLINE]));
2842	<
2843	<	qryRole.Next;
2844	<	end;
2845	<	finally
2846	<	qryRole.Free;
2847	<	end;
2848	<	end;
2849	<
2850	<	{                   GetProcedureArgs
2851	<	Functional description
2852	<	This function extract the procedure parameters and adds it to the
2853	<	extract file }
2854	<
2855	<	procedure TIBExtract.GetProcedureArgs(Proc: String);
2856	<	const
2857	<	{ query to retrieve the input parameters. }
2858	<	ProcHeaderSQL =
2859	<	'SELECT * ' +
2860	<	' FROM RDB$PROCEDURE_PARAMETERS PRM JOIN RDB$FIELDS FLD ON ' +
2861	<	' PRM.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +
2862	<	'WHERE ' +
2863	<	'    PRM.RDB$PROCEDURE_NAME = :PROCNAME AND ' +
2864	<	'    PRM.RDB$PARAMETER_TYPE = :Input ' +
2865	<	'ORDER BY PRM.RDB$PARAMETER_NUMBER';
2866	<
2867	<	var
2868	<	FirstTime, PrecisionKnown : Boolean;
2869	<	Line : String;
2870	<	qryHeader : TIBSQL;
2871	<
2872	<	function FormatParamStr : String;
2873	<	var
2874	<	i, CollationID, CharSetID : Integer;
2875	<	begin
2876	<	Result := Format('  %s ', [qryHeader.FieldByName('RDB$PARAMETER_NAME').AsString]);
2877	<	for i := Low(ColumnTypes) to High(ColumnTypes) do
2878	<	if qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = ColumnTypes[i].SQLType then
2879	<	begin
2880	<	PrecisionKnown := FALSE;
2881	<	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
2882	<	begin
2883	<	if qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_short, blr_long, blr_int64] then
2884	<	begin
2885	<	{ We are ODS >= 10 and could be any Dialect }
2886	<	if (FDatabaseInfo.DBSQLDialect >= 3) and
2887	<	(not qryHeader.FieldByName('RDB$FIELD_PRECISION').IsNull) and
2888	<	(qryHeader.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
2889	<	(qryHeader.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
2890	<	begin
2891	<	Result := Result + Format('%s(%d, %d)', [
2892	<	IntegralSubtypes [qryHeader.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
2893	<	qryHeader.FieldByName('RDB$FIELD_PRECISION').AsInteger,
2894	<	-1 * qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger]);
2895	<	PrecisionKnown := true;
2896	<	end;
2897	<	end;
2898	<	end;
2899	<	if PrecisionKnown = false then
2900	<	begin
2901	<	{ Take a stab at numerics and decimals }
2902	<	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_short) and
2903	<	(qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2904	<	Result := Result + Format('NUMERIC(4, %d)',
2905	<	[-qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger] )
2906	<	else
2907	<	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_long) and
2908	<	(qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2909	<	Result := Result + Format('NUMERIC(9, %d)',
2910	<	[-qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger] )
2911	<	else
2912	<	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_double) and
2913	<	(qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger  < 0) then
2914	<	Result := Result + Format('NUMERIC(15, %d)',
2915	<	[-qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger] )
2916	<	else
2917	<	Result := Result + ColumnTypes[i].TypeName;
2918	<	end;
2919	<	break;
2920	<	end;
2921	<	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_text, blr_varying]) and
2922	<	(not qryHeader.FieldByName('RDB$CHARACTER_LENGTH').IsNull) then
2923	<	Result := Result + Format('(%d)', [qryHeader.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
2924	<
2925	<	{ Show international character sets and collations }
2926	<
2927	<	if (not qryHeader.FieldByName('RDB$COLLATION_ID').IsNull) or
2928	<	(not qryHeader.FieldByName('RDB$CHARACTER_SET_ID').IsNull) then
2929	<	begin
2930	<	if qryHeader.FieldByName('RDB$COLLATION_ID').IsNull then
2931	<	CollationId := 0
2932	<	else
2933	<	CollationId := qryHeader.FieldByName('RDB$COLLATION_ID').AsInteger;
2934	<
2935	<	if qryHeader.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
2936	<	CharSetId := 0
2937	<	else
2938	<	CharSetId := qryHeader.FieldByName('RDB$CHARACTER_SET_ID').AsInteger;
2939	<
2940	<	Result := Result + GetCharacterSets(CharSetId, CollationId, false);
2941	<	end;
2942	<	end;
2943	<
2944	<	begin
2945	<	FirstTime := true;
2946	<	qryHeader := TIBSQL.Create(FDatabase);
2947	<	try
2948	<	qryHeader.SQL.Text := ProcHeaderSQL;
2949	<	qryHeader.Params.ByName('procname').AsString := Proc;
2950	<	qryHeader.Params.ByName('Input').AsInteger := 0;
2951	<	qryHeader.ExecQuery;
2952	<	while not qryHeader.Eof do
2953	<	begin
2954	<	if FirstTime then
2955	<	begin
2956	<	FirstTime := false;
2957	<	FMetaData.Add('(');
2958	<	end;
2959	<
2960	<	Line := FormatParamStr;
2961	<
2962	<	qryHeader.Next;
2963	<	if not qryHeader.Eof then
2964	<	Line := Line + ',';
2965	<	FMetaData.Add(Line);
2966	<	end;
2967	<
2968	<	{ If there was at least one param, close parens }
2969	<	if not FirstTime then
2970	<	begin
2971	<	FMetaData.Add( ')');
2972	<	end;
2973	<
2974	<	FirstTime := true;
2975	<	qryHeader.Close;
2976	<	qryHeader.Params.ByName('Input').AsInteger := 1;
2977	<	qryHeader.ExecQuery;
2978	<
2979	<	while not qryHeader.Eof do
2980	<	begin
2981	<	if FirstTime then
2982	<	begin
2983	<	FirstTime := false;
2984	<	FMetaData.Add('RETURNS' + NEWLINE + '(');
2985	<	end;
2986	<
2987	<	Line := FormatParamStr;
2988	<
2989	<	qryHeader.Next;
2990	<	if not qryHeader.Eof then
2991	<	Line := Line + ',';
2992	<	FMetaData.Add(Line);
2993	<	end;
2994	<
2995	<	{ If there was at least one param, close parens }
2996	<	if not FirstTime then
2997	<	begin
2998	<	FMetaData.Add( ')');
2999	<	end;
3000	<
3001	<	FMetaData.Add('AS');
3002	<	finally
3003	<	qryHeader.Free;
3004	<	end;
3005	<	end;
3006	<
3007	<	procedure TIBExtract.Notification(AComponent: TComponent;
3008	<	Operation: TOperation);
3009	<	begin
3010	<	inherited;
3011	<	if (AComponent = FDatabase) and (Operation = opRemove) then
3012	<	FDatabase := nil;
3013	<	if (AComponent = FTransaction) and (Operation = opRemove) then
3014	<	FTransaction := nil;
3015	<	end;
3016	<
3017	<	procedure TIBExtract.ListData(ObjectName: String);
3018	<	const
3019	<	SelectSQL = 'SELECT * FROM %s';
3020	<	var
3021	<	qrySelect : TIBSQL;
3022	<	Line : String;
3023	<	i : Integer;
3024	<	begin
3025	<	qrySelect := TIBSQL.Create(FDatabase);
3026	<	try
3027	<	qrySelect.SQL.Text := Format(SelectSQL,
3028	<	[QuoteIdentifier(FDatabase.SQLDialect, ObjectName)]);
3029	<	qrySelect.ExecQuery;
3030	<	while not qrySelect.Eof do
3031	<	begin
3032	<	Line := 'INSERT INTO ' + QuoteIdentifier(FDatabase.SQLDialect, ObjectName) + ' (';
3033	<	for i := 0 to qrySelect.Current.Count - 1 do
3034	<	if (qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3035	<	(qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3036	<	begin
3037	<	Line := Line + QuoteIdentifier(FDatabase.SQLDialect, qrySelect.Fields[i].Name);
3038	<	if i <> (qrySelect.Current.Count - 1) then
3039	<	Line := Line + ', ';
3040	<	end;
3041	<	Line := Line + ') VALUES (';
3042	<	for i := 0 to qrySelect.Current.Count - 1 do
3043	<	begin
3044	<	if qrySelect.Fields[i].IsNull and
3045	<	(qrySelect.Fields[i].SQLType <> SQL_ARRAY) and
3046	<	(qrySelect.Fields[i].SQLType <> SQL_BLOB) then
3047	<	begin
3048	<	Line := Line + 'NULL';
3049	<	if i <> (qrySelect.Current.Count - 1) then
3050	<	Line := Line + ', ';
3051	<	end
3052	<	else
3053	<	case qrySelect.Fields[i].SQLType of
3054	<	SQL_TEXT, SQL_VARYING, SQL_TYPE_DATE,
3055	<	SQL_TYPE_TIME, SQL_TIMESTAMP :
3056	<	begin
3057	<	Line := Line + QuotedStr(qrySelect.Fields[i].AsString);
3058	<	if i <> (qrySelect.Current.Count - 1) then
3059	<	Line := Line + ', ';
3060	<	end;
3061	<	SQL_SHORT, SQL_LONG, SQL_INT64,
3062	<	SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN:
3063	<	begin
3064	<	Line := Line + qrySelect.Fields[i].AsString;
3065	<	if i <> (qrySelect.Current.Count - 1) then
3066	<	Line := Line + ', ';
3067	<	end;
3068	<	SQL_ARRAY, SQL_BLOB : ;
3069	<	else
3070	<	IBError(ibxeInvalidDataConversion, [nil]);
3071	<	end;
3072	<	end;
3073	<	Line := Line + ')' + Term;
3074	<	FMetaData.Add(Line);
3075	<	qrySelect.Next;
3076	<	end;
3077	<	finally
3078	<	qrySelect.Free;
3079	<	end;
3080	<	end;
3081	<
3082	<	procedure TIBExtract.ListRoles(ObjectName: String);
3083	<	const
3084	<	RolesSQL =
3085	<	'select * from RDB$ROLES ' +
3086	<	'order by RDB$ROLE_NAME';
3087	<
3088	<	RolesByNameSQL =
3089	<	'select * from RDB$ROLES ' +
3090	<	'WHERE RDB$ROLE_NAME = :RoleName ' +
3091	<	'order by RDB$ROLE_NAME';
3092	<
3093	<	var
3094	<	qryRoles : TIBSQL;
3095	<	PrevOwner, RoleName, OwnerName : String;
3096	<	begin
3097	<	{Process GRANT roles}
3098	<	qryRoles := TIBSQL.Create(FDatabase);
3099	<	try
3100	<	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION9 then
3101	<	begin
3102	<	PrevOwner := '';
3103	<	FMetaData.Add('');
3104	<	FMetaData.Add('/* Grant Roles for this database */');
3105	<	FMetaData.Add('');
3106	<
3107	<	if ObjectName = '' then
3108	<	qryRoles.SQL.Text := RolesSQL
3109	<	else
3110	<	begin
3111	<	qryRoles.SQL.Text := RolesByNameSQL;
3112	<	qryRoles.Params.ByName('RoleName').AsString := ObjectName;
3113	<	end;
3114	<	qryRoles.ExecQuery;
3115	<	try
3116	<	while not qryRoles.Eof do
3117	<	begin
3118	<	RoleName := QuoteIdentifier(FDatabase.SQLDialect,
3119	<	qryRoles.FieldByName('rdb$Role_Name').AsString);
3120	<	OwnerName := Trim(qryRoles.FieldByName('rdb$Owner_Name').AsString);
3121	<	if PrevOwner <> OwnerName then
3122	<	begin
3123	<	FMetaData.Add('');
3124	<	FMetaData.Add(Format('/* Role: %s, Owner: %s */', [RoleName, OwnerName]));
3125	<	FMetaData.Add('');
3126	<	PrevOwner := OwnerName;
3127	<	end;
3128	<	FMetaData.Add('CREATE ROLE ' + RoleName + Term);
3129	<	qryRoles.Next;
3130	<	end;
3131	<	finally
3132	<	qryRoles.Close;
3133	<	end;
3134	<	end;
3135	<	finally
3136	<	qryRoles.Free;
3137	<	end;
3138	<	end;
3139	<
3140	<	end.
3141	<
3142	<
1	>	{************************************************************************}
2	>	{                                                                        }
3	>	{    The contents of this file are subject to the InterBase              }
4	>	{    Public License Version 1.0 (the "License"); you may not             }
5	>	{    use this file except in compliance with the License. You            }
6	>	{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
7	>	{    Software distributed under the License is distributed on            }
8	>	{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
9	>	{    express or implied. See the License for the specific language       }
10	>	{    governing rights and limitations under the License.                 }
11	>	{                                                                        }
12	>	{    The Original Code was created by Jeff Overcash.                     }
13	>	{    Portions based upon code by Inprise Corporation are Copyright (C)   }
14	>	{       Inprise Corporation. All Rights Reserved.                        }
15	>	{                                                                        }
16	>	{    IBX Version 4.2 or higher required                                  }
17	>	{    Contributor(s): Jeff Overcash                                       }
18	>	{                                                                        }
19	>	{    IBX For Lazarus (Firebird Express)                                  }
20	>	{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
21	>	{    Portions created by MWA Software are copyright McCallum Whyman      }
22	>	{    Associates Ltd 2011                                                 }
23	>	{                                                                        }
24	>	{************************************************************************}
25	>
26	>	{ Syntax Enhancements Supported (by Firebird Version no.):
27	>
28	>	Multi-action triggers (1.5)
29	>	CREATE SEQUENCE (2.0)
30	>	Database Triggers (2.1)
31	>	Global Temporary Tables (2.1)
32	>	Boolean Type (3.0)
33	>	Identity Column Type (3.0)
34	>	DDL Triggers (3.0)
35	>	}
36	>
37	>	unit IBExtract;
38	>
39	>	{$Mode Delphi}
40	>	{$codepage UTF8}
41	>
42	>	interface
43	>
44	>	uses
45	>	{$IFDEF WINDOWS }
46	>	Windows,
47	>	{$ELSE}
48	>	unix,
49	>	{$ENDIF}
50	>	SysUtils, Classes, IBDatabase, IBDatabaseInfo,
51	>	IBSQL, IBUtils, IBHeader, IB;
52	>
53	>	type
54	>	TExtractObjectTypes =
55	>	(eoDatabase, eoDomain, eoTable, eoView, eoProcedure, eoFunction,
56	>	eoGenerator, eoException, eoBLOBFilter, eoRole, eoTrigger, eoForeign,
57	>	eoIndexes, eoChecks, eoData);
58	>
59	>	TExtractType =
60	>	(etDomain, etTable, etRole, etTrigger, etForeign,
61	>	etIndex, etData, etGrant, etCheck);
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;
72	>	FTransaction : TIBTransaction;
73	>	FMetaData: TStrings;
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; 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(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
99	>	IncludeGrants:boolean=false);
100	>	procedure ListAllTables(flag : Boolean);
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 = '');
105	>	procedure ListDomains(ObjectName : String = ''; ExtractType : TExtractType = etDomain);
106	>	procedure ListException(ExceptionName : String = '');
107	>	procedure ListFilters(FilterName : String = '');
108	>	procedure ListForeign(ObjectName : String = ''; ExtractType : TExtractType = etForeign);
109	>	procedure ListFunctions(FunctionName : 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
117	>	{ Public declarations }
118	>	constructor Create(AOwner : TComponent); override;
119	>	destructor Destroy; override;
120	>	function GetArrayField(FieldName : String) : String;
121	>	function GetFieldType(FieldType, FieldSubType, FieldScale, FieldSize,
122	>	FieldPrec, FieldLen : Integer) : String;
123	>	function GetCharacterSets(CharSetId, Collation : integer;   CollateOnly : Boolean) : String;
124	>	procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = '';
125	>	ExtractTypes : TExtractTypes = []);
126	>	property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo;
127	>	property Items : TStrings read FMetaData;
128	>
129	>	published
130	>	{ Published declarations }
131	>	property Database : TIBDatabase read GetDatabase write SetDatabase;
132	>	property Transaction : TIBTransaction read GetTransaction write SetTransaction;
133	>	property ShowSystem: Boolean read FShowSystem write FShowSystem;
134	>	end;
135	>
136	>	TSQLType = record
137	>	SqlType : Integer;
138	>	TypeName : String;
139	>	end;
140	>
141	>	TPrivTypes = record
142	>	PrivFlag : Integer;
143	>	PrivString : String;
144	>	end;
145	>
146	>	TSQLTypes = Array[0..14] of TSQLType;
147	>
148	>	const
149	>
150	>	priv_UNKNOWN = 1;
151	>	priv_SELECT = 2;
152	>	priv_INSERT = 4;
153	>	priv_UPDATE = 8;
154	>	priv_DELETE = 16;
155	>	priv_EXECUTE = 32;
156	>	priv_REFERENCES = 64;
157	>	priv_USAGE = 128;
158	>
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'),
166	>	(PrivFlag : priv_USAGE; PrivString : 'USAGE' ));
167	>
168	>	ColumnTypes : TSQLTypes = (
169	>	(SqlType : blr_short; TypeName :    'SMALLINT'),            { NTX: keyword }
170	>	(SqlType : blr_long; TypeName : 'INTEGER'),         { NTX: keyword }
171	>	(SqlType : blr_quad; TypeName : 'QUAD'),            { NTX: keyword }
172	>	(SqlType : blr_float; TypeName : 'FLOAT'),          { NTX: keyword }
173	>	(SqlType : blr_text; TypeName : 'CHAR'),            { NTX: keyword }
174	>	(SqlType : blr_double; TypeName : 'DOUBLE PRECISION'),      { NTX: keyword }
175	>	(SqlType : blr_varying; TypeName : 'VARCHAR'),              { NTX: keyword }
176	>	(SqlType : blr_cstring; TypeName : 'CSTRING'),              { NTX: keyword }
177	>	(SqlType : blr_blob_id; TypeName : 'BLOB_ID'),              { NTX: keyword }
178	>	(SqlType : blr_blob; TypeName : 'BLOB'),            { NTX: keyword }
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'),
183	>	(SqlType : blr_bool; TypeName : 'BOOLEAN'));
184	>
185	>	SubTypes : Array[0..8] of String = (
186	>	'UNKNOWN',                  { NTX: keyword }
187	>	'TEXT',                             { NTX: keyword }
188	>	'BLR',                              { NTX: keyword }
189	>	'ACL',                              { NTX: keyword }
190	>	'RANGES',                   { NTX: keyword }
191	>	'SUMMARY',                  { NTX: keyword }
192	>	'FORMAT',                   { NTX: keyword }
193	>	'TRANSACTION_DESCRIPTION',  { NTX: keyword }
194	>	'EXTERNAL_FILE_DESCRIPTION');       { NTX: keyword }
195	>
196	>	IntegralSubtypes : Array[0..2] of String = (
197	>	'UNKNOWN',                  { Defined type, NTX: keyword }
198	>	'NUMERIC',                  { NUMERIC, NTX: keyword }
199	>	'DECIMAL');                         { DECIMAL, NTX: keyword }
200	>
201	>	ODS_VERSION6 = 6;     { on-disk structure as of v3.0 }
202	>	ODS_VERSION7 = 7;     { new on disk structure for fixing index bug }
203	>	ODS_VERSION8 =        8;      { new btree structure to support pc semantics }
204	>	ODS_VERSION9 =        9;      { btree leaf pages are always propogated up }
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;
212	>	FILE_inactive = 2;
213	>	FILE_manual = 4;
214	>	FILE_cache = 8;
215	>	FILE_conditional = 16;
216	>
217	>	{ flags for RDB$LOG_FILES }
218	>	LOG_serial = 1;
219	>	LOG_default = 2;
220	>	LOG_raw = 4;
221	>	LOG_overflow = 8;
222	>
223	>
224	>
225	>	MAX_INTSUBTYPES = 2;
226	>	MAXSUBTYPES = 8;     { Top of subtypes array }
227	>
228	>	{ Object types used in RDB$DEPENDENCIES and RDB$USER_PRIVILEGES }
229	>
230	>	obj_relation = 0;
231	>	obj_view = 1;
232	>	obj_trigger = 2;
233	>	obj_computed = 3;
234	>	obj_validation = 4;
235	>	obj_procedure = 5;
236	>	obj_expression_index = 6;
237	>	obj_exception = 7;
238	>	obj_user = 8;
239	>	obj_field = 9;
240	>	obj_index = 10;
241	>	obj_count = 11;
242	>	obj_user_group = 12;
243	>	obj_sql_role = 13;
244	>
245	>	implementation
246	>
247	>	uses FBMessages, IBDataOutput;
248	>
249	>	const
250	>	TERM = ';';
251	>	ProcTerm = '^';
252	>
253	>	CollationSQL =
254	>	'SELECT CST.RDB$CHARACTER_SET_NAME, COL.RDB$COLLATION_NAME, CST.RDB$DEFAULT_COLLATE_NAME ' +
255	>	'FROM RDB$COLLATIONS COL JOIN RDB$CHARACTER_SETS CST ON ' +
256	>	'  COL.RDB$CHARACTER_SET_ID = CST.RDB$CHARACTER_SET_ID ' +
257	>	'WHERE ' +
258	>	'  COL.RDB$COLLATION_ID = :COLLATION AND ' +
259	>	'  CST.RDB$CHARACTER_SET_ID = :CHAR_SET_ID ' +
260	>	'ORDER BY COL.RDB$COLLATION_NAME, CST.RDB$CHARACTER_SET_NAME';
261	>
262	>	NonCollationSQL =
263	>	'SELECT CST.RDB$CHARACTER_SET_NAME ' +
264	>	'FROM RDB$CHARACTER_SETS CST ' +
265	>	'WHERE CST.RDB$CHARACTER_SET_ID = :CHARSETID ' +
266	>	'ORDER BY CST.RDB$CHARACTER_SET_NAME';
267	>
268	>	PrecisionSQL =
269	>	'SELECT * FROM RDB$FIELDS ' +
270	>	'WHERE RDB$FIELD_NAME = :FIELDNAME';
271	>
272	>	ArraySQL =
273	>	'SELECT * FROM RDB$FIELD_DIMENSIONS FDIM ' +
274	>	'WHERE ' +
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
312	>	Functional description
313	>	Retrieves the dimensions of arrays and prints them.
314	>
315	>	Parameters:  fieldname -- the actual name of the array field }
316	>
317	>	function TIBExtract.GetArrayField(FieldName: String): String;
318	>	var
319	>	qryArray : TIBSQL;
320	>	begin
321	>	qryArray := TIBSQL.Create(FDatabase);
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	>	if not qryArray.Eof then
330	>	begin
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	>
343	>	qryArray.Free;
344	>
345	>	end;
346	>
347	>	constructor TIBExtract.Create(AOwner: TComponent);
348	>	begin
349	>	inherited;
350	>	FMetaData := TStringList.Create;
351	>	FDatabaseInfo := TIBDatabaseInfo.Create(nil);
352	>	FDatabaseInfo.Database := FDatabase;
353	>	if AOwner is TIBDatabase then
354	>	Database := TIBDatabase(AOwner);
355	>	if AOwner is TIBTransaction then
356	>	Transaction := TIBTransaction(AOwner);
357	>	end;
358	>
359	>	destructor TIBExtract.Destroy;
360	>	begin
361	>	FMetaData.Free;
362	>	FDatabasEInfo.Free;
363	>	inherited;
364	>	end;
365	>
366	>	function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String; IncludeData: boolean = false) : Boolean;
367	>	var
368	>	DidConnect : Boolean;
369	>	DidStart : Boolean;
370	>	begin
371	>	Result := true;
372	>	DidConnect := false;
373	>	DidStart := false;
374	>
375	>	if not FDatabase.Connected then
376	>	begin
377	>	FDatabase.Connected := true;
378	>	didConnect := true;
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
386	>	begin
387	>	FTransaction.StartTransaction;
388	>	DidStart := true;
389	>	end;
390	>
391	>	if TableName <> '' then
392	>	begin
393	>	if not ExtractListTable(TableName, '', true) then
394	>	Result := false;
395	>	end
396	>	else
397	>	begin
398	>	ListCreateDb;
399	>	ListFilters;
400	>	ListFunctions;
401	>	ListDomains;
402	>	ListAllTables(flag);
403	>	if IncludeData then
404	>	ListData('');
405	>	ListIndex;
406	>	ListForeign;
407	>	if IncludeData then
408	>	ListGenerators('',[etData])
409	>	else
410	>	ListGenerators;
411	>	ListViews;
412	>	ListCheck;
413	>	ListException;
414	>	ListProcs(pdCreateStub);
415	>	ListTriggers;
416	>	ListProcs(pdAlterProc);
417	>	ListGrants;
418	>	end;
419	>
420	>	if DidStart then
421	>	FTransaction.Commit;
422	>
423	>	if DidConnect then
424	>	FDatabase.Connected := false;
425	>	end;
426	>
427	>	{                   ExtractListTable
428	>	Functional description
429	>	Shows columns, types, info for a given table name
430	>	and text of views.
431	>	If a new_name is passed, substitute it for relation_name
432	>
433	>	relation_name -- Name of table to investigate
434	>	new_name -- Name of a new name for a replacement table
435	>	domain_flag -- extract needed domains before the table }
436	>
437	>	function TIBExtract.ExtractListTable(RelationName, NewName: String;
438	>	DomainFlag: Boolean): Boolean;
439	>	const
440	>	TableListSQL =
441	>	'SELECT * FROM RDB$RELATIONS REL JOIN RDB$RELATION_FIELDS RFR ON ' + {Do Not Localize}
442	>	'  RFR.RDB$RELATION_NAME = REL.RDB$RELATION_NAME JOIN RDB$FIELDS FLD ON ' +
443	>	'  RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +
444	>	'WHERE REL.RDB$RELATION_NAME = :RelationName ' +
445	>	'ORDER BY RFR.RDB$FIELD_POSITION, RFR.RDB$FIELD_NAME';
446	>
447	>	ConstraintSQL =
448	>	'SELECT RCO.RDB$CONSTRAINT_NAME, RDB$CONSTRAINT_TYPE, RDB$RELATION_NAME, ' +
449	>	'RDB$DEFERRABLE, RDB$INITIALLY_DEFERRED, RDB$INDEX_NAME, RDB$TRIGGER_NAME ' +
450	>	'FROM RDB$RELATION_CONSTRAINTS RCO, RDB$CHECK_CONSTRAINTS CON ' +
451	>	'WHERE ' +
452	>	'  CON.RDB$TRIGGER_NAME = :FIELDNAME AND ' +
453	>	'  CON.RDB$CONSTRAINT_NAME = RCO.RDB$CONSTRAINT_NAME AND ' +
454	>	'  RCO.RDB$CONSTRAINT_TYPE = ''NOT NULL'' AND ' +
455	>	'  RCO.RDB$RELATION_NAME = :RELATIONNAME';
456	>
457	>	RelConstraintsSQL =
458	>	'SELECT * FROM RDB$RELATION_CONSTRAINTS RELC ' +
459	>	'WHERE ' +
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_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;
472	>	SubType : integer;
473	>	IntChar : integer;
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;
481	>	ColList := '';
482	>	IntChar := 0;
483	>	ValidRelation := false;
484	>
485	>	if DomainFlag then
486	>	ListDomains(RelationName);
487	>	qryTables := TIBSQL.Create(FDatabase);
488	>	qryPrecision := TIBSQL.Create(FDatabase);
489	>	qryConstraints := TIBSQL.Create(FDatabase);
490	>	qryRelConstraints := TIBSQL.Create(FDatabase);
491	>	qryGenerators := TIBSQL.Create(FDatabase);
492	>	try
493	>	qryTables.SQL.Add(TableListSQL);
494	>	RelationName := trim(RelationName);
495	>	qryTables.Params.ByName('RelationName').AsString := RelationName;
496	>	qryTables.ExecQuery;
497	>	qryPrecision.SQL.Add(PrecisionSQL);
498	>	qryConstraints.SQL.Add(ConstraintSQL);
499	>	qryRelConstraints.SQL.Add(RelConstraintsSQL);
500	>	qryGenerators.SQL.Add(GetGeneratorSQL);
501	>	if not qryTables.Eof then
502	>	begin
503	>	ValidRelation := true;
504	>	TableType := qryTables.FieldByName('RDB$RELATION_TYPE').AsInteger;
505	>	if (not qryTables.FieldByName('RDB$OWNER_NAME').IsNull) and
506	>	(Trim(qryTables.FieldByName('RDB$OWNER_NAME').AsString) <> '') then
507	>	FMetaData.Add(Format('%s/* Table: %s, Owner: %s */%s',
508	>	[LineEnding, RelationName,
509	>	qryTables.FieldByName('RDB$OWNER_NAME').AsString, LineEnding]));
510	>	if TableType > 3 then
511	>	CreateTable := 'CREATE GLOBAL TEMPORARY TABLE'
512	>	else
513	>	CreateTable := 'CREATE TABLE';
514	>	if NewName <> '' then
515	>	FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,NewName)]))
516	>	else
517	>	FMetaData.Add(Format('%s %s ', [CreateTable,QuoteIdentifier(FDatabase.SQLDialect,RelationName)]));
518	>	if not qryTables.FieldByName('RDB$EXTERNAL_FILE').IsNull then
519	>	FMetaData.Add(Format('EXTERNAL FILE %s ',
520	>	[QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsString)]));
521	>	FMetaData.Add('(');
522	>	end;
523	>
524	>	while not qryTables.Eof do
525	>	begin
526	>	Column := '  ' + QuoteIdentifier(FDatabase.SQLDialect, qryTables.FieldByName('RDB$FIELD_NAME').AsString) + TAB;
527	>
528	>	{  Check first for computed fields, then domains.
529	>	If this is a known domain, then just print the domain rather than type
530	>	Domains won't have length, array, or blob definitions, but they
531	>	may have not null, default and check overriding their definitions }
532	>
533	>	if not qryTables.FieldByName('rdb$computed_blr').IsNull then
534	>	begin
535	>	Column := Column + ' COMPUTED BY ';
536	>	if not qryTables.FieldByName('RDB$COMPUTED_SOURCE').IsNull then
537	>	Column := Column + PrintValidation(qryTables.FieldByName('RDB$COMPUTED_SOURCE').AsString, true);
538	>	end
539	>	else
540	>	begin
541	>	FieldType := qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger;
542	>	FieldScale := qryTables.FieldByName('RDB$FIELD_SCALE').AsInteger;
543	>	if not ((Copy(qryTables.FieldByName('RDB$FIELD_NAME1').AsString, 1, 4) = 'RDB$') and
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, 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)
551	>	and (qryTables.FieldByName('RDB$COLLATION_ID').AsInteger <> 0) then
552	>	begin
553	>	Collation := qryTables.FieldByName('RDB$COLLATION_ID').AsInteger;
554	>	Column := Column + GetCharacterSets(qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsShort,
555	>	Collation, true);
556	>	end;
557	>	end
558	>	else
559	>	begin
560	>	{ Look through types array }
561	>	for i := Low(Columntypes) to High(ColumnTypes) do
562	>	begin
563	>	PrecisionKnown := false;
564	>	if qryTables.FieldByname('RDB$FIELD_TYPE').AsShort = ColumnTypes[i].SQLType then
565	>	begin
566	>
567	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
568	>	begin
569	>	{ Handle Integral subtypes NUMERIC and DECIMAL }
570	>	if qryTables.FieldByName('RDB$FIELD_TYPE').AsInteger in
571	>	[blr_short, blr_long, blr_int64] then
572	>	begin
573	>	qryPrecision.Params.ByName('FIELDNAME').AsString :=
574	>	qryTables.FieldByName('RDB$FIELD_NAME1').AsString;
575	>	qryPrecision.ExecQuery;
576	>
577	>	{ We are ODS >= 10 and could be any Dialect }
578	>	if not qryPrecision.FieldByName('RDB$FIELD_PRECISION').IsNull then
579	>	begin
580	>	{ We are Dialect >=3 since FIELD_PRECISION is non-NULL }
581	>	if (qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
582	>	(qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
583	>	begin
584	>	Column := column + Format('%s(%d, %d)',
585	>	[IntegralSubtypes[qryPrecision.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
586	>	qryPrecision.FieldByName('RDB$FIELD_PRECISION').AsInteger,
587	>	-qryPrecision.FieldByName('RDB$FIELD_SCALE').AsInteger]);
588	>	PrecisionKnown := TRUE;
589	>	end;
590	>	end;
591	>	qryPrecision.Close;
592	>	end;
593	>	end;
594	>
595	>	if PrecisionKnown = FALSE then
596	>	begin
597	>	{ Take a stab at numerics and decimals }
598	>	if (FieldType = blr_short) and (FieldScale < 0) then
599	>	Column := Column + Format('NUMERIC(4, %d)', [-FieldScale])
600	>	else
601	>	if (FieldType = blr_long) and (FieldScale < 0) then
602	>	Column := Column + Format('NUMERIC(9, %d)', [-FieldScale])
603	>	else
604	>	if (FieldType = blr_double) and (FieldScale < 0) then
605	>	Column := Column + Format('NUMERIC(15, %d)', [-FieldScale])
606	>	else
607	>	Column := Column + ColumnTypes[i].TypeName;
608	>	end;
609	>	end;
610	>	end;
611	>	if FieldType in [blr_text, blr_varying] then
612	>	if qryTables.FieldByName('RDB$CHARACTER_LENGTH').IsNull then
613	>	Column := Column + Format('(%d)', [qryTables.FieldByName('RDB$FIELD_LENGTH').AsInteger])
614	>	else
615	>	Column := Column + Format('(%d)', [qryTables.FieldByName('RDB$CHARACTER_LENGTH').AsInteger]);
616	>
617	>	{ Catch arrays after printing the type  }
618	>
619	>	if not qryTables.FieldByName('RDB$DIMENSIONS').IsNull and (qryTables.FieldByName('RDB$DIMENSIONS').AsInteger > 0) then
620	>	Column := column + GetArrayField(qryTables.FieldByName('RDB$FIELD_SOURCE').AsString);
621	>
622	>	if FieldType = blr_blob then
623	>	begin
624	>	subtype := qryTables.FieldByName('RDB$FIELD_SUB_TYPE').AsShort;
625	>	Column := Column + ' SUB_TYPE ';
626	>	if (subtype > 0) and (subtype <= MAXSUBTYPES) then
627	>	Column := Column + SubTypes[subtype]
628	>	else
629	>	Column := Column + IntToStr(subtype);
630	>	column := Column + Format(' SEGMENT SIZE %d',
631	>	[qryTables.FieldByName('RDB$SEGMENT_LENGTH').AsInteger]);
632	>	end;
633	>
634	>	{ International character sets }
635	>	if ((FieldType in [blr_text, blr_varying]) or
636	>	(FieldType = blr_blob)) and
637	>	(not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull) and
638	>	(qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) then
639	>	begin
640	>	{ Override rdb$fields id with relation_fields if present }
641	>
642	>	CharSetId := 0;
643	>	if not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
644	>	CharSetId := qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger;
645	>
646	>	Column := Column + GetCharacterSets(CharSetId, 0, false);
647	>	intchar := 1;
648	>	end;
649	>	end;
650	>
651	>	{Firebird 3 introduces IDENTITY columns. We need to check for them here}
652	>	if qryTables.HasField('RDB$GENERATOR_NAME') and not qryTables.FieldByName('RDB$GENERATOR_NAME').IsNull then
653	>	begin
654	>	qryGenerators.ParamByName('GENERATOR').AsString :=  qryTables.FieldByName('RDB$GENERATOR_NAME').AsString;
655	>	qryGenerators.ExecQuery;
656	>	if not qryGenerators.Eof then
657	>	begin
658	>	Column := Column + Format(' GENERATED BY DEFAULT AS IDENTITY START WITH %d',
659	>	[qryGenerators.FieldByName('RDB$INITIAL_VALUE').AsInteger]);
660	>	end;
661	>	qryGenerators.Close;
662	>	end;
663	>
664	>	{ Handle defaults for columns }
665	>	{ Originally This called PrintMetadataTextBlob,
666	>	should no longer need }
667	>	if not qryTables.FieldByName('RDB$DEFAULT_SOURCE').IsNull then
668	>	Column := Column + ' ' + qryTables.FieldByName('RDB$DEFAULT_SOURCE').AsString;
669	>
670	>
671	>	{ The null flag is either 1 or null (for nullable) .  if there is
672	>	a constraint name, print that too.  Domains cannot have named
673	>	constraints.  The column name is in rdb$trigger_name in
674	>	rdb$check_constraints.  We hope we get at most one row back. }
675	>
676	>	if qryTables.FieldByName('RDB$NULL_FLAG').AsInteger = 1 then
677	>	begin
678	>	qryConstraints.Params.ByName('FIELDNAME').AsString := qryTables.FieldByName('RDB$FIELD_NAME').AsString;
679	>	qryConstraints.Params.ByName('RELATIONNAME').AsString := qryTables.FieldByName('RDB$RELATION_NAME').AsString;
680	>	qryConstraints.ExecQuery;
681	>
682	>	while not qryConstraints.Eof do
683	>	begin
684	>	if Pos('INTEG', qryConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString) <> 1 then
685	>	Column := Column + Format(' CONSTRAINT %s',
686	>	[ QuoteIdentifier( FDatabase.SQLDialect,
687	>	qryConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString)]);
688	>	qryConstraints.Next;
689	>	end;
690	>	qryConstraints.Close;
691	>	Column := Column + ' NOT NULL';
692	>	end;
693	>
694	>	if ((FieldType in [blr_text, blr_varying]) or
695	>	(FieldType = blr_blob)) and
696	>	(not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull) and
697	>	(qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) and
698	>	(intchar <> 0) then
699	>	begin
700	>	Collation := 0;
701	>	if not qryTables.FieldByName('RDB$COLLATION_ID1').IsNull then
702	>	Collation := qryTables.FieldByName('RDB$COLLATION_ID1').AsInteger
703	>	else
704	>	if not qryTables.FieldByName('RDB$COLLATION_ID').IsNull then
705	>	Collation := qryTables.FieldByName('RDB$COLLATION_ID').AsInteger;
706	>
707	>	CharSetId := 0;
708	>	if not qryTables.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
709	>	CharSetId := qryTables.FieldByName('RDB$CHARACTER_SET_ID').AsInteger;
710	>
711	>	if Collation <> 0 then
712	>	Column := Column + GetCharacterSets(CharSetId, Collation, true);
713	>	end;
714	>	end;
715	>	qryTables.Next;
716	>	if not qryTables.Eof then
717	>	Column := Column + ',';
718	>	FMetaData.Add(Column);
719	>	end;
720	>
721	>	{ Do primary and unique keys only. references come later }
722	>
723	>	qryRelConstraints.Params.ByName('relationname').AsString := RelationName;
724	>	qryRelConstraints.ExecQuery;
725	>	while not qryRelConstraints.Eof do
726	>	begin
727	>	Constraint := '';
728	>	FMetaData.Strings[FMetaData.Count - 1] := FMetaData.Strings[FMetaData.Count - 1]  + ',';
729	>	{ If the name of the constraint is not INTEG..., print it }
730	>	if Pos('INTEG', qryRelConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString) <> 1 then
731	>	Constraint := Constraint + 'CONSTRAINT ' +
732	>	QuoteIdentifier(FDatabase.SQLDialect,
733	>	qryRelConstraints.FieldByName('RDB$CONSTRAINT_NAME').AsString);
734	>
735	>
736	>	if Pos('PRIMARY', qryRelConstraints.FieldByName('RDB$CONSTRAINT_TYPE').AsString) = 1 then
737	>	begin
738	>	FMetaData.Add(Constraint + Format(' PRIMARY KEY (%s)',
739	>	[GetIndexSegments(qryRelConstraints.FieldByName('RDB$INDEX_NAME').AsString)]));
740	>	end
741	>	else
742	>	if Pos('UNIQUE', qryRelConstraints.FieldByName('RDB$CONSTRAINT_TYPE').AsString) = 1 then
743	>	begin
744	>	FMetaData.Add(Constraint + Format(' UNIQUE (%s)',
745	>	[GetIndexSegments(qryRelConstraints.FieldByName('RDB$INDEX_NAME').AsString)]));
746	>	end;
747	>	qryRelConstraints.Next;
748	>	end;
749	>	if ValidRelation then
750	>	begin
751	>	if TableType = 4 then
752	>	FMetaData.Add(' ) ON COMMIT PRESERVE ROWS ' + TERM)
753	>	else
754	>	FMetaData.Add(')' + TERM);
755	>	end;
756	>	finally
757	>	qryTables.Free;
758	>	qryPrecision.Free;
759	>	qryConstraints.Free;
760	>	qryRelConstraints.Free;
761	>	qryGenerators.Free;
762	>	end;
763	>	end;
764	>
765	>	{                  ExtractListView
766	>	Functional description
767	>	Show text of the specified view.
768	>	Use a SQL query to get the info and print it.
769	>	Note: This should also contain check option }
770	>
771	>	procedure TIBExtract.ExtractListView(ViewName: String);
772	>	const
773	>	ViewsSQL = 'SELECT * FROM RDB$RELATIONS REL ' +
774	>	' WHERE ' +
775	>	'  (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
776	>	'  NOT REL.RDB$VIEW_BLR IS NULL AND ' +
777	>	'  REL.RDB$RELATION_NAME = :VIEWNAME AND ' +
778	>	'  REL.RDB$FLAGS = 1 ' +
779	>	'ORDER BY REL.RDB$RELATION_ID ';
780	>
781	>	ColumnsSQL = 'SELECT * FROM RDB$RELATION_FIELDS RFR ' +
782	>	'WHERE ' +
783	>	'  RFR.RDB$RELATION_NAME = :RELATIONNAME ' +
784	>	'ORDER BY RFR.RDB$FIELD_POSITION ';
785	>
786	>	var
787	>	qryViews, qryColumns : TIBSQL;
788	>	RelationName, ColList : String;
789	>	begin
790	>	qryViews := TIBSQL.Create(FDatabase);
791	>	qryColumns := TIBSQL.Create(FDatabase);
792	>	try
793	>	qryViews.SQL.Add(ViewsSQL);
794	>	qryViews.Params.ByName('viewname').AsString := ViewName;
795	>	qryViews.ExecQuery;
796	>	while not qryViews.Eof do
797	>	begin
798	>	FMetaData.Add('');
799	>	RelationName := QuoteIdentifier(FDatabase.SQLDialect,
800	>	qryViews.FieldByName('RDB$RELATION_NAME').AsString);
801	>	FMetaData.Add(Format('%s/* View: %s, Owner: %s */%s', [
802	>	RelationName,
803	>	Trim(qryViews.FieldByName('RDB$OWNER_NAME').AsString)]));
804	>	FMetaData.Add('');
805	>	FMetaData.Add(Format('CREATE VIEW %s (', [RelationName]));
806	>
807	>	{ Get Column List}
808	>	qryColumns.SQL.Add(ColumnsSQL);
809	>	qryColumns.Params.ByName('relationname').AsString := RelationName;
810	>	qryColumns.ExecQuery;
811	>	while not qryColumns.Eof do
812	>	begin
813	>	ColList := ColList + QuoteIdentifier(FDatabase.SQLDialect,
814	>	qryColumns.FieldByName('RDB$FIELD_NAME').AsString);
815	>	qryColumns.Next;
816	>	if not qryColumns.Eof then
817	>	ColList := ColList + ', ';
818	>	end;
819	>	FMetaData.Add(ColList + ') AS');
820	>	FMetaData.Add(qryViews.FieldByName('RDB$VIEW_SOURCE').AsString + Term);
821	>	qryViews.Next;
822	>	end;
823	>	finally
824	>	qryViews.Free;
825	>	qryColumns.Free;
826	>	end;
827	>	end;
828	>
829	>	function TIBExtract.GetCharacterSets(CharSetId, Collation: integer;
830	>	CollateOnly: Boolean): String;
831	>	var
832	>	CharSetSQL : TIBSQL;
833	>	DidActivate : Boolean;
834	>	begin
835	>	Result := '';
836	>	if not FTransaction.Active then
837	>	begin
838	>	FTransaction.StartTransaction;
839	>	DidActivate := true;
840	>	end
841	>	else
842	>	DidActivate := false;
843	>	CharSetSQL := TIBSQL.Create(FDatabase);
844	>	try
845	>	if Collation <> 0 then
846	>	begin
847	>	CharSetSQL.SQL.Add(CollationSQL);
848	>	CharSetSQL.Params.ByName('Char_Set_Id').AsInteger := CharSetId;
849	>	CharSetSQL.Params.ByName('Collation').AsInteger := Collation;
850	>	CharSetSQL.ExecQuery;
851	>
852	>	{ Is specified collation the default collation for character set? }
853	>	if (Trim(CharSetSQL.FieldByName('RDB$DEFAULT_COLLATE_NAME').AsString) =
854	>	Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsString)) then
855	>	begin
856	>	if not CollateOnly then
857	>	Result := ' CHARACTER SET ' + Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
858	>	end
859	>	else
860	>	if CollateOnly then
861	>	Result := ' COLLATE ' + Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsString)
862	>	else
863	>	Result := ' CHARACTER SET ' +
864	>	Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsString) +
865	>	' COLLATE ' +
866	>	Trim(CharSetSQL.FieldByName('RDB$COLLATION_NAME').AsString);
867	>	end
868	>	else
869	>	if CharSetId <> 0 then
870	>	begin
871	>	CharSetSQL.SQL.Add(NonCollationSQL);
872	>	CharSetSQL.Params.ByName('CharSetId').AsShort := CharSetId;
873	>	CharSetSQL.ExecQuery;
874	>	Result := ' CHARACTER SET ' + Trim(CharSetSQL.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
875	>	end;
876	>	finally
877	>	CharSetSQL.Free;
878	>	end;
879	>	if DidActivate then
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;
891	>	end;
892	>
893	>	{                GetIndexSegments
894	>	Functional description
895	>	returns the list of columns in an index. }
896	>
897	>	function TIBExtract.GetIndexSegments(indexname: String): String;
898	>	const
899	>	IndexNamesSQL =
900	>	'SELECT * FROM RDB$INDEX_SEGMENTS SEG ' +
901	>	'WHERE SEG.RDB$INDEX_NAME = :INDEXNAME ' +
902	>	'ORDER BY SEG.RDB$FIELD_POSITION';
903	>
904	>	var
905	>	qryColNames : TIBSQL;
906	>	begin
907	>	{ Query to get column names }
908	>	Result := '';
909	>	qryColNames := TIBSQL.Create(FDatabase);
910	>	try
911	>	qryColNames.SQL.Add(IndexNamesSQL);
912	>	qryColNames.Params.ByName('IndexName').AsString := IndexName;
913	>	qryColNames.ExecQuery;
914	>	while not qryColNames.Eof do
915	>	begin
916	>	{ Place a comma and a blank between each segment column name }
917	>
918	>	Result := Result + QuoteIdentifier(FDatabase.SQLDialect,
919	>	qryColNames.FieldByName('RDB$FIELD_NAME').AsString);
920	>	qryColNames.Next;
921	>	if not qryColNames.Eof then
922	>	Result := Result + ', ';
923	>	end;
924	>	finally
925	>	qryColNames.Free;
926	>	end;
927	>	end;
928	>
929	>	function TIBExtract.GetTransaction: TIBTransaction;
930	>	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 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}
967	>	begin
968	>	Result := 'ON ';
969	>	case TypeID of
970	>	$2000:
971	>	Result += 'CONNECT';
972	>	$2001:
973	>	Result += 'DISCONNECT';
974	>	$2002:
975	>	Result +='TRANSACTION START';
976	>	$2003:
977	>	Result += 'TRANSACTION COMMIT';
978	>	$2004:
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
1017	>	Result := 'AFTER '
1018	>	else
1019	>	Result := 'BEFORE ';
1020	>	TypeID := TypeID shr 1;
1021	>	separator := '';
1022	>	repeat
1023	>	Result += separator;
1024	>	separator := ' or ';
1025	>	case TypeID and $03 of
1026	>	1:
1027	>	Result += 'INSERT';
1028	>	2:
1029	>	Result += 'UPDATE';
1030	>	3:
1031	>	Result += 'DELETE';
1032	>	end;
1033	>	TypeID := TypeID shr 2;
1034	>	until TypeID = 0
1035	>	end
1036	>	end;
1037	>
1038	>	{          ListAllGrants
1039	>	Functional description
1040	>	Print the permissions on all user tables.
1041	>	Get separate permissions on table/views and then procedures }
1042	>
1043	>	procedure TIBExtract.ListGrants;
1044	>	const
1045	>	SecuritySQL = 'SELECT * FROM RDB$RELATIONS ' +
1046	>	'WHERE ' +
1047	>	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
1048	>	'  RDB$SECURITY_CLASS STARTING WITH ''SQL$'' ' +
1049	>	'ORDER BY RDB$RELATION_NAME';
1050	>
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;
1066	>	begin
1067	>	ListRoles;
1068	>	qryRoles := TIBSQL.Create(FDatabase);
1069	>	try
1070	>	{ This version of cursor gets only sql tables identified by security class
1071	>	and misses views, getting only null view_source }
1072	>
1073	>	FMetaData.Add('');
1074	>	FMetaData.Add('/* Grant permissions for this database */');
1075	>	FMetaData.Add('');
1076	>
1077	>	try
1078	>	qryRoles.SQL.Text := SecuritySQL;
1079	>	qryRoles.ExecQuery;
1080	>	while not qryRoles.Eof do
1081	>	begin
1082	>	RelationName := Trim(qryRoles.FieldByName('rdb$relation_Name').AsString);
1083	>	ShowGrants(RelationName, Term);
1084	>	qryRoles.Next;
1085	>	end;
1086	>	finally
1087	>	qryRoles.Close;
1088	>	end;
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
1119	>	while not qryRoles.Eof do
1120	>	begin
1121	>	ShowGrants(Trim(qryRoles.FieldByName('RDB$PROCEDURE_NAME').AsString), Term);
1122	>	qryRoles.Next;
1123	>	end;
1124	>	finally
1125	>	qryRoles.Close;
1126	>	end;
1127	>	finally
1128	>	qryRoles.Free;
1129	>	end;
1130	>	end;
1131	>
1132	>	{         ListAllProcs
1133	>	Functional description
1134	>	Shows text of a stored procedure given a name.
1135	>	or lists procedures if no argument.
1136	>	Since procedures may reference each other, we will create all
1137	>	dummy procedures of the correct name, then alter these to their
1138	>	correct form.
1139	>	Add the parameter names when these procedures are created.
1140	>
1141	>	procname -- Name of procedure to investigate }
1142	>
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 =  {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 ' +
1165	>	'WHERE RDB$PROCEDURE_NAME = :ProcedureName ' +
1166	>	'ORDER BY RDB$PROCEDURE_NAME';
1167	>
1168	>	var
1169	>	qryProcedures : TIBSQL;
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
1180	>	if ProcedureName = '' then
1181	>	qryProcedures.SQL.Text := ProcedureSQL
1182	>	else
1183	>	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
1191	>	if Header then
1192	>	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', [LineEnding, LineEnding]));
1197	>	Header := false;
1198	>	end;
1199	>	ProcName := Trim(qryProcedures.FieldByName('RDB$PROCEDURE_NAME').AsString);
1200	>
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	>	qryProcedures.Close;
1246	>
1247	>	if not Header then
1248	>	begin
1249	>	FMetaData.Add(Format('SET TERM %s %s', [Term, ProcTerm]));
1250	>	FMetaData.Add('COMMIT WORK;');
1251	>	FMetaData.Add('SET AUTODDL ON;');
1252	>	end;
1253	>	finally
1254	>	qryProcedures.Free;
1255	>	SList.Free;
1256	>	end;
1257	>	end;
1258	>
1259	>	{                 ListAllTables
1260	>	Functional description
1261	>	Extract the names of all user tables from
1262	>	rdb$relations.  Filter SQL tables by
1263	>	security class after we fetch them
1264	>	Parameters:  flag -- 0, get all tables }
1265	>
1266	>	procedure TIBExtract.ListAllTables(flag: Boolean);
1267	>	const
1268	>	TableSQL =
1269	>	'SELECT * FROM RDB$RELATIONS ' +
1270	>	'WHERE ' +
1271	>	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
1272	>	'  RDB$VIEW_BLR IS NULL ' +
1273	>	'ORDER BY RDB$RELATION_NAME';
1274	>
1275	>	var
1276	>	qryTables : TIBSQL;
1277	>	begin
1278	>	{ This version of cursor gets only sql tables identified by security class
1279	>	and misses views, getting only null view_source }
1280	>
1281	>	qryTables := TIBSQL.Create(FDatabase);
1282	>	try
1283	>	qryTables.SQL.Text := TableSQL;
1284	>	qryTables.ExecQuery;
1285	>	while not qryTables.Eof do
1286	>	begin
1287	>	if ((qryTables.FieldByName('RDB$FLAGS').AsInteger <> 1) and
1288	>	(not Flag)) then
1289	>	continue;
1290	>	if flag or (Pos('SQL$', qryTables.FieldByName('RDB$SECURITY_CLASS').AsString) <> 1) then
1291	>	ExtractListTable(qryTables.FieldByName('RDB$RELATION_NAME').AsString,
1292	>	'', false);
1293	>
1294	>	qryTables.Next;
1295	>	end;
1296	>	finally
1297	>	qryTables.Free;
1298	>	end;
1299	>	end;
1300	>
1301	>	{        ListAllTriggers
1302	>	Functional description
1303	>	Lists triggers in general on non-system
1304	>	tables with sql source only. }
1305	>
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 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 ' +
1317	>	'  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +
1318	>	'     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +
1319	>	'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +
1320	>	'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1321	>
1322	>	TriggerNameSQL =
1323	>	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$RELATIONS REL ON ' +
1324	>	'  TRG.RDB$RELATION_NAME = REL.RDB$RELATION_NAME ' +
1325	>	'WHERE ' +
1326	>	' REL.RDB$RELATION_NAME = :TableName AND ' +
1327	>	' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
1328	>	'  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +
1329	>	'     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +
1330	>	'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +
1331	>	'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1332	>
1333	>	TriggerByNameSQL =
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 ' +
1338	>	' (REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
1339	>	'  NOT EXISTS (SELECT * FROM RDB$CHECK_CONSTRAINTS CHK WHERE ' +
1340	>	'     TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME) ' +
1341	>	'ORDER BY TRG.RDB$RELATION_NAME, TRG.RDB$TRIGGER_TYPE, ' +
1342	>	'    TRG.RDB$TRIGGER_SEQUENCE, TRG.RDB$TRIGGER_NAME';
1343	>
1344	>	var
1345	>	Header : Boolean;
1346	>	TriggerName, RelationName, InActive: String;
1347	>	qryTriggers : TIBSQL;
1348	>	SList : TStrings;
1349	>	begin
1350	>	Header := true;
1351	>	SList := TStringList.Create;
1352	>	qryTriggers := TIBSQL.Create(FDatabase);
1353	>	try
1354	>	if ObjectName = '' then
1355	>	qryTriggers.SQL.Text := TriggerSQL
1356	>	else
1357	>	begin
1358	>	if etTable in ExtractTypes  then
1359	>	begin
1360	>	qryTriggers.SQL.Text := TriggerNameSQL;
1361	>	qryTriggers.Params.ByName('TableName').AsString := ObjectName;
1362	>	end
1363	>	else
1364	>	begin
1365	>	qryTriggers.SQL.Text := TriggerByNameSQL;
1366	>	qryTriggers.Params.ByName('TriggerName').AsString := ObjectName;
1367	>	end;
1368	>	end;
1369	>	qryTriggers.ExecQuery;
1370	>	while not qryTriggers.Eof do
1371	>	begin
1372	>	SList.Clear;
1373	>	if Header then
1374	>	begin
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	>	[LineEnding, LineEnding]));
1378	>	Header := false;
1379	>	end;
1380	>	TriggerName := qryTriggers.FieldByName('RDB$TRIGGER_NAME').AsString;
1381	>	RelationName := qryTriggers.FieldByName('RDB$RELATION_NAME').AsString;
1382	>	if qryTriggers.FieldByName('RDB$TRIGGER_INACTIVE').IsNull then
1383	>	InActive := 'INACTIVE'
1384	>	else
1385	>	if qryTriggers.FieldByName('RDB$TRIGGER_INACTIVE').AsInteger = 1 then
1386	>	InActive := 'INACTIVE'
1387	>	else
1388	>	InActive := 'ACTIVE';
1389	>
1390	>	if qryTriggers.FieldByName('RDB$FLAGS').AsInteger <> 1 then
1391	>	SList.Add('/* ');
1392	>
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.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
1416	>	begin
1417	>	FMetaData.Add('COMMIT WORK ' + ProcTerm);
1418	>	FMetaData.Add('SET TERM ' + Term + ProcTerm);
1419	>	end;
1420	>	finally
1421	>	qryTriggers.Free;
1422	>	SList.Free;
1423	>	end;
1424	>	end;
1425	>
1426	>	{                      ListCheck
1427	>	Functional description
1428	>	List check constraints for all objects to allow forward references }
1429	>
1430	>	procedure TIBExtract.ListCheck(ObjectName : String; ExtractType : TExtractType);
1431	>	const
1432	>	{ Query gets the check clauses for triggers stored for check constraints }
1433	>	CheckSQL =
1434	>	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +
1435	>	'  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +
1436	>	'WHERE ' +
1437	>	'  TRG.RDB$TRIGGER_TYPE = 1 AND ' +
1438	>	'  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +
1439	>	'    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +
1440	>	'ORDER BY CHK.RDB$CONSTRAINT_NAME';
1441	>
1442	>	CheckNameSQL =
1443	>	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +
1444	>	'  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +
1445	>	'WHERE ' +
1446	>	'  TRG.RDB$RELATION_NAME = :TableName AND ' +
1447	>	'  TRG.RDB$TRIGGER_TYPE = 1 AND ' +
1448	>	'  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +
1449	>	'    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +
1450	>	'ORDER BY CHK.RDB$CONSTRAINT_NAME';
1451	>
1452	>	CheckByNameSQL =
1453	>	'SELECT * FROM RDB$TRIGGERS TRG JOIN RDB$CHECK_CONSTRAINTS CHK ON ' +
1454	>	'  TRG.RDB$TRIGGER_NAME = CHK.RDB$TRIGGER_NAME ' +
1455	>	'WHERE ' +
1456	>	'  TRG.RDB$TRIGGER_NAME = :TriggerName AND ' +
1457	>	'  TRG.RDB$TRIGGER_TYPE = 1 AND ' +
1458	>	'  EXISTS (SELECT RDB$CONSTRAINT_NAME FROM RDB$RELATION_CONSTRAINTS RELC WHERE ' +
1459	>	'    CHK.RDB$CONSTRAINT_NAME = RELC.RDB$CONSTRAINT_NAME) ' +
1460	>	'ORDER BY CHK.RDB$CONSTRAINT_NAME';
1461	>
1462	>	var
1463	>	qryChecks : TIBSQL;
1464	>	SList : TStrings;
1465	>	RelationName : String;
1466	>	begin
1467	>	qryChecks := TIBSQL.Create(FDatabase);
1468	>	SList := TStringList.Create;
1469	>	try
1470	>	if ObjectName = '' then
1471	>	qryChecks.SQL.Text := CheckSQL
1472	>	else
1473	>	if ExtractType = etTable then
1474	>	begin
1475	>	qryChecks.SQL.Text := CheckNameSQL;
1476	>	qryChecks.Params.ByName('TableName').AsString := ObjectName;
1477	>	end
1478	>	else
1479	>	begin
1480	>	qryChecks.SQL.Text := CheckByNameSQL;
1481	>	qryChecks.Params.ByName('TriggerName').AsString := ObjectName;
1482	>	end;
1483	>	qryChecks.ExecQuery;
1484	>	while not qryChecks.Eof do
1485	>	begin
1486	>	SList.Clear;
1487	>	RelationName := qryChecks.FieldByName('RDB$RELATION_NAME').AsString;
1488	>	SList.Add(Format('ALTER TABLE %s ADD',
1489	>	[QuoteIdentifier(FDatabase.SQLDialect, RelationName)]));
1490	>	if Pos('INTEG', qryChecks.FieldByName('RDB$CONSTRAINT_NAME').AsString) <> 1 then
1491	>	SList.Add(Format('%sCONSTRAINT %s ', [TAB,
1492	>	QuoteIdentifier(FDatabase.SQLDialect, qryChecks.FieldByName('RDB$CONSTRAINT_NAME').AsString)]));
1493	>
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) + LineEnding;
1498	>	FMetaData.AddStrings(SList);
1499	>	qryChecks.Next;
1500	>	end;
1501	>	finally
1502	>	qryChecks.Free;
1503	>	SList.Free;
1504	>	end;
1505	>	end;
1506	>
1507	>	{             ListCreateDb
1508	>	Functional description
1509	>	Print the create database command if requested.  At least put
1510	>	the page size in a comment with the extracted db name }
1511	>
1512	>	procedure TIBExtract.ListCreateDb(TargetDb : String);
1513	>	const
1514	>	CharInfoSQL =
1515	>	'SELECT * FROM RDB$DATABASE DBP ' +
1516	>	'WHERE NOT DBP.RDB$CHARACTER_SET_NAME IS NULL ' +
1517	>	'  AND DBP.RDB$CHARACTER_SET_NAME <> '' ''';
1518	>
1519	>	FilesSQL =
1520	>	'select * from RDB$FILES ' +
1521	>	'order BY RDB$SHADOW_NUMBER, RDB$FILE_SEQUENCE';
1522	>
1523	>	LogsSQL =
1524	>	'SELECT * FROM RDB$LOG_FILES ' +
1525	>	'ORDER BY RDB$FILE_FLAGS, RDB$FILE_SEQUENCE';
1526	>
1527	>	var
1528	>	NoDb, First, FirstFile, HasWal, SetUsed : Boolean;
1529	>	Buffer : String;
1530	>	qryDB : TIBSQL;
1531	>	FileFlags, FileLength, FileSequence, FileStart : Integer;
1532	>
1533	>	function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
1534	>	begin
1535	>	with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
1536	>	if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
1537	>	Result := Items[0].AsInteger
1538	>	else
1539	>	IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
1540	>	end;
1541	>
1542	>	begin
1543	>	NoDb := FALSE;
1544	>	First := TRUE;
1545	>	FirstFile := TRUE;
1546	>	HasWal := FALSE;
1547	>	SetUsed := FALSE;
1548	>	Buffer := '';
1549	>	if TargetDb = '' then
1550	>	begin
1551	>	Buffer := '/* ';
1552	>	TargetDb := FDatabase.DatabaseName;
1553	>	NoDb := true;
1554	>	end;
1555	>	Buffer := Buffer + 'CREATE DATABASE ' + QuotedStr(TargetDb) + ' PAGE_SIZE ' +
1556	>	IntToStr(FDatabaseInfo.PageSize) + LineEnding;
1557	>	FMetaData.Add(Buffer);
1558	>	Buffer := '';
1559	>
1560	>	qryDB := TIBSQL.Create(FDatabase);
1561	>	try
1562	>	qryDB.SQL.Text := CharInfoSQL;
1563	>	qryDB.ExecQuery;
1564	>
1565	>	if not qryDB.EOF then
1566	>	Buffer := Format(' DEFAULT CHARACTER SET %s',
1567	>	[trim(qryDB.FieldByName('RDB$CHARACTER_SET_NAME').AsString)]);
1568	>	if NoDB then
1569	>	Buffer := Buffer + Term + ' */'
1570	>	else
1571	>	Buffer := Buffer + Term;
1572	>	FMetaData.Add(Buffer);
1573	>	qryDB.Close;
1574	>	{List secondary files and shadows as
1575	>	alter db and create shadow in comment}
1576	>	qryDB.SQL.Text := FilesSQL;
1577	>	qryDB.ExecQuery;
1578	>	while not qryDB.Eof do
1579	>	begin
1580	>	if First then
1581	>	begin
1582	>	FMetaData.Add(LineEnding + '/* Add secondary files in comments ');
1583	>	First := false;
1584	>	end; //end_if
1585	>
1586	>	if qryDB.FieldByName('RDB$FILE_FLAGS').IsNull then
1587	>	FileFlags := 0
1588	>	else
1589	>	FileFlags := qryDB.FieldByName('RDB$FILE_FLAGS').AsInteger;
1590	>	if qryDB.FieldByName('RDB$FILE_LENGTH').IsNull then
1591	>	FileLength := 0
1592	>	else
1593	>	FileLength := qryDB.FieldByName('RDB$FILE_LENGTH').AsInteger;
1594	>	if qryDB.FieldByName('RDB$FILE_SEQUENCE').IsNull then
1595	>	FileSequence := 0
1596	>	else
1597	>	FileSequence := qryDB.FieldByName('RDB$FILE_SEQUENCE').AsInteger;
1598	>	if qryDB.FieldByName('RDB$FILE_START').IsNull then
1599	>	FileStart := 0
1600	>	else
1601	>	FileStart := qryDB.FieldByName('RDB$FILE_START').AsInteger;
1602	>
1603	>	{ Pure secondary files }
1604	>	if FileFlags = 0 then
1605	>	begin
1606	>	Buffer := Format('%sALTER DATABASE ADD FILE ''%s''',
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
1611	>	Buffer := Buffer + Format(' LENGTH %d', [FileLength]);
1612	>	FMetaData.Add(Buffer);
1613	>	end; //end_if
1614	>	if (FileFlags and FILE_cache) <> 0 then
1615	>	FMetaData.Add(Format('%sALTER DATABASE ADD CACHE ''%s'' LENGTH %d',
1616	>	[LineEnding, qryDB.FieldByName('RDB$FILE_NAME').AsString, FileLength]));
1617	>
1618	>	Buffer := '';
1619	>	if (FileFlags and FILE_shadow) <> 0 then
1620	>	begin
1621	>	if FileSequence <> 0 then
1622	>	Buffer := Format('%sFILE ''%s''',
1623	>	[TAB, qryDB.FieldByName('RDB$FILE_NAME').AsString])
1624	>	else
1625	>	begin
1626	>	Buffer := Format('%sCREATE SHADOW %d ''%s'' ',
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 ';
1631	>	if (FileFlags and FILE_manual) <> 0 then
1632	>	Buffer := Buffer + 'MANUAL '
1633	>	else
1634	>	Buffer := Buffer + 'AUTO ';
1635	>	if (FileFlags and FILE_conditional) <> 0 then
1636	>	Buffer := Buffer + 'CONDITIONAL ';
1637	>	end; //end_else
1638	>	if FileLength <> 0 then
1639	>	Buffer := Buffer + Format('LENGTH %d ', [FileLength]);
1640	>	if FileStart <> 0 then
1641	>	Buffer := Buffer + Format('STARTING %d ', [FileStart]);
1642	>	FMetaData.Add(Buffer);
1643	>	end; //end_if
1644	>	qryDB.Next;
1645	>	end;
1646	>	qryDB.Close;
1647	>
1648	>	qryDB.SQL.Text := LogsSQL;
1649	>	qryDB.ExecQuery;
1650	>	while not qryDB.Eof do
1651	>	begin
1652	>
1653	>	if qryDB.FieldByName('RDB$FILE_FLAGS').IsNull then
1654	>	FileFlags := 0
1655	>	else
1656	>	FileFlags := qryDB.FieldByName('RDB$FILE_FLAGS').AsInteger;
1657	>	if qryDB.FieldByName('RDB$FILE_LENGTH').IsNull then
1658	>	FileLength := 0
1659	>	else
1660	>	FileLength := qryDB.FieldByName('RDB$FILE_LENGTH').AsInteger;
1661	>
1662	>	Buffer := '';
1663	>	HasWal := true;
1664	>	if First then
1665	>	begin
1666	>	if NoDB then
1667	>	Buffer := '/* ';
1668	>	Buffer := Buffer + LineEnding + 'ALTER DATABASE ADD ';
1669	>	First := false;
1670	>	end; //end_if
1671	>	if FirstFile then
1672	>	Buffer := Buffer + 'LOGFILE ';
1673	>	{ Overflow files also have the serial bit set }
1674	>	if (FileFlags and LOG_default) = 0 then
1675	>	begin
1676	>	if (FileFlags and LOG_overflow) <> 0 then
1677	>	Buffer := Buffer + Format(')%s   OVERFLOW ''%s''',
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	>	[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 }
1686	>
1687	>	{ We have round robin and overflow file specifications }
1688	>	else
1689	>	begin
1690	>	if FirstFile then
1691	>	Buffer := Buffer + '('
1692	>	else
1693	>	Buffer := Buffer + Format(',%s  ', [LineEnding]);
1694	>	FirstFile := false;
1695	>
1696	>	Buffer := Buffer + Format('''%s''', [qryDB.FieldByName('RDB$FILE_NAME').AsString]);
1697	>	end; //end_else
1698	>	end;
1699	>	{ Any file can have a length }
1700	>	if FileLength <> 0 then
1701	>	Buffer := Buffer + Format(' SIZE %d ', [FileLength]);
1702	>	FMetaData.Add(Buffer);
1703	>	qryDB.Next;
1704	>	end;
1705	>	qryDB.Close;
1706	>	Buffer := '';
1707	>	if HasWal then
1708	>	begin
1709	>	Buffer := Buffer + PrintSet(SetUsed);
1710	>	Buffer := Buffer + Format('NUM_LOG_BUFFERS = %d',
1711	>	[GetLongDatabaseInfo(isc_info_num_wal_buffers)]);
1712	>	Buffer := Buffer + PrintSet(SetUsed);
1713	>	Buffer := Buffer + Format('LOG_BUFFER_SIZE = %d',
1714	>	[GetLongDatabaseInfo(isc_info_wal_buffer_size)]);
1715	>	Buffer := Buffer + PrintSet(SetUsed);
1716	>	Buffer := Buffer + Format('GROUP_COMMIT_WAIT_TIME = %d',
1717	>	[GetLongDatabaseInfo(isc_info_wal_grpc_wait_usecs)]);
1718	>	Buffer := Buffer + PrintSet(SetUsed);
1719	>	Buffer := Buffer + Format('CHECK_POINT_LENGTH = %d',
1720	>	[GetLongDatabaseInfo(isc_info_wal_ckpt_length)]);
1721	>	FMetaData.Add(Buffer);
1722	>
1723	>	end;
1724	>	if not First then
1725	>	begin
1726	>	if NoDB then
1727	>	FMetaData.Add(Format('%s */%s', [LineEnding, LineEnding]))
1728	>	else
1729	>	FMetaData.Add(Format('%s%s%s', [Term, LineEnding, LineEnding]));
1730	>	end;
1731	>	finally
1732	>	qryDB.Free;
1733	>	end;
1734	>
1735	>	(*
1736	>	*)
1737	>	end;
1738	>
1739	>	{                    ListDomainTable
1740	>	Functional description
1741	>	List domains as identified by fields with any constraints on them
1742	>	for the named table
1743	>
1744	>	Parameters:  table_name == only extract domains for this table }
1745	>
1746	>	procedure TIBExtract.ListDomains(ObjectName: String; ExtractType : TExtractType);
1747	>	const
1748	>	DomainSQL =
1749	>	'SELECT distinct fld.* FROM RDB$FIELDS FLD JOIN RDB$RELATION_FIELDS RFR ON ' +
1750	>	'  RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +
1751	>	'WHERE RFR.RDB$RELATION_NAME = :TABLE_NAME ' +
1752	>	'ORDER BY FLD.RDB$FIELD_NAME';
1753	>
1754	>	DomainByNameSQL =
1755	>	'SELECT * FROM RDB$FIELDS FLD ' +
1756	>	'WHERE FLD.RDB$FIELD_NAME = :DomainName ' +
1757	>	'ORDER BY FLD.RDB$FIELD_NAME';
1758	>
1759	>	AllDomainSQL =
1760	>	'select * from RDB$FIELDS ' +
1761	>	'where RDB$SYSTEM_FLAG <> 1 ' +
1762	>	'order BY RDB$FIELD_NAME';
1763	>
1764	>	var
1765	>	First : Boolean;
1766	>	qryDomains : TIBSQL;
1767	>	FieldName, Line : String;
1768	>
1769	>	function FormatDomainStr : String;
1770	>	var
1771	>	i, SubType : Integer;
1772	>	PrecisionKnown : Boolean;
1773	>	begin
1774	>	Result := '';
1775	>	for i := Low(ColumnTypes) to High(ColumnTypes) do
1776	>	if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = ColumnTypes[i].SQLType then
1777	>	begin
1778	>	PrecisionKnown := FALSE;
1779	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
1780	>	begin
1781	>	if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_short, blr_long, blr_int64] then
1782	>	begin
1783	>	{ We are ODS >= 10 and could be any Dialect }
1784	>	if (FDatabaseInfo.DBSQLDialect >= 3) and
1785	>	(not qryDomains.FieldByName('RDB$FIELD_PRECISION').IsNull) and
1786	>	(qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
1787	>	(qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
1788	>	begin
1789	>	Result := Result + Format('%s(%d, %d)', [
1790	>	IntegralSubtypes [qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
1791	>	qryDomains.FieldByName('RDB$FIELD_PRECISION').AsInteger,
1792	>	-1 * qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger]);
1793	>	PrecisionKnown := true;
1794	>	end;
1795	>	end;
1796	>	end;
1797	>	if PrecisionKnown = false then
1798	>	begin
1799	>	{ Take a stab at numerics and decimals }
1800	>	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_short) and
1801	>	(qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
1802	>	Result := Result + Format('NUMERIC(4, %d)',
1803	>	[-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )
1804	>	else
1805	>	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_long) and
1806	>	(qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
1807	>	Result := Result + Format('NUMERIC(9, %d)',
1808	>	[-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )
1809	>	else
1810	>	if (qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_double) and
1811	>	(qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger  < 0) then
1812	>	Result := Result + Format('NUMERIC(15, %d)',
1813	>	[-qryDomains.FieldByName('RDB$FIELD_SCALE').AsInteger] )
1814	>	else
1815	>	Result := Result + ColumnTypes[i].TypeName;
1816	>	end;
1817	>	break;
1818	>	end;
1819	>
1820	>	if qryDomains.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_blob then
1821	>	begin
1822	>	subtype := qryDomains.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger;
1823	>	Result := Result + ' SUB_TYPE ';
1824	>	if (subtype > 0) and (subtype <= MAXSUBTYPES) then
1825	>	Result := Result + SubTypes[subtype]
1826	>	else
1827	>	Result := Result + Format('%d', [subtype]);
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]) 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. }
1841	>	if not qryDomains.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
1842	>	Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1843	>	0, FALSE);
1844	>	if not qryDomains.FieldByName('RDB$DIMENSIONS').IsNull then
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', [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', [LineEnding, TAB,
1854	>	qryDomains.FieldByName('RDB$VALIDATION_SOURCE').AsString])
1855	>	else
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
1860	>	Result := Result + ' NOT NULL';
1861	>
1862	>	{ Show the collation order if one has been specified.  If the collation
1863	>	order is the default for the character set being used, then no collation
1864	>	order will be shown ( because it isn't needed ).
1865	>
1866	>	If the collation id is 0, then the default for the character set is
1867	>	being used so there is no need to retrieve the collation information.}
1868	>
1869	>	if (not qryDomains.FieldByName('RDB$COLLATION_ID').IsNull) and
1870	>	(qryDomains.FieldByName('RDB$COLLATION_ID').AsInteger <> 0) then
1871	>	Result := Result + GetCharacterSets(qryDomains.FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
1872	>	qryDomains.FieldByName('RDB$COLLATION_ID').AsInteger, true);
1873	>	end;
1874	>
1875	>	begin
1876	>	First := true;
1877	>	qryDomains := TIBSQL.Create(FDatabase);
1878	>	try
1879	>	if ObjectName <> '' then
1880	>	begin
1881	>	if ExtractType = etTable then
1882	>	begin
1883	>	qryDomains.SQL.Text := DomainSQL;
1884	>	qryDomains.Params.ByName('table_name').AsString := ObjectName;
1885	>	end
1886	>	else
1887	>	begin
1888	>	qryDomains.SQL.Text := DomainByNameSQL;
1889	>	qryDomains.Params.ByName('DomainName').AsString := ObjectName;
1890	>	end;
1891	>	end
1892	>	else
1893	>	qryDomains.SQL.Text := AllDomainSQL;
1894	>
1895	>	qryDomains.ExecQuery;
1896	>	while not qryDomains.Eof do
1897	>	begin
1898	>	FieldName := qryDomains.FieldByName('RDB$FIELD_NAME').AsString;
1899	>	{ Skip over artifical domains }
1900	>	if (Pos('RDB$',FieldName) = 1) and
1901	>	(FieldName[5] in ['0'..'9']) and
1902	>	(qryDomains.FieldByName('RDB$SYSTEM_FLAG').AsInteger <> 1) then
1903	>	begin
1904	>	qryDomains.Next;
1905	>	continue;
1906	>	end;
1907	>
1908	>	if First then
1909	>	begin
1910	>	FMetaData.Add('/* Domain definitions */');
1911	>	First := false;
1912	>	end;
1913	>
1914	>	Line := Format('CREATE DOMAIN %s AS ', [FieldName]);
1915	>	Line := Line + FormatDomainStr + Term;
1916	>	FMetaData.Add(Line);
1917	>	qryDomains.Next;
1918	>	end;
1919	>	finally
1920	>	qryDomains.Free;
1921	>	end;
1922	>	end;
1923	>
1924	>	{          ListException
1925	>	Functional description
1926	>	List all exceptions defined in the database
1927	>
1928	>	Parameters:  none }
1929	>
1930	>	procedure TIBExtract.ListException(ExceptionName : String = '');
1931	>	const
1932	>	ExceptionSQL =
1933	>	'select * from RDB$EXCEPTIONS ' +
1934	>	'ORDER BY RDB$EXCEPTION_NAME';
1935	>
1936	>	ExceptionNameSQL =
1937	>	'select * from RDB$EXCEPTIONS ' +
1938	>	'WHERE RDB$EXCEPTION_NAME = :ExceptionName ' +
1939	>	'ORDER BY RDB$EXCEPTION_NAME';
1940	>
1941	>	var
1942	>	First : Boolean;
1943	>	qryException : TIBSQL;
1944	>	begin
1945	>	First := true;
1946	>	qryException := TIBSQL.Create(FDatabase);
1947	>	try
1948	>	if ExceptionName = '' then
1949	>	qryException.SQL.Text := ExceptionSQL
1950	>	else
1951	>	begin
1952	>	qryException.SQL.Text := ExceptionNameSQL;
1953	>	qryException.Params.ByName('ExceptionName').AsString := ExceptionName;
1954	>	end;
1955	>
1956	>	qryException.ExecQuery;
1957	>	while not qryException.Eof do
1958	>	begin
1959	>	if First then
1960	>	begin
1961	>	FMetaData.Add('');
1962	>	FMetaData.Add('/*  Exceptions */');
1963	>	FMetaData.Add('');
1964	>	First := false;
1965	>	end; //end_if
1966	>
1967	>	FMetaData.Add(Format('CREATE EXCEPTION %s %s%s',
1968	>	[QuoteIdentifier(FDatabase.SQLDialect, qryException.FieldByName('RDB$EXCEPTION_NAME').AsString),
1969	>	QuotedStr(qryException.FieldByName('RDB$MESSAGE').AsString), Term]));
1970	>	qryException.Next;
1971	>	end;
1972	>	finally
1973	>	qryException.Free;
1974	>	end;
1975	>	end;
1976	>
1977	>	{              ListFilters
1978	>
1979	>	Functional description
1980	>	List all blob filters
1981	>
1982	>	Parameters:  none
1983	>	Results in
1984	>	DECLARE FILTER <fname> INPUT_TYPE <blob_sub_type> OUTPUT_TYPE <blob_subtype>
1985	>	ENTRY_POINT <string> MODULE_NAME <string> }
1986	>
1987	>	procedure TIBExtract.ListFilters(FilterName : String = '');
1988	>	const
1989	>	FiltersSQL =
1990	>	'SELECT * FROM RDB$FILTERS ' +
1991	>	'ORDER BY RDB$FUNCTION_NAME';
1992	>	FilterNameSQL =
1993	>	'SELECT * FROM RDB$FILTERS ' +
1994	>	'WHERE RDB$FUNCTION_NAME = :FunctionName ' +
1995	>	'ORDER BY RDB$FUNCTION_NAME';
1996	>
1997	>	var
1998	>	First : Boolean;
1999	>	qryFilters : TIBSQL;
2000	>	begin
2001	>	First := true;
2002	>	qryFilters := TIBSQL.Create(FDatabase);
2003	>	try
2004	>	if FilterName = '' then
2005	>	qryFilters.SQL.Text := FiltersSQL
2006	>	else
2007	>	begin
2008	>	qryFilters.SQL.Text := FilterNameSQL;
2009	>	qryFilters.Params.ByName('FunctionName').AsString := FilterName;
2010	>	end;
2011	>	qryFilters.ExecQuery;
2012	>	while not qryFilters.Eof do
2013	>	begin
2014	>	if First then
2015	>	begin
2016	>	FMetaData.Add('');
2017	>	FMetaData.Add('/*  BLOB Filter declarations */');
2018	>	FMetaData.Add('');
2019	>	First := false;
2020	>	end; //end_if
2021	>
2022	>	FMetaData.Add(Format('DECLARE FILTER %s INPUT_TYPE %d OUTPUT_TYPE %d',
2023	>	[qryFilters.FieldByName('RDB$FUNCTION_NAME').AsString,
2024	>	qryFilters.FieldByName('RDB$INPUT_SUB_TYPE').AsInteger,
2025	>	qryFilters.FieldByName('RDB$OUTPUT_SUB_TYPE').AsInteger]));
2026	>	FMetaData.Add(Format('%sENTRY_POINT ''%s'' MODULE_NAME ''%s''%s%',
2027	>	[TAB, qryFilters.FieldByName('RDB$ENTRYPOINT').AsString,
2028	>	qryFilters.FieldByName('RDB$MODULE_NAME').AsString, Term]));
2029	>	FMetaData.Add('');
2030	>
2031	>	qryFilters.Next;
2032	>	end;
2033	>
2034	>	finally
2035	>	qryFilters.Free;
2036	>	end;
2037	>	end;
2038	>
2039	>	{            ListForeign
2040	>	Functional description
2041	>	List all foreign key constraints and alter the tables }
2042	>
2043	>	procedure TIBExtract.ListForeign(ObjectName : String; ExtractType : TExtractType);
2044	>	const
2045	>	{ Static queries for obtaining foreign constraints, where RELC1 is the
2046	>	foreign key constraints, RELC2 is the primary key lookup and REFC
2047	>	is the join table }
2048	>	ForeignSQL =
2049	>	'SELECT REFC.RDB$UPDATE_RULE REFC_UPDATE_RULE, REFC.RDB$DELETE_RULE REFC_DELETE_RULE, ' +
2050	>	'  RELC1.RDB$RELATION_NAME RELC1_RELATION_NAME, RELC2.RDB$RELATION_NAME RELC2_RELATION_NAME, ' +
2051	>	'  RELC1.RDB$INDEX_NAME RELC1_INDEX_NAME, RELC1.RDB$CONSTRAINT_NAME RELC1_CONSTRAINT_NAME, ' +
2052	>	'  RELC2.RDB$INDEX_NAME RELC2_INDEX_NAME ' +
2053	>	'FROM RDB$REF_CONSTRAINTS REFC, RDB$RELATION_CONSTRAINTS RELC1, ' +
2054	>	'     RDB$RELATION_CONSTRAINTS RELC2 ' +
2055	>	'WHERE ' +
2056	>	'  RELC1.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'' AND ' +
2057	>	'  REFC.RDB$CONST_NAME_UQ = RELC2.RDB$CONSTRAINT_NAME AND ' +
2058	>	'  REFC.RDB$CONSTRAINT_NAME = RELC1.RDB$CONSTRAINT_NAME AND ' +
2059	>	'  (RELC2.RDB$CONSTRAINT_TYPE = ''UNIQUE'' OR ' +
2060	>	'    RELC2.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'') ' +
2061	>	'ORDER BY RELC1.RDB$RELATION_NAME, RELC1.RDB$CONSTRAINT_NAME';
2062	>
2063	>	ForeignNameSQL =
2064	>	'SELECT REFC.RDB$UPDATE_RULE REFC_UPDATE_RULE, REFC.RDB$DELETE_RULE REFC_DELETE_RULE, ' +
2065	>	'  RELC1.RDB$RELATION_NAME RELC1_RELATION_NAME, RELC2.RDB$RELATION_NAME RELC2_RELATION_NAME, ' +
2066	>	'  RELC1.RDB$INDEX_NAME RELC1_INDEX_NAME, RELC1.RDB$CONSTRAINT_NAME RELC1_CONSTRAINT_NAME, ' +
2067	>	'  RELC2.RDB$INDEX_NAME RELC2_INDEX_NAME ' +
2068	>	'FROM RDB$REF_CONSTRAINTS REFC, RDB$RELATION_CONSTRAINTS RELC1, ' +
2069	>	'     RDB$RELATION_CONSTRAINTS RELC2 ' +
2070	>	'WHERE ' +
2071	>	'  RELC1.RDB$RELATION_NAME = :TableName AND ' +
2072	>	'  RELC1.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'' AND ' +
2073	>	'  REFC.RDB$CONST_NAME_UQ = RELC2.RDB$CONSTRAINT_NAME AND ' +
2074	>	'  REFC.RDB$CONSTRAINT_NAME = RELC1.RDB$CONSTRAINT_NAME AND ' +
2075	>	'  (RELC2.RDB$CONSTRAINT_TYPE = ''UNIQUE'' OR ' +
2076	>	'    RELC2.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'') ' +
2077	>	'ORDER BY RELC1.RDB$RELATION_NAME, RELC1.RDB$CONSTRAINT_NAME';
2078	>
2079	>	ForeignByNameSQL =
2080	>	'SELECT REFC.RDB$UPDATE_RULE REFC_UPDATE_RULE, REFC.RDB$DELETE_RULE REFC_DELETE_RULE, ' +
2081	>	'  RELC1.RDB$RELATION_NAME RELC1_RELATION_NAME, RELC2.RDB$RELATION_NAME RELC2_RELATION_NAME, ' +
2082	>	'  RELC1.RDB$INDEX_NAME RELC1_INDEX_NAME, RELC1.RDB$CONSTRAINT_NAME RELC1_CONSTRAINT_NAME, ' +
2083	>	'  RELC2.RDB$INDEX_NAME RELC2_INDEX_NAME ' +
2084	>	'FROM RDB$REF_CONSTRAINTS REFC, RDB$RELATION_CONSTRAINTS RELC1, ' +
2085	>	'     RDB$RELATION_CONSTRAINTS RELC2 ' +
2086	>	'WHERE ' +
2087	>	'  RELC1.RDB$CONSTRAINT_NAME = :ConstraintName AND ' +
2088	>	'  RELC1.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'' AND ' +
2089	>	'  REFC.RDB$CONST_NAME_UQ = RELC2.RDB$CONSTRAINT_NAME AND ' +
2090	>	'  REFC.RDB$CONSTRAINT_NAME = RELC1.RDB$CONSTRAINT_NAME AND ' +
2091	>	'  (RELC2.RDB$CONSTRAINT_TYPE = ''UNIQUE'' OR ' +
2092	>	'    RELC2.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'') ' +
2093	>	'ORDER BY RELC1.RDB$RELATION_NAME, RELC1.RDB$CONSTRAINT_NAME';
2094	>
2095	>	var
2096	>	qryForeign : TIBSQL;
2097	>	Line : String;
2098	>
2099	>	begin
2100	>	qryForeign := TIBSQL.Create(FDatabase);
2101	>	try
2102	>	if ObjectName = '' then
2103	>	qryForeign.SQL.Text := ForeignSQL
2104	>	else
2105	>	begin
2106	>	if ExtractType = etTable then
2107	>	begin
2108	>	qryForeign.SQL.Text := ForeignNameSQL;
2109	>	qryForeign.Params.ByName('TableName').AsString := ObjectName;
2110	>	end
2111	>	else
2112	>	begin
2113	>	qryForeign.SQL.Text := ForeignByNameSQL;
2114	>	qryForeign.Params.ByName('ConstraintName').AsString := ObjectName;
2115	>	end;
2116	>	end;
2117	>	qryForeign.ExecQuery;
2118	>	while not qryForeign.Eof do
2119	>	begin
2120	>	Line := Format('ALTER TABLE %s ADD ', [QuoteIdentifier(FDatabase.SQLDialect,
2121	>	qryForeign.FieldByName('RELC1_RELATION_NAME').AsString)]);
2122	>
2123	>	{ If the name of the constraint is not INTEG..., print it.
2124	>	INTEG... are internally generated names. }
2125	>	if (not qryForeign.FieldByName('RELC1_CONSTRAINT_NAME').IsNull) and
2126	>	( Pos('INTEG', qryForeign.FieldByName('RELC1_CONSTRAINT_NAME').AsString) <> 1) then
2127	>	Line := Line + Format('CONSTRAINT %s ', [QuoteIdentifier(FDatabase.SQLDialect,
2128	>	Trim(qryForeign.FieldByName('RELC1_CONSTRAINT_NAME').AsString))]);
2129	>
2130	>	Line := Line + Format('FOREIGN KEY (%s) REFERENCES %s ', [
2131	>	GetIndexSegments(qryForeign.FieldByName('RELC1_INDEX_NAME').AsString),
2132	>	Trim(qryForeign.FieldByName('RELC2_RELATION_NAME').AsString)]);
2133	>
2134	>	Line := Line + Format('(%s)',
2135	>	[GetIndexSegments(qryForeign.FieldByName('RELC2_INDEX_NAME').AsString)]);
2136	>
2137	>	{ Add the referential actions, if any }
2138	>	if (not qryForeign.FieldByName('REFC_UPDATE_RULE').IsNull) and
2139	>	(Trim(qryForeign.FieldByName('REFC_UPDATE_RULE').AsString) <> 'RESTRICT') then
2140	>	Line := Line + Format(' ON UPDATE %s',
2141	>	[Trim(qryForeign.FieldByName('REFC_UPDATE_RULE').AsString)]);
2142	>
2143	>	if (not qryForeign.FieldByName('REFC_DELETE_RULE').IsNull) and
2144	>	(Trim(qryForeign.FieldByName('REFC_DELETE_RULE').AsString) <> 'RESTRICT') then
2145	>	Line := Line + Format(' ON DELETE %s',
2146	>	[Trim(qryForeign.FieldByName('REFC_DELETE_RULE').AsString)]);
2147	>
2148	>	Line := Line + Term;
2149	>	FMetaData.Add(Line);
2150	>	qryForeign.Next;
2151	>	end;
2152	>	finally
2153	>	qryForeign.Free;
2154	>	end;
2155	>	end;
2156	>
2157	>	{    ListFunctions
2158	>
2159	>	Functional description
2160	>	List all external functions
2161	>
2162	>	Parameters:  none
2163	>	Results in
2164	>	DECLARE EXTERNAL FUNCTION function_name
2165	>	CHAR [256] , INTEGER, ....
2166	>	RETURNS INTEGER BY VALUE
2167	>	ENTRY_POINT entrypoint MODULE_NAME module; }
2168	>
2169	>	procedure TIBExtract.ListFunctions(FunctionName : String = '');
2170	>	const
2171	>	FunctionSQL =
2172	>	'SELECT * FROM RDB$FUNCTIONS WHERE RDB$SYSTEM_FLAG = 0 ' +
2173	>	'ORDER BY RDB$FUNCTION_NAME';
2174	>
2175	>	FunctionNameSQL =
2176	>	'SELECT * FROM RDB$FUNCTIONS ' +
2177	>	'WHERE RDB$FUNCTION_NAME = :FunctionName ' +
2178	>	'ORDER BY RDB$FUNCTION_NAME';
2179	>
2180	>	FunctionArgsSQL =
2181	>	'SELECT * FROM RDB$FUNCTION_ARGUMENTS ' +
2182	>	'WHERE ' +
2183	>	'  :FUNCTION_NAME = RDB$FUNCTION_NAME ' +
2184	>	'ORDER BY RDB$ARGUMENT_POSITION';
2185	>
2186	>	FuncArgsPosSQL =
2187	>	'SELECT * FROM RDB$FUNCTION_ARGUMENTS ' +
2188	>	'WHERE ' +
2189	>	'  RDB$FUNCTION_NAME = :RDB$FUNCTION_NAME AND ' +
2190	>	'  RDB$ARGUMENT_POSITION = :RDB$ARGUMENT_POSITION';
2191	>
2192	>	CharSetSQL =
2193	>	'SELECT * FROM RDB$CHARACTER_SETS ' +
2194	>	'WHERE ' +
2195	>	'  RDB$CHARACTER_SET_ID = :CHARACTER_SET_ID';
2196	>
2197	>	var
2198	>	qryFunctions, qryFuncArgs, qryCharSets, qryFuncPos : TIBSQL;
2199	>	First, FirstArg, DidCharset, PrecisionKnown : Boolean;
2200	>	ReturnBuffer, TypeBuffer, Line : String;
2201	>	i, FieldType : Integer;
2202	>	begin
2203	>	First := true;
2204	>	qryFunctions := TIBSQL.Create(FDatabase);
2205	>	qryFuncArgs := TIBSQL.Create(FDatabase);
2206	>	qryFuncPos := TIBSQL.Create(FDatabase);
2207	>	qryCharSets := TIBSQL.Create(FDatabase);
2208	>	try
2209	>	if FunctionName = '' then
2210	>	qryFunctions.SQL.Text := FunctionSQL
2211	>	else
2212	>	begin
2213	>	qryFunctions.SQL.Text := FunctionNameSQL;
2214	>	qryFunctions.Params.ByName('FunctionName').AsString := FunctionName;
2215	>	end;
2216	>	qryFuncArgs.SQL.Text := FunctionArgsSQL;
2217	>	qryFuncPos.SQL.Text := FuncArgsPosSQL;
2218	>	qryCharSets.SQL.Text := CharSetSQL;
2219	>	qryFunctions.ExecQuery;
2220	>	while not qryFunctions.Eof do
2221	>	begin
2222	>	if First then
2223	>	begin
2224	>	FMEtaData.Add(Format('%s/*  External Function declarations */%s',
2225	>	[LineEnding, LineEnding]));
2226	>	First := false;
2227	>	end; //end_if
2228	>	{ Start new function declaration }
2229	>	FMetaData.Add(Format('DECLARE EXTERNAL FUNCTION %s',
2230	>	[qryFunctions.FieldByName('RDB$FUNCTION_NAME').AsString]));
2231	>	Line := '';
2232	>
2233	>	FirstArg := true;
2234	>	qryFuncArgs.Params.ByName('FUNCTION_NAME').AsString :=
2235	>	qryFunctions.FieldByName('RDB$FUNCTION_NAME').AsString;
2236	>
2237	>	qryFuncArgs.ExecQuery;
2238	>	while not qryFuncArgs.Eof do
2239	>	begin
2240	>	{ Find parameter type }
2241	>	i := 0;
2242	>	FieldType := qryFuncArgs.FieldByName('RDB$FIELD_TYPE').AsInteger;
2243	>	while FieldType <> ColumnTypes[i].SQLType do
2244	>	Inc(i);
2245	>
2246	>	{ Print length where appropriate }
2247	>	if FieldType in [ blr_text, blr_varying, blr_cstring] then
2248	>	begin
2249	>	DidCharset := false;
2250	>
2251	>	qryCharSets.Params.ByName('CHARACTER_SET_ID').AsString :=
2252	>	qryFuncArgs.FieldByName('RDB$CHARACTER_SET_ID').AsString;
2253	>	qryCharSets.ExecQuery;
2254	>	while not qryCharSets.Eof do
2255	>	begin
2256	>	DidCharset := true;
2257	>	TypeBuffer := Format('%s(%d) CHARACTER SET %s',
2258	>	[ColumnTypes[i].TypeName,
2259	>	qryFuncArgs.FieldByName('RDB$FIELD_LENGTH').AsInteger div
2260	>	Max(1,qryCharSets.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger),
2261	>	qryCharSets.FieldByName('RDB$CHARACTER_SET_NAME').AsString]);
2262	>	qryCharSets.Next;
2263	>	end;
2264	>	qryCharSets.Close;
2265	>	if not DidCharset then
2266	>	TypeBuffer := Format('%s(%d)', [ColumnTypes[i].TypeName,
2267	>	qryFuncArgs.FieldByName('RDB$FIELD_LENGTH').AsInteger]);
2268	>	end //end_if
2269	>	else
2270	>	begin
2271	>	PrecisionKnown := false;
2272	>	if (FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10) and
2273	>	(FieldType in [blr_short, blr_long, blr_int64]) then
2274	>	begin
2275	>	qryFuncPos.Params.ByName('RDB$FUNCTION_NAME').AsString :=
2276	>	qryFuncArgs.FieldByName('RDB$FUNCTION_NAME').AsString;
2277	>	qryFuncPos.Params.ByName('RDB$ARGUMENT_POSITION').AsInteger :=
2278	>	qryFuncArgs.FieldByName('RDB$ARGUMENT_POSITION').AsInteger;
2279	>
2280	>	qryFuncPos.ExecQuery;
2281	>	while not qryFuncPos.Eof do
2282	>	begin
2283	>	{ We are ODS >= 10 and could be any Dialect }
2284	>	if not qryFuncPos.FieldByName('RDB$FIELD_PRECISION').IsNull then
2285	>	begin
2286	>	{ We are Dialect >=3 since FIELD_PRECISION is non-NULL }
2287	>	if (qryFuncPos.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
2288	>	(qryFuncPos.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
2289	>	begin
2290	>	TypeBuffer := Format('%s(%d, %d)',
2291	>	[IntegralSubtypes[qryFuncPos.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
2292	>	qryFuncPos.FieldByName('RDB$FIELD_PRECISION').AsInteger,
2293	>	-qryFuncPos.FieldByName('RDB$FIELD_SCALE').AsInteger] );
2294	>	PrecisionKnown := true;
2295	>	end; //end_if
2296	>	end; { if field_precision is not null }
2297	>	qryFuncPos.Next;
2298	>	end;
2299	>	qryFuncPos.Close;
2300	>	end; { if major_ods >= ods_version10 && }
2301	>	if not PrecisionKnown then
2302	>	begin
2303	>	{ Take a stab at numerics and decimals }
2304	>	if (FieldType = blr_short) and
2305	>	(qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2306	>	TypeBuffer := Format('NUMERIC(4, %d)',
2307	>	[-qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger])
2308	>	else
2309	>	if (FieldType = blr_long) and
2310	>	(qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2311	>	TypeBuffer := Format('NUMERIC(9, %d)',
2312	>	[-qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger])
2313	>	else
2314	>	if (FieldType = blr_double) and
2315	>	(qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
2316	>	TypeBuffer := Format('NUMERIC(15, %d)',
2317	>	[-qryFuncArgs.FieldByName('RDB$FIELD_SCALE').AsInteger])
2318	>	else
2319	>	TypeBuffer := ColumnTypes[i].TypeName;
2320	>	end; { if  not PrecisionKnown  }
2321	>	end; { if FCHAR or VARCHAR or CSTRING ... else }
2322	>
2323	>	if qryFunctions.FieldByName('RDB$RETURN_ARGUMENT').AsInteger =
2324	>	qryFuncArgs.FieldByName('RDB$ARGUMENT_POSITION').AsInteger then
2325	>	begin
2326	>	ReturnBuffer := 'RETURNS ' + TypeBuffer;
2327	>	if qryFuncArgs.FieldByName('RDB$MECHANISM').AsInteger = 0 then
2328	>	ReturnBuffer := ReturnBuffer + ' BY VALUE ';
2329	>	if qryFuncArgs.FieldByName('RDB$MECHANISM').AsInteger < 0 then
2330	>	ReturnBuffer := ReturnBuffer + ' FREE_IT';
2331	>	end
2332	>	else
2333	>	begin
2334	>	{ First arg needs no comma }
2335	>	if FirstArg then
2336	>	begin
2337	>	Line := Line + TypeBuffer;
2338	>	FirstArg := false;
2339	>	end
2340	>	else
2341	>	Line := Line + ', ' + TypeBuffer;
2342	>	end; //end_else
2343	>	qryFuncArgs.Next;
2344	>	end;
2345	>	qryFuncArgs.Close;
2346	>
2347	>	FMetaData.Add(Line);
2348	>	FMetaData.Add(ReturnBuffer);
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, LineEnding, LineEnding]));
2353	>
2354	>	qryFunctions.Next;
2355	>	end;
2356	>	finally
2357	>	qryFunctions.Free;
2358	>	qryFuncArgs.Free;
2359	>	qryCharSets.Free;
2360	>	qryFuncPos.Free;
2361	>	end;
2362	>	end;
2363	>
2364	>	{  ListGenerators
2365	>	Functional description
2366	>	Re create all non-system generators }
2367	>
2368	>	procedure TIBExtract.ListGenerators(GeneratorName: String;
2369	>	ExtractTypes: TExtractTypes);
2370	>	const
2371	>	GeneratorSQL =
2372	>	'SELECT RDB$GENERATOR_NAME ' +
2373	>	'FROM RDB$GENERATORS ' +
2374	>	'WHERE ' +
2375	>	'  (RDB$SYSTEM_FLAG IS NULL OR RDB$SYSTEM_FLAG <> 1) ' +
2376	>	'ORDER BY RDB$GENERATOR_NAME';
2377	>
2378	>	GeneratorNameSQL =
2379	>	'SELECT RDB$GENERATOR_NAME ' +
2380	>	'FROM RDB$GENERATORS ' +
2381	>	'WHERE RDB$GENERATOR_NAME = :GeneratorName AND ' +
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
2398	>	else
2399	>	begin
2400	>	qryGenerator.SQL.Text := GeneratorNameSQL;
2401	>	qryGenerator.Params.ByName('GeneratorName').AsString := GeneratorName;
2402	>	end;
2403	>	qryGenerator.ExecQuery;
2404	>	FMetaData.Add('');
2405	>	while not qryGenerator.Eof do
2406	>	begin
2407	>	GenName := qryGenerator.FieldByName('RDB$GENERATOR_NAME').AsString;
2408	>	if ((Pos('RDB$',GenName) = 1) and
2409	>	(GenName[5] in ['0'..'9'])) or
2410	>	((Pos('SQL$',GenName) = 1) and
2411	>	(GenName[5] in ['0'..'9'])) then
2412	>	begin
2413	>	qryGenerator.Next;
2414	>	continue;
2415	>	end;
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	>
2440	>	{       ListIndex
2441	>	Functional description
2442	>	Define all non-constraint indices
2443	>	Use a static SQL query to get the info and print it.
2444	>
2445	>	Uses get_index_segment to provide a key list for each index }
2446	>
2447	>	procedure TIBExtract.ListIndex(ObjectName : String; ExtractType : TExtractType);
2448	>	const
2449	>	IndexSQL =
2450	>	'SELECT IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, IDX.RDB$UNIQUE_FLAG, ' +
2451	>	'       IDX.RDB$INDEX_TYPE ' +
2452	>	'FROM RDB$INDICES IDX JOIN RDB$RELATIONS RELC ON ' +
2453	>	'  IDX.RDB$RELATION_NAME = RELC.RDB$RELATION_NAME ' +
2454	>	'WHERE (RELC.RDB$SYSTEM_FLAG <> 1 OR RELC.RDB$SYSTEM_FLAG IS NULL) AND ' +
2455	>	'  NOT EXISTS (SELECT * FROM RDB$RELATION_CONSTRAINTS RC ' +
2456	>	'    WHERE RC.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME) ' +
2457	>	'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME';
2458	>
2459	>	IndexNameSQL =
2460	>	'SELECT IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, IDX.RDB$UNIQUE_FLAG, ' +
2461	>	'       IDX.RDB$INDEX_TYPE ' +
2462	>	'FROM RDB$INDICES IDX JOIN RDB$RELATIONS RELC ON ' +
2463	>	'  IDX.RDB$RELATION_NAME = RELC.RDB$RELATION_NAME ' +
2464	>	'WHERE (RELC.RDB$SYSTEM_FLAG <> 1 OR RELC.RDB$SYSTEM_FLAG IS NULL) AND ' +
2465	>	'  RELC.RDB$RELATION_NAME = :RelationName AND ' +
2466	>	'  NOT EXISTS (SELECT * FROM RDB$RELATION_CONSTRAINTS RC ' +
2467	>	'    WHERE RC.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME) ' +
2468	>	'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME';
2469	>
2470	>	IndexByNameSQL =
2471	>	'SELECT IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, IDX.RDB$UNIQUE_FLAG, ' +
2472	>	'       IDX.RDB$INDEX_TYPE ' +
2473	>	'FROM RDB$INDICES IDX JOIN RDB$RELATIONS RELC ON ' +
2474	>	'  IDX.RDB$RELATION_NAME = RELC.RDB$RELATION_NAME ' +
2475	>	'WHERE (RELC.RDB$SYSTEM_FLAG <> 1 OR RELC.RDB$SYSTEM_FLAG IS NULL) AND ' +
2476	>	'  IDX.RDB$INDEX_NAME = :IndexName AND ' +
2477	>	'  NOT EXISTS (SELECT * FROM RDB$RELATION_CONSTRAINTS RC ' +
2478	>	'    WHERE RC.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME) ' +
2479	>	'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME';
2480	>
2481	>	var
2482	>	qryIndex : TIBSQL;
2483	>	First : Boolean;
2484	>	Unique, IdxType, Line : String;
2485	>	begin
2486	>	First := true;
2487	>	qryIndex := TIBSQL.Create(FDatabase);
2488	>	try
2489	>	if ObjectName = '' then
2490	>	qryIndex.SQL.Text := IndexSQL
2491	>	else
2492	>	begin
2493	>	if ExtractType = etTable then
2494	>	begin
2495	>	qryIndex.SQL.Text := IndexNameSQL;
2496	>	qryIndex.Params.ByName('RelationName').AsString := ObjectName;
2497	>	end
2498	>	else
2499	>	begin
2500	>	qryIndex.SQL.Text := IndexByNameSQL;
2501	>	qryIndex.Params.ByName('IndexName').AsString := ObjectName;
2502	>	end;
2503	>	end;
2504	>	qryIndex.ExecQuery;
2505	>	while not qryIndex.Eof do
2506	>	begin
2507	>	if First then
2508	>	begin
2509	>	if ObjectName = '' then
2510	>	FMetaData.Add(LineEnding + '/*  Index definitions for all user tables */' + LineEnding)
2511	>	else
2512	>	FMetaData.Add(LineEnding + '/*  Index definitions for ' + ObjectName + ' */' + LineEnding);
2513	>	First := false;
2514	>	end; //end_if
2515	>
2516	>	if qryIndex.FieldByName('RDB$UNIQUE_FLAG').AsInteger = 1 then
2517	>	Unique := ' UNIQUE'
2518	>	else
2519	>	Unique := '';
2520	>
2521	>	if qryIndex.FieldByName('RDB$INDEX_TYPE').AsInteger = 1 then
2522	>	IdxType := ' DESCENDING'
2523	>	else
2524	>	IdxType := '';
2525	>
2526	>	Line := Format('CREATE%s%s INDEX %s ON %s(', [Unique, IdxType,
2527	>	QuoteIdentifier(FDataBase.SQLDialect,
2528	>	qryIndex.FieldByName('RDB$INDEX_NAME').AsString),
2529	>	QuoteIdentifier(FDataBase.SQLDialect,
2530	>	qryIndex.FieldByName('RDB$RELATION_NAME').AsString)]);
2531	>
2532	>	Line := Line + GetIndexSegments(qryIndex.FieldByName('RDB$INDEX_NAME').AsString) +
2533	>	')' + Term;
2534	>
2535	>	FMetaData.Add(Line);
2536	>	qryIndex.Next;
2537	>	end;
2538	>	finally
2539	>	qryIndex.Free;
2540	>	end;
2541	>	end;
2542	>
2543	>	{    ListViews
2544	>	Functional description
2545	>	Show text of views.
2546	>	Use a SQL query to get the info and print it.
2547	>	Note: This should also contain check option }
2548	>
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'; }
2576	>
2577	>	ViewNameSQL =
2578	>	'SELECT RDB$RELATION_NAME, RDB$OWNER_NAME, RDB$VIEW_SOURCE ' +
2579	>	'FROM RDB$RELATIONS ' +
2580	>	'WHERE ' +
2581	>	'  (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL) AND ' +
2582	>	'  NOT RDB$VIEW_BLR IS NULL AND ' +
2583	>	'  RDB$FLAGS = 1 AND ' +
2584	>	'  RDB$RELATION_NAME = :ViewName ' +
2585	>	'ORDER BY RDB$RELATION_ID';
2586	>
2587	>	ColumnSQL =
2588	>	'SELECT RDB$FIELD_NAME FROM RDB$RELATION_FIELDS ' +
2589	>	'WHERE ' +
2590	>	'  RDB$RELATION_NAME = :RELATION_NAME ' +
2591	>	'ORDER BY RDB$FIELD_POSITION';
2592	>
2593	>	var
2594	>	qryView, qryColumns : TIBSQL;
2595	>	SList : TStrings;
2596	>	begin
2597	>	qryView := TIBSQL.Create(FDatabase);
2598	>	qryColumns := TIBSQL.Create(FDatabase);
2599	>	SList := TStringList.Create;
2600	>	try
2601	>	if ViewName = '' then
2602	>	qryView.SQL.Text := ViewSQL
2603	>	else
2604	>	begin
2605	>	qryView.SQL.Text := ViewNameSQL;
2606	>	qryView.Params.ByName('ViewName').AsString := ViewName;
2607	>	end;
2608	>	qryColumns.SQL.Text := ColumnSQL;
2609	>	qryView.ExecQuery;
2610	>	while not qryView.Eof do
2611	>	begin
2612	>	SList.Add(Format('%s/* View: %s, Owner: %s */%s',
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)]));
2618	>
2619	>	qryColumns.Params.ByName('RELATION_NAME').AsString :=
2620	>	qryView.FieldByName('RDB$RELATION_NAME').AsString;
2621	>	qryColumns.ExecQuery;
2622	>	while not qryColumns.Eof do
2623	>	begin
2624	>	SList.Add('  ' + QuoteIdentifier(FDatabase.SQLDialect,
2625	>	qryColumns.FieldByName('RDB$FIELD_NAME').AsString));
2626	>	qryColumns.Next;
2627	>	if not qryColumns.Eof then
2628	>	SList.Strings[SList.Count - 1] := SList.Strings[SList.Count - 1] + ', ';
2629	>	end;
2630	>	qryColumns.Close;
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, LineEnding]);
2635	>	FMetaData.AddStrings(SList);
2636	>	SList.Clear;
2637	>	qryView.Next;
2638	>	end;
2639	>	finally
2640	>	qryView.Free;
2641	>	qryColumns.Free;
2642	>	SList.Free;
2643	>	end;
2644	>	end;
2645	>
2646	>	{    PrintSet
2647	>	Functional description
2648	>	print (using ISQL_printf) the word "SET"
2649	>	if the first line of the ALTER DATABASE
2650	>	settings options. Also, add trailing
2651	>	comma for end of prior line if needed.
2652	>
2653	>	uses Print_buffer, a global }
2654	>
2655	>	function TIBExtract.PrintSet(var Used: Boolean) : String;
2656	>	begin
2657	>	if not Used then
2658	>	begin
2659	>	Result := '  SET ';
2660	>	Used := true;
2661	>	end
2662	>	else
2663	>	Result := Format(', %s      ', [LineEnding]);
2664	>	end;
2665	>
2666	>	{
2667	>	PrintValidation
2668	>	Functional description
2669	>	This does some minor syntax adjustmet for extracting
2670	>	validation blobs and computed fields.
2671	>	if it does not start with the word CHECK
2672	>	if this is a computed field blob,look for () or insert them.
2673	>	if flag = false, this is a validation clause,
2674	>	if flag = true, this is a computed field }
2675	>
2676	>	function TIBExtract.PrintValidation(ToValidate: String;
2677	>	flag: Boolean): String;
2678	>	var
2679	>	IsSQL : Boolean;
2680	>	begin
2681	>	IsSql := false;
2682	>
2683	>	Result := '';
2684	>	ToValidate := Trim(ToValidate);
2685	>
2686	>	if flag then
2687	>	begin
2688	>	if ToValidate[1] = '(' then
2689	>	IsSQL := true;
2690	>	end
2691	>	else
2692	>	if (Pos(ToValidate, 'check') = 1) or (Pos(ToValidate, 'CHECK') = 1) then
2693	>	IsSQL := TRUE;
2694	>
2695	>	if not IsSQL then
2696	>	begin
2697	>	if Flag then
2698	>	Result := Result + '/* ' + ToValidate + ' */'
2699	>	else
2700	>	Result := Result + '(' + ToValidate + ')';
2701	>	end
2702	>	else
2703	>	Result := ToValidate;
2704	>	end;
2705	>
2706	>	procedure TIBExtract.SetDatabase(const Value: TIBDatabase);
2707	>	begin
2708	>	if (csLoading in ComponentState) or (FDatabase <> Value) then
2709	>	begin
2710	>	FDatabase := Value;
2711	>	if (not Assigned(FTransaction)) and (FDatabase <> nil) then
2712	>	Transaction := FDatabase.DefaultTransaction;
2713	>	FDatabaseInfo.Database := FDatabase;
2714	>	end;
2715	>	end;
2716	>
2717	>	procedure TIBExtract.SetTransaction(const Value: TIBTransaction);
2718	>	begin
2719	>	if FTransaction <> Value then
2720	>	begin
2721	>	FTransaction := Value;
2722	>	if (not Assigned(FDatabase)) and (FTransaction <> nil) then
2723	>	Database := FTransaction.DefaultDatabase;
2724	>	end;
2725	>	end;
2726	>
2727	>	procedure TIBExtract.ExtractObject(ObjectType : TExtractObjectTypes;
2728	>	ObjectName : String = ''; ExtractTypes : TExtractTypes = []);
2729	>	var
2730	>	DidActivate : Boolean;
2731	>	begin
2732	>	DidActivate := false;
2733	>	if not FTransaction.Active then
2734	>	begin
2735	>	FTransaction.StartTransaction;
2736	>	DidActivate := true;
2737	>	end;
2738	>	FMetaData.Clear;
2739	>	case ObjectType of
2740	>	eoDatabase : ExtractDDL(true, '', etData in ExtractTypes);
2741	>	eoDomain :
2742	>	if etTable in ExtractTypes then
2743	>	ListDomains(ObjectName, etTable)
2744	>	else
2745	>	ListDomains(ObjectName);
2746	>	eoTable :
2747	>	begin
2748	>	if ObjectName <> '' then
2749	>	begin
2750	>	if etDomain in ExtractTypes then
2751	>	ListDomains(ObjectName, etTable);
2752	>	ExtractListTable(ObjectName, '', false);
2753	>	if etIndex in ExtractTypes then
2754	>	ListIndex(ObjectName, etTable);
2755	>	if etForeign in ExtractTypes then
2756	>	ListForeign(ObjectName, etTable);
2757	>	if etCheck in ExtractTypes then
2758	>	ListCheck(ObjectName, etTable);
2759	>	if etTrigger in ExtractTypes then
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
2769	>	ListData(ObjectName);
2770	>	end
2771	>	else
2772	>	ListAllTables(true);
2773	>	end;
2774	>	eoView :
2775	>	begin
2776	>	ListViews(ObjectName);
2777	>	if ObjectName <> '' then
2778	>	begin
2779	>	if etTrigger in ExtractTypes then
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 :
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,ExtractTypes);
2798	>	eoException : ListException(ObjectName);
2799	>	eoBLOBFilter : ListFilters(ObjectName);
2800	>	eoRole : ListRoles(ObjectName);
2801	>	eoTrigger :
2802	>	if etTable in ExtractTypes then
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(ObjectName);
2814	>	eoForeign :
2815	>	if etTable in ExtractTypes then
2816	>	ListForeign(ObjectName, etTable)
2817	>	else
2818	>	ListForeign(ObjectName);
2819	>	eoIndexes :
2820	>	if etTable in ExtractTypes then
2821	>	ListIndex(ObjectName, etTable)
2822	>	else
2823	>	ListIndex(ObjectName);
2824	>	eoChecks :
2825	>	if etTable in ExtractTypes then
2826	>	ListCheck(ObjectName, etTable)
2827	>	else
2828	>	ListCheck(ObjectName);
2829	>	eoData : ListData(ObjectName);
2830	>	end;
2831	>	if DidActivate then
2832	>	FTransaction.Commit;
2833	>	end;
2834	>
2835	>	function TIBExtract.GetFieldType(FieldType, FieldSubType, FieldScale,
2836	>	FieldSize, FieldPrec, FieldLen: Integer): String;
2837	>	var
2838	>	i : Integer;
2839	>	PrecisionKnown : Boolean;
2840	>	begin
2841	>	Result := '';
2842	>	for i := Low(ColumnTypes) to High(ColumnTypes) do
2843	>	if FieldType = ColumnTypes[i].SQLType then
2844	>	begin
2845	>	PrecisionKnown := FALSE;
2846	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
2847	>	begin
2848	>	if FieldType in [blr_short, blr_long, blr_int64] then
2849	>	begin
2850	>	{ We are ODS >= 10 and could be any Dialect }
2851	>	if (FDatabaseInfo.DBSQLDialect >= 3) and
2852	>	(FieldPrec <> 0) and
2853	>	(FieldSubType > 0) and
2854	>	(FieldSubType <= MAX_INTSUBTYPES) then
2855	>	begin
2856	>	Result := Result + Format('%s(%d, %d)', [
2857	>	IntegralSubtypes [FieldSubType],
2858	>	FieldPrec,
2859	>	-1 * FieldScale]);
2860	>	PrecisionKnown := true;
2861	>	end;
2862	>	end;
2863	>	end;
2864	>	if PrecisionKnown = false then
2865	>	begin
2866	>	{ Take a stab at numerics and decimals }
2867	>	if (FieldType = blr_short) and
2868	>	(FieldScale < 0) then
2869	>	Result := Result + Format('NUMERIC(4, %d)',
2870	>	[-FieldScale] )
2871	>	else
2872	>	if (FieldType = blr_long) and
2873	>	(FieldScale < 0) then
2874	>	Result := Result + Format('NUMERIC(9, %d)',
2875	>	[-FieldScale] )
2876	>	else
2877	>	if (FieldType = blr_double) and
2878	>	(FieldScale  < 0) then
2879	>	Result := Result + Format('NUMERIC(15, %d)',
2880	>	[-FieldScale] )
2881	>	else
2882	>	Result := Result + ColumnTypes[i].TypeName;
2883	>	end;
2884	>	break;
2885	>	end;
2886	>	if (FieldType in [blr_text, blr_varying]) and
2887	>	(FieldSize <> 0) then
2888	>	Result := Result + Format('(%d)', [FieldSize]);
2889	>	end;
2890	>
2891	>	{  S H O W _ g r a n t s
2892	>	Functional description
2893	>	Show grants for given object name
2894	>	This function is also called by extract for privileges.
2895	>	It must extract granted privileges on tables/views to users,
2896	>	- these may be compound, so put them on the same line.
2897	>	Grant execute privilege on procedures to users
2898	>	Grant various privileges to procedures.
2899	>	All privileges may have the with_grant option set. }
2900	>
2901	>	procedure TIBExtract.ShowGrants(MetaObject: String; Terminator: String);
2902	>	const
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 qryOwnerPriv : TIBSQL;
2986	>
2987	>	begin
2988	>	if MetaObject = '' then
2989	>	exit;
2990	>
2991	>	qryOwnerPriv := TIBSQL.Create(FDatabase);
2992	>	try
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	>	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;
3011	>	qryOwnerPriv.Close;
3012	>	finally
3013	>	qryOwnerPriv.Free;
3014	>	end;
3015	>	end;
3016	>
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	>	var qryOwnerPriv : TIBSQL;
3063	>
3064	>	begin
3065	>	if MetaObject = '' then
3066	>	exit;
3067	>
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	>	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
3094	>	Functional description
3095	>	Show grants for given role name
3096	>	This function is also called by extract for privileges.
3097	>	All membership privilege may have the with_admin option set. }
3098	>
3099	>	procedure TIBExtract.ShowGrantRoles(Terminator: String);
3100	>	const
3101	>	RoleSQL =
3102	>	'SELECT RDB$USER, RDB$GRANT_OPTION, RDB$RELATION_NAME ' +
3103	>	'FROM RDB$USER_PRIVILEGES ' +
3104	>	'WHERE ' +
3105	>	'  RDB$OBJECT_TYPE = %d AND ' +
3106	>	'  RDB$USER_TYPE = %d AND ' +
3107	>	'  RDB$PRIVILEGE = ''M'' ' +
3108	>	'ORDER BY  RDB$RELATION_NAME, RDB$USER';
3109	>
3110	>	var
3111	>	WithOption, UserString : String;
3112	>	qryRole : TIBSQL;
3113	>
3114	>	begin
3115	>	qryRole := TIBSQL.Create(FDatabase);
3116	>	try
3117	>	qryRole.SQL.Text := Format(RoleSQL, [obj_sql_role, obj_user]);
3118	>	qryRole.ExecQuery;
3119	>	while not qryRole.Eof do
3120	>	begin
3121	>	UserString := Trim(qryRole.FieldByName('RDB$USER').AsString);
3122	>
3123	>	if (not qryRole.FieldByName('RDB$GRANT_OPTION').IsNull) and
3124	>	(qryRole.FieldByName('RDB$GRANT_OPTION').AsInteger = 1) then
3125	>	WithOption := ' WITH ADMIN OPTION'
3126	>	else
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, LineEnding]));
3131	>
3132	>	qryRole.Next;
3133	>	end;
3134	>	finally
3135	>	qryRole.Free;
3136	>	end;
3137	>	end;
3138	>
3139	>	{                   GetProcedureArgs
3140	>	Functional description
3141	>	This function extract the procedure parameters and adds it to the
3142	>	extract file }
3143	>
3144	>	procedure TIBExtract.GetProcedureArgs(Proc: String);
3145	>	const
3146	>	{ query to retrieve the input parameters. }
3147	>	ProcHeaderSQL =
3148	>	'SELECT * ' +
3149	>	' FROM RDB$PROCEDURE_PARAMETERS PRM JOIN RDB$FIELDS FLD ON ' +
3150	>	' PRM.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME ' +
3151	>	'WHERE ' +
3152	>	'    PRM.RDB$PROCEDURE_NAME = :PROCNAME AND ' +
3153	>	'    PRM.RDB$PARAMETER_TYPE = :Input ' +
3154	>	'ORDER BY PRM.RDB$PARAMETER_NUMBER';
3155	>
3156	>	var
3157	>	FirstTime, PrecisionKnown : Boolean;
3158	>	Line : String;
3159	>	qryHeader : TIBSQL;
3160	>
3161	>	function FormatParamStr : String;
3162	>	var
3163	>	i, CollationID, CharSetID : Integer;
3164	>	begin
3165	>	Result := Format('  %s ', [qryHeader.FieldByName('RDB$PARAMETER_NAME').AsString]);
3166	>	for i := Low(ColumnTypes) to High(ColumnTypes) do
3167	>	if qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = ColumnTypes[i].SQLType then
3168	>	begin
3169	>	PrecisionKnown := FALSE;
3170	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION10 then
3171	>	begin
3172	>	if qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger in [blr_short, blr_long, blr_int64] then
3173	>	begin
3174	>	{ We are ODS >= 10 and could be any Dialect }
3175	>	if (FDatabaseInfo.DBSQLDialect >= 3) and
3176	>	(not qryHeader.FieldByName('RDB$FIELD_PRECISION').IsNull) and
3177	>	(qryHeader.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger > 0) and
3178	>	(qryHeader.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger <= MAX_INTSUBTYPES) then
3179	>	begin
3180	>	Result := Result + Format('%s(%d, %d)', [
3181	>	IntegralSubtypes [qryHeader.FieldByName('RDB$FIELD_SUB_TYPE').AsInteger],
3182	>	qryHeader.FieldByName('RDB$FIELD_PRECISION').AsInteger,
3183	>	-1 * qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger]);
3184	>	PrecisionKnown := true;
3185	>	end;
3186	>	end;
3187	>	end;
3188	>	if PrecisionKnown = false then
3189	>	begin
3190	>	{ Take a stab at numerics and decimals }
3191	>	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_short) and
3192	>	(qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
3193	>	Result := Result + Format('NUMERIC(4, %d)',
3194	>	[-qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger] )
3195	>	else
3196	>	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_long) and
3197	>	(qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger < 0) then
3198	>	Result := Result + Format('NUMERIC(9, %d)',
3199	>	[-qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger] )
3200	>	else
3201	>	if (qryHeader.FieldByName('RDB$FIELD_TYPE').AsInteger = blr_double) and
3202	>	(qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger  < 0) then
3203	>	Result := Result + Format('NUMERIC(15, %d)',
3204	>	[-qryHeader.FieldByName('RDB$FIELD_SCALE').AsInteger] )
3205	>	else
3206	>	Result := Result + ColumnTypes[i].TypeName;
3207	>	end;
3208	>	break;
3209	>	end;
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	>
3220	>	if (not qryHeader.FieldByName('RDB$COLLATION_ID').IsNull) or
3221	>	(not qryHeader.FieldByName('RDB$CHARACTER_SET_ID').IsNull) then
3222	>	begin
3223	>	if qryHeader.FieldByName('RDB$COLLATION_ID').IsNull then
3224	>	CollationId := 0
3225	>	else
3226	>	CollationId := qryHeader.FieldByName('RDB$COLLATION_ID').AsInteger;
3227	>
3228	>	if qryHeader.FieldByName('RDB$CHARACTER_SET_ID').IsNull then
3229	>	CharSetId := 0
3230	>	else
3231	>	CharSetId := qryHeader.FieldByName('RDB$CHARACTER_SET_ID').AsInteger;
3232	>
3233	>	Result := Result + GetCharacterSets(CharSetId, CollationId, false);
3234	>	end;
3235	>	end;
3236	>
3237	>	begin
3238	>	FirstTime := true;
3239	>	qryHeader := TIBSQL.Create(FDatabase);
3240	>	try
3241	>	qryHeader.SQL.Text := ProcHeaderSQL;
3242	>	qryHeader.Params.ByName('procname').AsString := Proc;
3243	>	qryHeader.Params.ByName('Input').AsInteger := 0;
3244	>	qryHeader.ExecQuery;
3245	>	while not qryHeader.Eof do
3246	>	begin
3247	>	if FirstTime then
3248	>	begin
3249	>	FirstTime := false;
3250	>	FMetaData.Add('(');
3251	>	end;
3252	>
3253	>	Line := FormatParamStr;
3254	>
3255	>	qryHeader.Next;
3256	>	if not qryHeader.Eof then
3257	>	Line := Line + ',';
3258	>	FMetaData.Add(Line);
3259	>	end;
3260	>
3261	>	{ If there was at least one param, close parens }
3262	>	if not FirstTime then
3263	>	begin
3264	>	FMetaData.Add( ')');
3265	>	end;
3266	>
3267	>	FirstTime := true;
3268	>	qryHeader.Close;
3269	>	qryHeader.Params.ByName('Input').AsInteger := 1;
3270	>	qryHeader.ExecQuery;
3271	>
3272	>	while not qryHeader.Eof do
3273	>	begin
3274	>	if FirstTime then
3275	>	begin
3276	>	FirstTime := false;
3277	>	FMetaData.Add('RETURNS' + LineEnding + '(');
3278	>	end;
3279	>
3280	>	Line := FormatParamStr;
3281	>
3282	>	qryHeader.Next;
3283	>	if not qryHeader.Eof then
3284	>	Line := Line + ',';
3285	>	FMetaData.Add(Line);
3286	>	end;
3287	>
3288	>	{ If there was at least one param, close parens }
3289	>	if not FirstTime then
3290	>	begin
3291	>	FMetaData.Add( ')');
3292	>	end;
3293	>
3294	>	FMetaData.Add('AS');
3295	>	finally
3296	>	qryHeader.Free;
3297	>	end;
3298	>	end;
3299	>
3300	>	procedure TIBExtract.Notification(AComponent: TComponent;
3301	>	Operation: TOperation);
3302	>	begin
3303	>	inherited;
3304	>	if (AComponent = FDatabase) and (Operation = opRemove) then
3305	>	FDatabase := nil;
3306	>	if (AComponent = FTransaction) and (Operation = opRemove) then
3307	>	FTransaction := nil;
3308	>	end;
3309	>
3310	>	procedure TIBExtract.ListData(ObjectName: String);
3311	>	const
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	>	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	>	ListData(Trim(FieldByName('RDB$RELATION_NAME').AsString));
3339	>	Next;
3340	>	end;
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;
3374	>	end;
3375	>	end;
3376	>
3377	>	procedure TIBExtract.ListRoles(ObjectName: String);
3378	>	const
3379	>	RolesSQL =
3380	>	'select * from RDB$ROLES WHERE RDB$SYSTEM_FLAG = 0 ' +
3381	>	'order by RDB$ROLE_NAME';
3382	>
3383	>	RolesByNameSQL =
3384	>	'select * from RDB$ROLES ' +
3385	>	'WHERE RDB$ROLE_NAME = :RoleName ' +
3386	>	'order by RDB$ROLE_NAME';
3387	>
3388	>	var
3389	>	qryRoles : TIBSQL;
3390	>	PrevOwner, RoleName, OwnerName : String;
3391	>	begin
3392	>	{Process GRANT roles}
3393	>	qryRoles := TIBSQL.Create(FDatabase);
3394	>	try
3395	>	if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION9 then
3396	>	begin
3397	>	PrevOwner := '';
3398	>	FMetaData.Add('');
3399	>	FMetaData.Add('/* Grant Roles for this database */');
3400	>	FMetaData.Add('');
3401	>
3402	>	if ObjectName = '' then
3403	>	qryRoles.SQL.Text := RolesSQL
3404	>	else
3405	>	begin
3406	>	qryRoles.SQL.Text := RolesByNameSQL;
3407	>	qryRoles.Params.ByName('RoleName').AsString := ObjectName;
3408	>	end;
3409	>	qryRoles.ExecQuery;
3410	>	try
3411	>	while not qryRoles.Eof do
3412	>	begin
3413	>	RoleName := QuoteIdentifier(FDatabase.SQLDialect,
3414	>	qryRoles.FieldByName('rdb$Role_Name').AsString);
3415	>	OwnerName := Trim(qryRoles.FieldByName('rdb$Owner_Name').AsString);
3416	>	if PrevOwner <> OwnerName then
3417	>	begin
3418	>	FMetaData.Add('');
3419	>	FMetaData.Add(Format('/* Role: %s, Owner: %s */', [RoleName, OwnerName]));
3420	>	FMetaData.Add('');
3421	>	PrevOwner := OwnerName;
3422	>	end;
3423	>	FMetaData.Add('CREATE ROLE ' + RoleName + Term);
3424	>	qryRoles.Next;
3425	>	end;
3426	>	finally
3427	>	qryRoles.Close;
3428	>	end;
3429	>	end;
3430	>	finally
3431	>	qryRoles.Free;
3432	>	end;
3433	>	end;
3434	>
3435	>	end.
3436	>
3437	>

Diff Legend

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