ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBExtract.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBExtract.pas (file contents):
Revision 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines