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

Diff Legend

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