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

Diff Legend

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