ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBExtract.pas
Revision: 221
Committed: Mon Mar 19 09:48:37 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 130709 byte(s)
Log Message:
Fixes merged

File Contents

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