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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines