54 |
|
TExtractObjectTypes = |
55 |
|
(eoDatabase, eoDomain, eoTable, eoView, eoProcedure, eoFunction, eoPackage, |
56 |
|
eoGenerator, eoException, eoBLOBFilter, eoRole, eoTrigger, eoForeign, |
57 |
< |
eoIndexes, eoChecks, eoData); |
57 |
> |
eoIndexes, eoChecks, eoComments, eoData); |
58 |
|
|
59 |
|
TExtractType = |
60 |
|
(etDomain, etTable, etRole, etTrigger, etForeign, |
67 |
|
|
68 |
|
TPackageDDLType = (paHeader,paBody,paBoth); |
69 |
|
|
70 |
+ |
TCommentType = (ctDatabase, ctCharacterSet,ctCollation,ctDomain,ctException, |
71 |
+ |
ctExternalFunction, ctFilter, ctGenerator, ctIndex, ctPackage, |
72 |
+ |
ctProcedure, ctRole, ctSequence, ctTable, ctTrigger, |
73 |
+ |
ctView, ctColumn,ctParameter, ctArgument); |
74 |
+ |
TCommentTypes = set of TCommentType; |
75 |
+ |
|
76 |
|
{ TIBExtract } |
77 |
|
|
78 |
|
TIBExtract = class(TComponent) |
80 |
|
FAlwaysQuoteIdentifiers: boolean; |
81 |
|
FCaseSensitiveObjectNames: boolean; |
82 |
|
FDatabase : TIBDatabase; |
83 |
+ |
FIncludeMetaDataComments: boolean; |
84 |
|
FTransaction : TIBTransaction; |
85 |
|
FMetaData: TStrings; |
86 |
|
FDatabaseInfo: TIBDatabaseInfo; |
87 |
|
FShowSystem: Boolean; |
88 |
|
{ Private declarations } |
89 |
|
procedure Add2MetaData(const Msg: string; IsError: boolean=true); |
90 |
+ |
procedure AddComment(Query: TIBSQL; cType: TCommentType; OutStrings: TStrings; |
91 |
+ |
CommentFieldName: string = 'RDB$DESCRIPTION'); |
92 |
|
function GetDatabase: TIBDatabase; |
93 |
|
function GetIndexSegments ( indexname : String) : String; |
94 |
|
function GetTransaction: TIBTransaction; |
95 |
|
function GetTriggerType(TypeID: Int64): string; |
96 |
+ |
function LookupDDLObject(cType: TCommentType): integer; |
97 |
|
procedure SetDatabase(const Value: TIBDatabase); |
98 |
|
procedure SetTransaction(const Value: TIBTransaction); |
99 |
|
function PrintValidation(ToValidate : String; flag : Boolean) : String; |
116 |
|
procedure ListAllTables(flag : Boolean); |
117 |
|
procedure ListTriggers(ObjectName: String=''; ExtractTypes: TExtractTypes = [etTrigger]); |
118 |
|
procedure ListCheck(ObjectName : String = ''; ExtractType : TExtractType = etCheck); |
119 |
< |
function PrintSet(var Used : Boolean) : String; |
119 |
> |
procedure ListComments(CommentTypes: TCommentTypes = []); |
120 |
|
procedure ListCreateDb(TargetDb : String = ''); |
121 |
|
procedure ListDomains(ObjectName : String = ''; ExtractType : TExtractType = etDomain); |
122 |
|
procedure ListException(ExceptionName : String = ''); |
127 |
|
procedure ListIndex(ObjectName : String = ''; ExtractType : TExtractType = etIndex); |
128 |
|
procedure ListViews(ViewName : String = ''); |
129 |
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
130 |
+ |
function PrintSet(var Used : Boolean) : String; |
131 |
|
function QuoteIdentifier(Value: String): String; |
132 |
|
|
133 |
|
{ Protected declarations } |
141 |
|
function GetCharacterSets(CharSetId, Collation : integer; CollateOnly : Boolean) : String; |
142 |
|
procedure ExtractObject(ObjectType : TExtractObjectTypes; ObjectName : String = ''; |
143 |
|
ExtractTypes : TExtractTypes = []); |
144 |
+ |
procedure ListObjectNames(ObjectType: integer; Names: TStrings); |
145 |
|
property DatabaseInfo : TIBDatabaseInfo read FDatabaseInfo; |
146 |
|
property Items : TStrings read FMetaData; |
147 |
|
|
151 |
|
property Transaction : TIBTransaction read GetTransaction write SetTransaction; |
152 |
|
property ShowSystem: Boolean read FShowSystem write FShowSystem; |
153 |
|
property AlwaysQuoteIdentifiers: boolean read FAlwaysQuoteIdentifiers write FAlwaysQuoteIdentifiers; |
154 |
+ |
property IncludeMetaDataComments: boolean read FIncludeMetaDataComments write FIncludeMetaDataComments default true; |
155 |
|
property CaseSensitiveObjectNames: boolean read FCaseSensitiveObjectNames write FCaseSensitiveObjectNames; |
156 |
|
end; |
157 |
|
|
260 |
|
obj_user = 8; |
261 |
|
obj_field = 9; |
262 |
|
obj_index = 10; |
263 |
< |
obj_count = 11; |
263 |
> |
obj_character_set = 11; |
264 |
|
obj_user_group = 12; |
265 |
|
obj_sql_role = 13; |
266 |
+ |
obj_generator = 14; |
267 |
+ |
obj_udf = 15; |
268 |
+ |
obj_blob_filter = 16; |
269 |
+ |
obj_collation = 17; |
270 |
|
obj_package = 18; |
271 |
+ |
obj_package_body = 19; |
272 |
+ |
|
273 |
+ |
obj_function = 100; |
274 |
+ |
obj_domain = 101; |
275 |
|
|
276 |
|
implementation |
277 |
|
|
337 |
|
(ObjectName: 'PACKAGE BODY'; Bits: 2; Bit1: tpCreate; Bit2: tpDrop; Bit3: tpNone) |
338 |
|
); |
339 |
|
|
340 |
+ |
type |
341 |
+ |
TDDLObjects = record |
342 |
+ |
ObjectName: string; |
343 |
+ |
ObjType: integer; |
344 |
+ |
SystemTableName: string; |
345 |
+ |
NameField: string; |
346 |
+ |
NameSpaceField: string; |
347 |
+ |
Condition: string; |
348 |
+ |
CommentType: TCommentType; |
349 |
+ |
end; |
350 |
+ |
|
351 |
+ |
const |
352 |
+ |
DDLObjects: array [0..18] of TDDLObjects = ( |
353 |
+ |
(ObjectName: 'CHARACTER SET'; |
354 |
+ |
ObjType: obj_character_set; |
355 |
+ |
SystemTableName: 'RDB$CHARACTER_SETS'; |
356 |
+ |
NameField: 'RDB$CHARACTER_SET_NAME'; |
357 |
+ |
NameSpaceField: ''; |
358 |
+ |
Condition: ''; |
359 |
+ |
CommentType: ctCharacterSet), |
360 |
+ |
(ObjectName: 'COLLATION'; |
361 |
+ |
ObjType: obj_collation; |
362 |
+ |
SystemTableName: 'RDB$COLLATIONS'; |
363 |
+ |
NameField: 'RDB$COLLATION_NAME'; |
364 |
+ |
NameSpaceField: ''; |
365 |
+ |
Condition: ''; |
366 |
+ |
CommentType: ctCollation), |
367 |
+ |
(ObjectName: 'DOMAIN'; |
368 |
+ |
ObjType: obj_domain; |
369 |
+ |
SystemTableName: 'RDB$FIELDS'; |
370 |
+ |
NameField: 'RDB$FIELD_NAME'; |
371 |
+ |
NameSpaceField: ''; |
372 |
+ |
Condition: 'RDB$SYSTEM_FLAG = 0'; |
373 |
+ |
CommentType: ctDomain), |
374 |
+ |
(ObjectName: 'EXCEPTION'; |
375 |
+ |
ObjType: obj_exception; |
376 |
+ |
SystemTableName: 'RDB$EXCEPTIONS'; |
377 |
+ |
NameField: 'RDB$EXCEPTION_NAME'; |
378 |
+ |
NameSpaceField: ''; |
379 |
+ |
Condition: ''; |
380 |
+ |
CommentType: ctException), |
381 |
+ |
(ObjectName: 'EXTERNAL FUNCTION'; |
382 |
+ |
ObjType: obj_function; |
383 |
+ |
SystemTableName: 'RDB$FUNCTIONS'; |
384 |
+ |
NameField: 'RDB$FUNCTION_NAME'; |
385 |
+ |
NameSpaceField: ''; |
386 |
+ |
Condition: ''; |
387 |
+ |
CommentType: ctExternalFunction), |
388 |
+ |
(ObjectName: 'FILTER'; |
389 |
+ |
ObjType: obj_blob_filter; |
390 |
+ |
SystemTableName: 'RDB$FILTERS'; |
391 |
+ |
NameField: 'RDB$FUNCTION_NAME'; |
392 |
+ |
NameSpaceField: ''; |
393 |
+ |
Condition: ''; |
394 |
+ |
CommentType: ctFilter), |
395 |
+ |
(ObjectName: 'GENERATOR'; |
396 |
+ |
ObjType: obj_generator; |
397 |
+ |
SystemTableName: 'RDB$GENERATORS'; |
398 |
+ |
NameField: 'RDB$GENERATOR_NAME'; |
399 |
+ |
NameSpaceField: ''; |
400 |
+ |
Condition: ''; |
401 |
+ |
CommentType: ctGenerator), |
402 |
+ |
(ObjectName: 'INDEX'; |
403 |
+ |
ObjType: obj_index; |
404 |
+ |
SystemTableName: 'RDB$INDICES'; |
405 |
+ |
NameField: 'RDB$INDEX_NAME'; |
406 |
+ |
NameSpaceField: ''; |
407 |
+ |
Condition: ''; |
408 |
+ |
CommentType: ctIndex), |
409 |
+ |
(ObjectName: 'PACKAGE'; |
410 |
+ |
ObjType: obj_package; |
411 |
+ |
SystemTableName: 'RDB$PACKAGES'; |
412 |
+ |
NameField: 'RDB$PACKAGE_NAME'; |
413 |
+ |
NameSpaceField: ''; |
414 |
+ |
Condition: ''; |
415 |
+ |
CommentType: ctPackage), |
416 |
+ |
(ObjectName: 'PROCEDURE'; |
417 |
+ |
ObjType: obj_procedure; |
418 |
+ |
SystemTableName: 'RDB$PROCEDURES'; |
419 |
+ |
NameField: 'RDB$PROCEDURE_NAME'; |
420 |
+ |
NameSpaceField: ''; |
421 |
+ |
Condition: ''; |
422 |
+ |
CommentType: ctProcedure), |
423 |
+ |
(ObjectName: 'ROLE'; |
424 |
+ |
ObjType: obj_sql_role; |
425 |
+ |
SystemTableName: 'RDB$ROLES'; |
426 |
+ |
NameField: 'RDB$ROLE_NAME'; |
427 |
+ |
NameSpaceField: ''; |
428 |
+ |
Condition: ''; |
429 |
+ |
CommentType: ctRole), |
430 |
+ |
(ObjectName: 'SEQUENCE'; |
431 |
+ |
ObjType: obj_generator; |
432 |
+ |
SystemTableName: 'RDB$GENERATORS'; |
433 |
+ |
NameField: 'RDB$GENERATOR_NAME'; |
434 |
+ |
NameSpaceField: ''; |
435 |
+ |
Condition: ''; |
436 |
+ |
CommentType: ctSequence), |
437 |
+ |
(ObjectName: 'TABLE'; |
438 |
+ |
ObjType: obj_relation; |
439 |
+ |
SystemTableName: 'RDB$RELATIONS'; |
440 |
+ |
NameField: 'RDB$RELATION_NAME'; |
441 |
+ |
NameSpaceField: ''; |
442 |
+ |
Condition: 'RDB$RELATION_TYPE = 0'; |
443 |
+ |
CommentType: ctTable), |
444 |
+ |
(ObjectName: 'TRIGGER'; |
445 |
+ |
ObjType: obj_trigger; |
446 |
+ |
SystemTableName: 'RDB$TRIGGERS'; |
447 |
+ |
NameField: 'RDB$TRIGGER_NAME'; |
448 |
+ |
NameSpaceField: ''; |
449 |
+ |
Condition: ''; |
450 |
+ |
CommentType: ctTrigger), |
451 |
+ |
(ObjectName: 'VIEW'; |
452 |
+ |
ObjType: obj_view; |
453 |
+ |
SystemTableName: 'RDB$RELATIONS'; |
454 |
+ |
NameField: 'RDB$RELATION_NAME'; |
455 |
+ |
NameSpaceField: ''; |
456 |
+ |
Condition: 'RDB$RELATION_TYPE = 1'; |
457 |
+ |
CommentType: ctView), |
458 |
+ |
(ObjectName: 'COLUMN'; |
459 |
+ |
ObjType: -1; |
460 |
+ |
SystemTableName: 'RDB$RELATION_FIELDS'; |
461 |
+ |
NameField: 'RDB$FIELD_NAME'; |
462 |
+ |
NameSpaceField: 'RDB$RELATION_NAME'; |
463 |
+ |
Condition: ''; |
464 |
+ |
CommentType: ctColumn), |
465 |
+ |
(ObjectName: 'PARAMETER'; |
466 |
+ |
ObjType: -1; |
467 |
+ |
SystemTableName: 'RDB$PROCEDURE_PARAMETERS'; |
468 |
+ |
NameField: 'RDB$PARAMETER_NAME'; |
469 |
+ |
NameSpaceField: 'RDB$PROCEDURE_NAME'; |
470 |
+ |
Condition: ''; |
471 |
+ |
CommentType: ctParameter), |
472 |
+ |
(ObjectName: 'PARAMETER'; |
473 |
+ |
ObjType: -1; |
474 |
+ |
SystemTableName: 'RDB$FUNCTION_ARGUMENTS'; |
475 |
+ |
NameField: 'RDB$ARGUMENT_NAME'; |
476 |
+ |
NameSpaceField: 'RDB$FUNCTION_NAME'; |
477 |
+ |
Condition: ''; |
478 |
+ |
CommentType: ctArgument), |
479 |
+ |
(ObjectName: 'DATABASE'; |
480 |
+ |
ObjType: -1; |
481 |
+ |
SystemTableName: 'RDB$DATABASE'; |
482 |
+ |
NameField: ''; |
483 |
+ |
CommentType: ctDatabase) |
484 |
+ |
); |
485 |
|
{ TIBExtract } |
486 |
|
|
487 |
|
{ ArrayDimensions |
530 |
|
Database := TIBDatabase(AOwner); |
531 |
|
if AOwner is TIBTransaction then |
532 |
|
Transaction := TIBTransaction(AOwner); |
533 |
+ |
FIncludeMetaDataComments := true; |
534 |
|
end; |
535 |
|
|
536 |
|
destructor TIBExtract.Destroy; |
596 |
|
if DatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then |
597 |
|
ListPackages(paBody); |
598 |
|
ListProcs(pdAlterProc); |
599 |
+ |
FMetaData.Add(''); |
600 |
+ |
FMetaData.Add('/* Comments on System Objects */'); |
601 |
+ |
FMetaData.Add(''); |
602 |
+ |
ListComments([ctCollation,ctCharacterSet]); |
603 |
|
ListGrants(ExtractTypes); |
604 |
|
end; |
605 |
|
|
653 |
|
|
654 |
|
var |
655 |
|
Collation, CharSetId : integer; |
656 |
< |
i : integer; |
656 |
> |
i : integer; |
657 |
|
Column, Constraint : String; |
658 |
|
SubType : integer; |
659 |
|
IntChar : integer; |
662 |
|
FieldScale, FieldType : Integer; |
663 |
|
CreateTable: string; |
664 |
|
TableType: integer; |
665 |
+ |
Comments: TStrings; |
666 |
|
begin |
667 |
|
Result := true; |
668 |
|
IntChar := 0; |
675 |
|
qryConstraints := TIBSQL.Create(FDatabase); |
676 |
|
qryRelConstraints := TIBSQL.Create(FDatabase); |
677 |
|
qryGenerators := TIBSQL.Create(FDatabase); |
678 |
+ |
Comments := TStringList.Create; |
679 |
|
try |
680 |
|
qryTables.SQL.Add(TableListSQL); |
681 |
|
RelationName := trim(RelationName); |
706 |
|
FMetaData.Add(Format('EXTERNAL FILE %s ', |
707 |
|
[QuotedStr(qryTables.FieldByName('RDB$EXTERNAL_FILE').AsString)])); |
708 |
|
FMetaData.Add('('); |
709 |
+ |
AddComment(qryTables,ctTable,Comments); |
710 |
|
end; |
711 |
|
|
712 |
|
while not qryTables.Eof do |
713 |
|
begin |
714 |
< |
Column := ' ' + QuoteIdentifier( qryTables.FieldByName('RDB$FIELD_NAME').AsString) + TAB; |
714 |
> |
AddComment(qryTables,ctColumn,Comments,'RDB$DESCRIPTION1'); |
715 |
> |
Column := ' ' + QuoteIdentifier( qryTables.FieldByName('RDB$FIELD_NAME').AsString) + TAB; |
716 |
|
|
717 |
|
{ Check first for computed fields, then domains. |
718 |
|
If this is a known domain, then just print the domain rather than type |
942 |
|
else |
943 |
|
FMetaData.Add(')' + TERM); |
944 |
|
end; |
945 |
+ |
FMetaData.AddStrings(Comments); |
946 |
|
finally |
947 |
+ |
Comments.Free; |
948 |
|
qryTables.Free; |
949 |
|
qryPrecision.Free; |
950 |
|
qryConstraints.Free; |
977 |
|
var |
978 |
|
qryViews, qryColumns : TIBSQL; |
979 |
|
RelationName, ColList : String; |
980 |
+ |
Comments: TStrings; |
981 |
|
begin |
982 |
|
ColList := ''; |
983 |
|
qryViews := TIBSQL.Create(FDatabase); |
984 |
|
qryColumns := TIBSQL.Create(FDatabase); |
985 |
+ |
Comments := TStringList.Create; |
986 |
|
try |
987 |
|
qryViews.SQL.Add(ViewsSQL); |
988 |
|
qryViews.Params.ByName('viewname').AsString := ViewName; |
990 |
|
while not qryViews.Eof do |
991 |
|
begin |
992 |
|
FMetaData.Add(''); |
993 |
+ |
AddComment(qryViews,ctView,Comments); |
994 |
|
RelationName := QuoteIdentifier( |
995 |
|
qryViews.FieldByName('RDB$RELATION_NAME').AsString); |
996 |
|
FMetaData.Add(Format('%s/* View: %s, Owner: %s */%s', [ |
1005 |
|
qryColumns.ExecQuery; |
1006 |
|
while not qryColumns.Eof do |
1007 |
|
begin |
1008 |
+ |
AddComment(qryColumns,ctColumn,Comments); |
1009 |
|
ColList := ColList + QuoteIdentifier( |
1010 |
|
qryColumns.FieldByName('RDB$FIELD_NAME').AsString); |
1011 |
|
qryColumns.Next; |
1017 |
|
qryViews.Next; |
1018 |
|
end; |
1019 |
|
finally |
1020 |
+ |
FMetaData.AddStrings(Comments); |
1021 |
+ |
Comments.Free; |
1022 |
|
qryViews.Free; |
1023 |
|
qryColumns.Free; |
1024 |
|
end; |
1083 |
|
FMetaData.Add(Msg); |
1084 |
|
end; |
1085 |
|
|
1086 |
+ |
function TIBExtract.LookupDDLObject(cType: TCommentType): integer; |
1087 |
+ |
begin |
1088 |
+ |
for Result := Low(DDLObjects) to High(DDLObjects) do |
1089 |
+ |
begin |
1090 |
+ |
if DDLObjects[Result].CommentType = cType then Exit; |
1091 |
+ |
end; |
1092 |
+ |
Result := -1; |
1093 |
+ |
end; |
1094 |
+ |
|
1095 |
+ |
|
1096 |
+ |
procedure TIBExtract.AddComment(Query: TIBSQL; cType: TCommentType; |
1097 |
+ |
OutStrings: TStrings; CommentFieldName: string); |
1098 |
+ |
var cmt: string; |
1099 |
+ |
index: integer; |
1100 |
+ |
begin |
1101 |
+ |
if IncludeMetaDataComments and |
1102 |
+ |
Query.HasField(CommentFieldName) and not Query.FieldByName(CommentFieldName).IsNull then |
1103 |
+ |
begin |
1104 |
+ |
index := LookupDDLObject(cType); |
1105 |
+ |
if index = -1 then Exit; |
1106 |
+ |
|
1107 |
+ |
with DDLObjects[index] do |
1108 |
+ |
begin |
1109 |
+ |
cmt := 'COMMENT ON ' + ObjectName + ' '; |
1110 |
+ |
if NameSpaceField <> '' then |
1111 |
+ |
cmt += QuoteIdentifier(query.FieldByName(NameSpaceField).AsString) + '.'; |
1112 |
+ |
if NameField <> '' then |
1113 |
+ |
cmt += QuoteIdentifier(query.FieldByName(NameField).AsString); |
1114 |
+ |
end; |
1115 |
+ |
|
1116 |
+ |
cmt += ' IS ''' + SQLSafeString(Query.FieldByName(CommentFieldName).AsString) + '''' + TERM; |
1117 |
+ |
OutStrings.Add(cmt); |
1118 |
+ |
end; |
1119 |
+ |
end; |
1120 |
+ |
|
1121 |
|
function TIBExtract.GetDatabase: TIBDatabase; |
1122 |
|
begin |
1123 |
|
result := FDatabase; |
1490 |
|
Header : Boolean; |
1491 |
|
SList : TStrings; |
1492 |
|
aPackageName: string; |
1493 |
+ |
Comments: TStrings; |
1494 |
|
begin |
1495 |
|
Header := true; |
1496 |
|
qryPackages := TIBSQL.Create(FDatabase); |
1497 |
+ |
Comments := TStringList.Create; |
1498 |
|
SList := TStringList.Create; |
1499 |
|
try |
1500 |
|
if PackageName = '' then |
1517 |
|
Header := false; |
1518 |
|
end; |
1519 |
|
|
1520 |
+ |
AddComment(qryPackages,ctPackage,Comments); |
1521 |
|
aPackageName := qryPackages.FieldByName('RDB$PACKAGE_NAME').AsString; |
1522 |
|
if PackageDDLType in [paHeader,paBoth] then |
1523 |
|
begin |
1549 |
|
FMetaData.Add('COMMIT WORK;'); |
1550 |
|
FMetaData.Add('SET AUTODDL ON;'); |
1551 |
|
end; |
1552 |
+ |
FMetaData.AddStrings(Comments); |
1553 |
|
finally |
1554 |
+ |
Comments.Free; |
1555 |
|
SList.Free; |
1556 |
|
qryPackages.Free; |
1557 |
|
end; |
1614 |
|
ProcName : String; |
1615 |
|
SList : TStrings; |
1616 |
|
Header : Boolean; |
1617 |
< |
|
1617 |
> |
Comments: TStrings; |
1618 |
|
begin |
1619 |
|
|
1620 |
|
Header := true; |
1621 |
|
qryProcedures := TIBSQL.Create(FDatabase); |
1622 |
+ |
Comments := TStringList.Create; |
1623 |
|
SList := TStringList.Create; |
1624 |
|
try |
1625 |
|
if ProcedureName = '' then |
1651 |
|
case ProcDDLType of |
1652 |
|
pdCreateStub: |
1653 |
|
begin |
1654 |
+ |
AddComment(qryProcedures,ctProcedure,Comments); |
1655 |
|
FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier( |
1656 |
|
ProcName)])); |
1657 |
|
GetProcedureArgs(ProcName); |
1663 |
|
|
1664 |
|
pdCreateProc: |
1665 |
|
begin |
1666 |
+ |
AddComment(qryProcedures,ctProcedure,Comments); |
1667 |
|
FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier( |
1668 |
|
ProcName)])); |
1669 |
|
GetProcedureArgs(ProcName); |
1705 |
|
FMetaData.Add('COMMIT WORK;'); |
1706 |
|
FMetaData.Add('SET AUTODDL ON;'); |
1707 |
|
end; |
1708 |
+ |
FMetaData.AddStrings(Comments); |
1709 |
|
finally |
1710 |
|
qryProcedures.Free; |
1711 |
|
SList.Free; |
1712 |
+ |
Comments.Free; |
1713 |
|
end; |
1714 |
|
end; |
1715 |
|
|
1803 |
|
TriggerName, RelationName, InActive: String; |
1804 |
|
qryTriggers : TIBSQL; |
1805 |
|
SList : TStrings; |
1806 |
+ |
Comments: TStrings; |
1807 |
|
begin |
1808 |
|
Header := true; |
1809 |
|
if [etTable,etTrigger ] * ExtractTypes <> [] then |
1810 |
|
ExtractTypes -= [etDatabaseTriggers,etDDLTriggers]; |
1811 |
|
SList := TStringList.Create; |
1812 |
+ |
Comments := TStringList.Create; |
1813 |
|
qryTriggers := TIBSQL.Create(FDatabase); |
1814 |
|
try |
1815 |
|
if ObjectName = '' then |
1830 |
|
qryTriggers.ExecQuery; |
1831 |
|
while not qryTriggers.Eof do |
1832 |
|
begin |
1833 |
+ |
AddComment(qryTriggers,ctTrigger,Comments); |
1834 |
|
SList.Clear; |
1835 |
|
if Header then |
1836 |
|
begin |
1885 |
|
FMetaData.Add('COMMIT WORK ' + ProcTerm); |
1886 |
|
FMetaData.Add('SET TERM ' + Term + ProcTerm); |
1887 |
|
end; |
1888 |
+ |
FMetaData.AddStrings(Comments); |
1889 |
|
finally |
1890 |
+ |
Comments.Free; |
1891 |
|
qryTriggers.Free; |
1892 |
|
SList.Free; |
1893 |
|
end; |
1974 |
|
end; |
1975 |
|
end; |
1976 |
|
|
1977 |
+ |
procedure TIBExtract.ListComments(CommentTypes: TCommentTypes); |
1978 |
+ |
|
1979 |
+ |
procedure DoListComments(cmt: TCommentType); |
1980 |
+ |
var qryCmt: TIBSQL; |
1981 |
+ |
sql: string; |
1982 |
+ |
index: integer; |
1983 |
+ |
begin |
1984 |
+ |
index := LookupDDLObject(cmt); |
1985 |
+ |
if index = -1 then Exit; |
1986 |
+ |
|
1987 |
+ |
qryCmt := TIBSQL.Create(FDatabase); |
1988 |
+ |
try |
1989 |
+ |
with DDLObjects[index] do |
1990 |
+ |
begin |
1991 |
+ |
sql := 'Select * From '+ SystemTableName; |
1992 |
+ |
if not (cmt in [ctCharacterSet, ctCollation, ctDatabase]) then |
1993 |
+ |
begin |
1994 |
+ |
if not ShowSystem then |
1995 |
+ |
sql += ' Where (RDB$SYSTEM_FLAG is null or RDB$SYSTEM_FLAG = 0)'; |
1996 |
+ |
if Condition <> '' then |
1997 |
+ |
begin |
1998 |
+ |
if not ShowSystem then |
1999 |
+ |
sql += ' AND ' + Condition |
2000 |
+ |
else |
2001 |
+ |
sql += ' Where ' + Condition; |
2002 |
+ |
end; |
2003 |
+ |
end; |
2004 |
+ |
sql += ' Order by 1'; |
2005 |
+ |
end; |
2006 |
+ |
qryCmt.SQL.Text := sql; |
2007 |
+ |
qryCmt.ExecQuery; |
2008 |
+ |
while not qryCmt.Eof do |
2009 |
+ |
begin |
2010 |
+ |
AddComment(qryCmt,cmt,FMetaData); |
2011 |
+ |
qryCmt.Next; |
2012 |
+ |
end; |
2013 |
+ |
finally |
2014 |
+ |
qryCmt.Free; |
2015 |
+ |
end; |
2016 |
+ |
end; |
2017 |
+ |
|
2018 |
+ |
var cType: TCommentType; |
2019 |
+ |
begin |
2020 |
+ |
if CommentTypes = [] then |
2021 |
+ |
begin |
2022 |
+ |
for cType := low(TCommentType) to High(TCommentType) do |
2023 |
+ |
DoListComments(cType) |
2024 |
+ |
end |
2025 |
+ |
else |
2026 |
+ |
for cType in CommentTypes do |
2027 |
+ |
DoListComments(cType); |
2028 |
+ |
end; |
2029 |
+ |
|
2030 |
|
{ ListCreateDb |
2031 |
|
Functional description |
2032 |
|
Print the create database command if requested. At least put |
2052 |
|
Buffer : String; |
2053 |
|
qryDB : TIBSQL; |
2054 |
|
FileFlags, FileLength, FileSequence, FileStart : Integer; |
2055 |
+ |
Comments: TStrings; |
2056 |
|
|
2057 |
|
function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt; |
2058 |
|
begin |
2081 |
|
FMetaData.Add(Buffer); |
2082 |
|
Buffer := ''; |
2083 |
|
|
2084 |
+ |
Comments := TStringList.Create; |
2085 |
|
qryDB := TIBSQL.Create(FDatabase); |
2086 |
|
try |
2087 |
|
qryDB.SQL.Text := CharInfoSQL; |
2095 |
|
else |
2096 |
|
Buffer := Buffer + Term; |
2097 |
|
FMetaData.Add(Buffer); |
2098 |
+ |
AddComment(qryDB,ctDatabase,Comments); |
2099 |
|
qryDB.Close; |
2100 |
|
{List secondary files and shadows as |
2101 |
|
alter db and create shadow in comment} |
2254 |
|
else |
2255 |
|
FMetaData.Add(Format('%s%s%s', [Term, LineEnding, LineEnding])); |
2256 |
|
end; |
2257 |
+ |
FMetaData.AddStrings(Comments); |
2258 |
|
finally |
2259 |
|
qryDB.Free; |
2260 |
+ |
Comments.Free; |
2261 |
|
end; |
2262 |
|
|
2263 |
|
(* |
2442 |
|
Line := Format('CREATE DOMAIN %s AS ', [FieldName]); |
2443 |
|
Line := Line + FormatDomainStr + Term; |
2444 |
|
FMetaData.Add(Line); |
2445 |
+ |
AddComment(qryDomains,ctDomain,FMetaData); |
2446 |
|
qryDomains.Next; |
2447 |
|
end; |
2448 |
|
finally |
2496 |
|
FMetaData.Add(Format('CREATE EXCEPTION %s %s%s', |
2497 |
|
[QuoteIdentifier( qryException.FieldByName('RDB$EXCEPTION_NAME').AsString), |
2498 |
|
QuotedStr(qryException.FieldByName('RDB$MESSAGE').AsString), Term])); |
2499 |
+ |
AddComment(qryException,ctException,FMetaData); |
2500 |
|
qryException.Next; |
2501 |
|
end; |
2502 |
|
finally |
2557 |
|
[TAB, qryFilters.FieldByName('RDB$ENTRYPOINT').AsString, |
2558 |
|
qryFilters.FieldByName('RDB$MODULE_NAME').AsString, Term])); |
2559 |
|
FMetaData.Add(''); |
2560 |
< |
|
2560 |
> |
AddComment(qryFilters,ctFilter,FMetaData); |
2561 |
|
qryFilters.Next; |
2562 |
|
end; |
2563 |
|
|
2729 |
|
First, FirstArg, DidCharset, PrecisionKnown : Boolean; |
2730 |
|
ReturnBuffer, TypeBuffer, Line : String; |
2731 |
|
i, FieldType : Integer; |
2732 |
+ |
Comments: TStrings; |
2733 |
|
begin |
2734 |
|
First := true; |
2735 |
+ |
Comments := TStringList.Create; |
2736 |
|
qryFunctions := TIBSQL.Create(FDatabase); |
2737 |
|
qryFuncArgs := TIBSQL.Create(FDatabase); |
2738 |
|
qryFuncPos := TIBSQL.Create(FDatabase); |
2758 |
|
First := false; |
2759 |
|
end; //end_if |
2760 |
|
{ Start new function declaration } |
2761 |
+ |
AddComment(qryFunctions,ctExternalFunction,Comments); |
2762 |
|
FMetaData.Add(Format('DECLARE EXTERNAL FUNCTION %s', |
2763 |
|
[qryFunctions.FieldByName('RDB$FUNCTION_NAME').AsString])); |
2764 |
|
Line := ''; |
2770 |
|
qryFuncArgs.ExecQuery; |
2771 |
|
while not qryFuncArgs.Eof do |
2772 |
|
begin |
2773 |
+ |
AddComment(qryFuncArgs,ctParameter,Comments); |
2774 |
|
{ Find parameter type } |
2775 |
|
i := 0; |
2776 |
|
FieldType := qryFuncArgs.FieldByName('RDB$FIELD_TYPE').AsInteger; |
2887 |
|
|
2888 |
|
qryFunctions.Next; |
2889 |
|
end; |
2890 |
+ |
FMetaData.AddStrings(Comments); |
2891 |
|
finally |
2892 |
|
qryFunctions.Free; |
2893 |
|
qryFuncArgs.Free; |
2894 |
|
qryCharSets.Free; |
2895 |
|
qryFuncPos.Free; |
2896 |
+ |
Comments.Free; |
2897 |
|
end; |
2898 |
|
end; |
2899 |
|
|
2965 |
|
qryValue.Close; |
2966 |
|
end; |
2967 |
|
end; |
2968 |
+ |
AddComment(qryGenerator,ctSequence,FMetaData); |
2969 |
|
qryGenerator.Next; |
2970 |
|
end; |
2971 |
|
finally |
3070 |
|
')' + Term; |
3071 |
|
|
3072 |
|
FMetaData.Add(Line); |
3073 |
+ |
AddComment(qryIndex,ctIndex,FMetaData); |
3074 |
|
qryIndex.Next; |
3075 |
|
end; |
3076 |
|
finally |
3372 |
|
ListCheck(ObjectName, etTable) |
3373 |
|
else |
3374 |
|
ListCheck(ObjectName); |
3375 |
+ |
eoComments: |
3376 |
+ |
ListComments; |
3377 |
|
eoData : ListData(ObjectName); |
3378 |
|
end; |
3379 |
|
if DidActivate then |
3380 |
|
FTransaction.Commit; |
3381 |
|
end; |
3382 |
|
|
3383 |
+ |
procedure TIBExtract.ListObjectNames(ObjectType: integer; Names: TStrings); |
3384 |
+ |
var qryObjects: TIBSQL; |
3385 |
+ |
i, index: integer; |
3386 |
+ |
sql: string; |
3387 |
+ |
begin |
3388 |
+ |
index := -1; |
3389 |
+ |
Names.Clear; |
3390 |
+ |
for i := Low(DDLObjects) to High(DDLObjects) do |
3391 |
+ |
begin |
3392 |
+ |
if DDLObjects[i].ObjType = ObjectType then |
3393 |
+ |
begin |
3394 |
+ |
index := i; |
3395 |
+ |
break; |
3396 |
+ |
end; |
3397 |
+ |
end; |
3398 |
+ |
if index = -1 then Exit; |
3399 |
+ |
|
3400 |
+ |
qryObjects := TIBSQL.Create(FDatabase); |
3401 |
+ |
try |
3402 |
+ |
with DDLObjects[index] do |
3403 |
+ |
begin |
3404 |
+ |
sql := 'Select ' + NameField + ' From ' + SystemTableName; |
3405 |
+ |
if not ShowSystem then |
3406 |
+ |
sql += ' Where (RDB$SYSTEM_FLAG is null or RDB$SYSTEM_FLAG = 0)'; |
3407 |
+ |
if Condition <> '' then |
3408 |
+ |
begin |
3409 |
+ |
if not ShowSystem then |
3410 |
+ |
sql += ' AND ' + Condition |
3411 |
+ |
else |
3412 |
+ |
sql += ' Where ' + Condition; |
3413 |
+ |
end; |
3414 |
+ |
sql += ' Order by 1'; |
3415 |
+ |
end; |
3416 |
+ |
|
3417 |
+ |
qryObjects.SQL.Text := sql; |
3418 |
+ |
qryObjects.ExecQuery; |
3419 |
+ |
while not qryObjects.Eof do |
3420 |
+ |
begin |
3421 |
+ |
Names.Add(qryObjects.Fields[0].AsString); |
3422 |
+ |
qryObjects.Next; |
3423 |
+ |
end; |
3424 |
+ |
finally |
3425 |
+ |
qryObjects.Free; |
3426 |
+ |
end; |
3427 |
+ |
end; |
3428 |
+ |
|
3429 |
|
function TIBExtract.GetFieldType(FieldType, FieldSubType, FieldScale, |
3430 |
|
FieldSize, FieldPrec, FieldLen: Integer): String; |
3431 |
|
var |
4012 |
|
var |
4013 |
|
qryRoles : TIBSQL; |
4014 |
|
PrevOwner, RoleName, OwnerName : String; |
4015 |
+ |
Comments: TStrings; |
4016 |
|
begin |
4017 |
|
{Process GRANT roles} |
4018 |
+ |
Comments := TStringList.Create; |
4019 |
|
qryRoles := TIBSQL.Create(FDatabase); |
4020 |
|
try |
4021 |
|
if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION9 then |
4036 |
|
try |
4037 |
|
while not qryRoles.Eof do |
4038 |
|
begin |
4039 |
+ |
AddComment(qryRoles,ctRole,Comments); |
4040 |
|
RoleName := QuoteIdentifier( |
4041 |
|
qryRoles.FieldByName('rdb$Role_Name').AsString); |
4042 |
|
OwnerName := Trim(qryRoles.FieldByName('rdb$Owner_Name').AsString); |
4055 |
|
finally |
4056 |
|
qryRoles.Close; |
4057 |
|
end; |
4058 |
+ |
FMetaData.AddStrings(Comments); |
4059 |
|
end; |
4060 |
|
finally |
4061 |
|
qryRoles.Free; |
4062 |
+ |
Comments.Free; |
4063 |
|
end; |
4064 |
|
end; |
4065 |
|
|