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

Comparing ibx/trunk/runtime/nongui/IBExtract.pas (file contents):
Revision 228 by tony, Tue Apr 3 10:52:43 2018 UTC vs.
Revision 229 by tony, Tue Apr 10 13:32:36 2018 UTC

# Line 54 | Line 54 | type
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,
# Line 67 | Line 67 | type
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)
# Line 74 | Line 80 | type
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;
# Line 106 | Line 116 | type
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 = '');
# Line 117 | Line 127 | type
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 }
# Line 130 | Line 141 | type
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  
# Line 139 | Line 151 | type
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  
# Line 247 | Line 260 | const
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  
# Line 316 | Line 337 | const
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
# Line 364 | Line 530 | begin
530      Database := TIBDatabase(AOwner);
531    if AOwner is TIBTransaction then
532      Transaction := TIBTransaction(AOwner);
533 +  FIncludeMetaDataComments := true;
534   end;
535  
536   destructor TIBExtract.Destroy;
# Line 429 | Line 596 | begin
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  
# Line 482 | Line 653 | const
653  
654   var
655    Collation, CharSetId : integer;
656 <        i : integer;
656 >  i : integer;
657    Column, Constraint : String;
658    SubType : integer;
659    IntChar : integer;
# Line 491 | Line 662 | var
662    FieldScale, FieldType : Integer;
663    CreateTable: string;
664    TableType: integer;
665 +  Comments: TStrings;
666   begin
667    Result := true;
668    IntChar := 0;
# Line 503 | Line 675 | begin
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);
# Line 533 | Line 706 | begin
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
# Line 767 | Line 942 | begin
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;
# Line 800 | Line 977 | const
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;
# Line 811 | Line 990 | begin
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', [
# Line 825 | Line 1005 | begin
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;
# Line 836 | Line 1017 | begin
1017        qryViews.Next;
1018      end;
1019    finally
1020 +    FMetaData.AddStrings(Comments);
1021 +    Comments.Free;
1022      qryViews.Free;
1023      qryColumns.Free;
1024    end;
# Line 900 | Line 1083 | begin
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;
# Line 1272 | Line 1490 | var
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
# Line 1297 | Line 1517 | begin
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
# Line 1328 | Line 1549 | 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;
# Line 1391 | Line 1614 | var
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
# Line 1427 | Line 1651 | begin
1651        case ProcDDLType of
1652        pdCreateStub:
1653          begin
1654 +          AddComment(qryProcedures,ctProcedure,Comments);
1655            FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(
1656               ProcName)]));
1657            GetProcedureArgs(ProcName);
# Line 1438 | Line 1663 | begin
1663  
1664        pdCreateProc:
1665        begin
1666 +        AddComment(qryProcedures,ctProcedure,Comments);
1667          FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(
1668             ProcName)]));
1669          GetProcedureArgs(ProcName);
# Line 1479 | Line 1705 | begin
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  
# Line 1575 | Line 1803 | var
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
# Line 1600 | Line 1830 | begin
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
# Line 1654 | Line 1885 | 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;
# Line 1741 | Line 1974 | begin
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
# Line 1766 | Line 2052 | var
2052    Buffer : String;
2053    qryDB : TIBSQL;
2054    FileFlags, FileLength, FileSequence, FileStart : Integer;
2055 +  Comments: TStrings;
2056  
2057    function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): LongInt;
2058    begin
# Line 1794 | Line 2081 | begin
2081    FMetaData.Add(Buffer);
2082    Buffer := '';
2083  
2084 +  Comments := TStringList.Create;
2085    qryDB := TIBSQL.Create(FDatabase);
2086    try
2087      qryDB.SQL.Text := CharInfoSQL;
# Line 1807 | Line 2095 | begin
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}
# Line 1965 | Line 2254 | begin
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   (*
# Line 2151 | Line 2442 | begin
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
# Line 2204 | Line 2496 | begin
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
# Line 2264 | Line 2557 | begin
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  
# Line 2436 | Line 2729 | var
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);
# Line 2463 | Line 2758 | begin
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 := '';
# Line 2474 | Line 2770 | begin
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;
# Line 2590 | Line 2887 | begin
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  
# Line 2666 | Line 2965 | begin
2965            qryValue.Close;
2966          end;
2967        end;
2968 +      AddComment(qryGenerator,ctSequence,FMetaData);
2969        qryGenerator.Next;
2970      end;
2971    finally
# Line 2770 | Line 3070 | begin
3070            ')' + Term;
3071  
3072        FMetaData.Add(Line);
3073 +      AddComment(qryIndex,ctIndex,FMetaData);
3074        qryIndex.Next;
3075      end;
3076    finally
# Line 3071 | Line 3372 | begin
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
# Line 3663 | Line 4012 | const
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
# Line 3685 | Line 4036 | begin
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);
# Line 3703 | Line 4055 | begin
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  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines