ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBExtract.pas
Revision: 5
Committed: Fri Feb 18 16:26:16 2011 UTC (13 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 107429 byte(s)
Log Message: 
Committing updates for Release pre-release

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