home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / zluDDLExtraction.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  115.7 KB  |  2,877 lines
  1. {
  2.  * The contents of this file are subject to the InterBase Public License
  3.  * Version 1.0 (the "License"); you may not use this file except in
  4.  * compliance with the License.
  5.  * 
  6.  * You may obtain a copy of the License at http://www.Inprise.com/IPL.html.
  7.  * 
  8.  * Software distributed under the License is distributed on an "AS IS"
  9.  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  10.  * the License for the specific language governing rights and limitations
  11.  * under the License.  The Original Code was created by Inprise
  12.  * Corporation and its predecessors.
  13.  * 
  14.  * Portions created by Inprise Corporation are Copyright (C) Inprise
  15.  * Corporation. All Rights Reserved.
  16.  * 
  17.  * Contributor(s): ______________________________________.
  18. }
  19.  
  20. {****************************************************************
  21. *
  22. *  z l u D D L E x t r a c t i o n
  23. *
  24. ****************************************************************
  25. *  Author: The Client Server Factory Inc.
  26. *  Date:   March 1, 1999
  27. *
  28. *  Description:  This unit provides all the necessary functions
  29. *                to extract metadata from the various InterBase
  30. *                database objects.
  31. *
  32. *****************************************************************
  33. * Revisions:
  34. *
  35. *****************************************************************}
  36.  
  37. unit zluDDLExtraction;
  38.  
  39. interface
  40.  
  41. uses
  42.   SysUtils, Classes, zluibcClasses, dmuMain, IB, frmuMessage, IBSql,
  43.   zluUtility, zluGlobal, IBDatabase, IBDatabaseInfo;
  44.  
  45. type
  46.  
  47. function GetDDLBlobFilters(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  48. function GetDDLCheckConst(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  49. function GetDDLColumns(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  50. function GetDDLDatabase(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): boolean;
  51. function GetDDLDomains(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  52. function GetDDLExceptions(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  53. function GetDDLFunctions(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  54. function GetDDLGenerators(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  55. function GetDDLIndexes(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  56. function GetDDLProcedures(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  57. function GetDDLReferentialConst(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  58. function GetDDLRoles(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  59. function GetDDLTable(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  60. function GetDDLTables(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): boolean;
  61. function GetDDLTriggers(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  62. function GetDDLUniqueConst(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  63. function GetDDLViews(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean; const ObjName: String): boolean;
  64. function GetDependencies(var Dependencies: TStringList; const SelDatabaseNode: TIBDatabase; const ObjectName:String; const ObjectType: Integer): integer;
  65.  
  66. implementation
  67.  
  68. const
  69.   MAXSUBTYPES = 8;
  70.   TERMINATOR = '!!';           // Define new terminator to use with procedures and triggers
  71.  
  72.  
  73.   { Flags for RDB$FILE_FLAGS }
  74.   FILE_shadow   = $01;
  75.   FILE_inactive    = $02;
  76.   FILE_manual   = $04;
  77.   FILE_cache    = $08;
  78.   FILE_conditional = $10;
  79.  
  80.   { flags for RDB$LOG_FILES }
  81.   LOG_serial    = $01;
  82.   LOG_default   = $02;
  83.   LOG_raw       = $04;
  84.   LOG_overflow  = $08;
  85.  
  86.   { flags for RDB$RELATIONS }
  87.   REL_sql       = $01;
  88.  
  89.   { flags for RDB$TRIGGERS }
  90.   TRG_sql          = $01
  91.   TRG_ignore_perm  = $02;
  92.  
  93. {****************************************************************
  94. *
  95. *  G e t D D L B l o b F i l t e r s ( )
  96. *
  97. ****************************************************************
  98. *  Author: The Client Server Factory Inc.
  99. *  Date:   March 1, 1999
  100. *
  101. *  Input:  TStringList (variable)   - Gets populated with metadata for blob filters.
  102. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  103. *          Boolean (value)          - Specifies whether or not to include system data.
  104. *
  105. *  Return: Boolean - Indicates the success/failure of the operation
  106. *
  107. *  Description:  Retrieves metadata for all blob filters in the database.
  108. *
  109. *****************************************************************
  110. * Revisions:
  111. *
  112. *****************************************************************}
  113. function GetDDLBlobFilters(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  114.                            const SystemData: boolean; const ObjName: String): boolean;
  115. var
  116.   lSQLStr: string;
  117.   lqryGetObjList: TIBSql;
  118. begin
  119.   // initialize
  120.   lqryGetObjList := nil;
  121.   try
  122.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  123.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  124.  
  125.     // quert to get list of BLOB filters
  126.     lqryGetObjList := TIBSql.Create(dmMain);
  127.     lqryGetObjList.Database := SelDatabaseNode;
  128.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  129.  
  130.     with lqryGetObjList do
  131.     begin
  132.       lSQLStr := 'SELECT RDB$FUNCTION_NAME,RDB$MODULE_NAME,RDB$ENTRYPOINT,';
  133.       lSQLStr := Format('%s RDB$INPUT_SUB_TYPE,RDB$OUTPUT_SUB_TYPE FROM RDB$FILTERS',[lSQLStr]);
  134.  
  135.       // if the system data menu item is selected then include system data in query
  136.       if not SystemData then
  137.       begin
  138.         lSQLStr := Format('%s WHERE (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  139.       end;
  140.  
  141.       if ObjName <> '' then
  142.       begin
  143.         if not SystemData then
  144.           lSQLStr := Format('%s AND RDB$FUNCTION_NAME = ''%s''', [lSQLStr, ObjName])
  145.         else
  146.           lSQLStr := Format('%s WHERE RDB$FUNCTION_NAME = ''%s''', [lSQLStr, ObjName]);
  147.       end;
  148.  
  149.       lSQLStr := Format('%s ORDER BY RDB$FUNCTION_NAME',[lSQLStr]);
  150.       SQL.Clear;
  151.       SQL.Add(lSQLStr);
  152.       try
  153.         Prepare;
  154.         ExecQuery;
  155.         result := false;
  156.         while not EOF do
  157.         begin
  158.           SQLScript.Add(Format('/*  Blob Filter: %s  */',[Trim(FieldbyName('RDB$FUNCTION_NAME').AsString)]));
  159.           SQLScript.Add(Format('DECLARE FILTER %s ',[Trim(FieldbyName('RDB$FUNCTION_NAME').AsString)]));
  160.           SQLScript.Add(Format('INPUT_TYPE %s OUTPUT_TYPE %s',[Trim(FieldbyName('RDB$INPUT_SUB_TYPE').AsString),Trim(FieldbyName('RDB$OUTPUT_SUB_TYPE').AsString)]));
  161.           SQLScript.Add(Format('ENTRY_POINT ''%s'' MODULE_NAME ''%s''',[Trim(FieldbyName('RDB$ENTRYPOINT').AsString),Trim(FieldbyName('RDB$MODULE_NAME').AsString)]));
  162.  
  163.           SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ';';
  164.           SQLScript.Add(' ');
  165.           Next;                                // increment lqryGetObjList pointer
  166.           // return result as true
  167.           result := true;
  168.         end;
  169.         Close;
  170.       except
  171.         on E:EIBError do
  172.         begin
  173.           // if an exception occurs then catch it and show error message
  174.           // return result as false
  175.           DisplayMsg(ERR_GET_DDL, E.Message);
  176.           result := false;
  177.         end;
  178.       end;
  179.     end;
  180.   finally
  181.     // close dataset and deallocate memory
  182.     lqryGetObjList.Close;
  183.     lqryGetObjList.Free;
  184.   end;
  185. end;
  186.  
  187. {****************************************************************
  188. *
  189. *  G e t D D L C h e c k C o n s t ( )
  190. *
  191. ****************************************************************
  192. *  Author: The Client Server Factory Inc.
  193. *  Date:   March 1, 1999
  194. *
  195. *  Input:  TStringList (variable)   - Gets populated with metadata for check constraints.
  196. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  197. *          String (value)           - Specifies a table name.
  198. *
  199. *  Return: Boolean - Indicates the success/failure of the operation
  200. *
  201. *  Description:  Retrieves metadata for all check constraints in a specified table.
  202. *
  203. *****************************************************************
  204. * Revisions:
  205. *
  206. *****************************************************************}
  207. function GetDDLCheckConst(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  208. var
  209.   lSQLStr: string;
  210.   lqryGetObjList : TIBSQL;
  211.   lqryGetObjDetails: TIBSQL;
  212. begin
  213.   lqryGetObjList := nil;
  214.   lqryGetObjDetails := nil;
  215.   try
  216.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  217.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  218.  
  219.     // query to get list of check constraints
  220.     lqryGetObjList := TIBSql.Create(dmMain);
  221.     lqryGetObjList.Database := SelDatabaseNode;
  222.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  223.  
  224.     with lqryGetObjList do
  225.     begin
  226.       // get check constraints and source
  227.       lSQLStr := 'SELECT A.RDB$CONSTRAINT_NAME, A.RDB$TRIGGER_NAME, B.RDB$TRIGGER_NAME,';
  228.       lSQLStr := Format('%s B.RDB$RELATION_NAME, B.RDB$TRIGGER_SOURCE, B.RDB$TRIGGER_TYPE FROM', [lSQLStr]);
  229.       lSQLStr := Format('%s RDB$CHECK_CONSTRAINTS A, RDB$TRIGGERS B WHERE', [lSQLStr]);
  230.       lSQLStr := Format('%s B.RDB$RELATION_NAME = ''%s''', [lSQLStr, TableName]);
  231.       lSQLStr := Format('%s AND A.RDB$TRIGGER_NAME = B.RDB$TRIGGER_NAME AND', [lSQLStr]);
  232.       lSQLStr := Format('%s B.RDB$TRIGGER_TYPE = 1', [lSQLStr]);
  233.       lSQLStr := Format('%s ORDER BY RDB$CONSTRAINT_NAME ASC', [lSQLStr]);
  234.  
  235.       SQL.Clear;
  236.       SQL.Add(lSQLStr);
  237.       try
  238.         Prepare;
  239.         ExecQuery;
  240.         result := false;
  241.         while not EOF do
  242.         begin
  243.           // show check constraint source
  244.           SQLScript.Add(Format('/*  Check Constraint: %s  */',[Trim(FieldbyName('RDB$CONSTRAINT_NAME').AsString)]));
  245.           SQLScript.Add(Format('ALTER TABLE %s',[Trim(FieldbyName('RDB$RELATION_NAME').AsString)]));
  246.           SQLScript.Add(FORMAT('  ADD CONSTRAINT %s', [Trim(FIeldByName('RDB$CONSTRAINT_NAME').AsString)]));
  247.           SQLScript.Add(Format('  %s', [FIeldByName('RDB$TRIGGER_SOURCE').AsString]));
  248.  
  249.           SQLScript.Add(' ');
  250.           Next;                                // increment lqryGetObjList pointer
  251.           result := true;
  252.         end;
  253.         Close;
  254.       except
  255.         on E:EIBError do
  256.         begin
  257.           // if an exception occurs then catch it and show error message
  258.           // return result as false
  259.           DisplayMsg(ERR_GET_DDL, E.Message);
  260.           result := false;
  261.         end;
  262.       end;
  263.     end;
  264.   finally
  265.     // close datasets and deallocate memory
  266.     lqryGetObjList.Close;
  267.     lqryGetObjDetails.Close;
  268.     lqryGetObjList.Free;
  269.   end;
  270. end;
  271. {****************************************************************
  272. *
  273. *  G e t D D L C o l u m n s ( )
  274. *
  275. ****************************************************************
  276. *  Author: The Client Server Factory Inc.
  277. *  Date:   March 1, 1999
  278. *
  279. *  Input:  TStringList (variable)   - Gets populated with metadata for columns.
  280. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  281. *          String (value)           - Specifies a table name.
  282. *
  283. *  Return: Boolean - Indicates the success/failure of the operation
  284. *
  285. *  Description:  Retrieves metadata for all columns in a specified table.
  286. *
  287. *****************************************************************
  288. * Revisions:
  289. *
  290. *****************************************************************}
  291. function GetDDLColumns(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  292. var
  293.   lSQLStr: string;
  294.   lStr: string;
  295.   lqryGetObjList : TIBSQL;
  296.  
  297. begin
  298.   // initialize
  299.   lqryGetObjList := nil;
  300.   try
  301.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  302.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  303.  
  304.     // query to get list of columns and details
  305.     lqryGetObjList := TIBSql.Create(dmMain);
  306.     lqryGetObjList.Database := SelDatabaseNode;
  307.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  308.  
  309.     with lqryGetObjList do
  310.     begin
  311.       lSQLStr:='SELECT A.RDB$FIELD_NAME, A.RDB$RELATION_NAME, A.RDB$NULL_FLAG NOTNULL,';
  312.       lSQLStr:=Format('%s A.RDB$FIELD_POSITION, A.RDB$FIELD_SOURCE, B.RDB$COMPUTED_SOURCE,', [lSQLStr]);
  313.       lSQLStr:=Format('%s A.RDB$DEFAULT_SOURCE DEF, B.RDB$FIELD_NAME, B.RDB$FIELD_TYPE,', [lSQLStr]);
  314.       lSQLStr:=Format('%s B.RDB$FIELD_SUB_TYPE, B.RDB$SEGMENT_LENGTH, B.RDB$DIMENSIONS,', [lSQLStr]);
  315.       lSQLStr:=Format('%s B.RDB$FIELD_LENGTH, B.RDB$FIELD_SCALE, B.CHARACTER_LENGTH, B.FIELD_PRECISION', [lSQLStr]);
  316.       lSQLStr:=Format('%s FROM RDB$RELATION_FIELDS A, RDB$FIELDS B WHERE', [lSQLStr]);
  317.       lSQLStr:=FOrmat('%s A.RDB$RELATION_NAME = ''%s'' AND', [lSQLStr, TableName]);
  318.       lSQLStr:=Format('%s A.RDB$FIELD_SOURCE = B.RDB$FIELD_NAME', [lSQLStr]);
  319.       lSQLStr := Format('%s ORDER BY RDB$FIELD_POSITION',[lSQLStr]);
  320.  
  321.       SQL.Clear;
  322.       SQL.Add(lSQLStr);
  323.       try
  324.         Prepare;
  325.         ExecQuery;
  326.         result := false;
  327.         while not EOF do
  328.         begin
  329.           // determine if current column is based on a domain or
  330.           // natural data type and whether or not this is a computed column
  331.           // if none of the above then determine the data type
  332.           if (StrPos(PChar(FieldByName('RDB$FIELD_SOURCE').AsString), PChar('RDB$')) <> Nil) and
  333.             (Trim(FieldByName('RDB$COMPUTED_SOURCE').AsString) = '') then
  334.           begin
  335.             if FieldByName('RDB$DIMENSIONS').AsInteger > 0 then
  336.                GetArrayField(lStr, Database, Trim(FieldByName('RDB$FIELD_SOURCE').AsString));
  337.  
  338.             lStr := Format('%s %s',[lStr , GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  339.                                                  FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  340.                                                  FieldByName('RDB$FIELD_LENGTH').AsInteger,
  341.                                                  FieldByName('RDB$FIELD_SCALE').AsInteger,
  342.                                                  FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  343.                                                  FieldByName('RDB$FIELD_PRECISION').AsInteger)]);
  344.           end // not a domain
  345.           else
  346.             if Trim(FieldByName('RDB$COMPUTED_SOURCE').AsString) <> '' then
  347.               lStr:='COMPUTED BY ' + Trim(FieldByName('RDB$COMPUTED_SOURCE').AsString)
  348.             else                               // otherwise use the domain as the datatype
  349.               lStr:=Trim(FieldByName('RDB$FIELD_SOURCE').AsString);
  350.  
  351.           // add to script
  352.           SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + lStr;
  353.  
  354.           // add default source, if any
  355.           if not FieldByName('DEF').IsNull then
  356.           begin
  357.             SQLScript.Strings[SQLScript.Count - 1] :=
  358.               SQLScript.Strings[SQLScript.Count - 1] + ' ' +
  359.               Trim(FieldByName('DEF').AsString);
  360.           end;
  361.  
  362.           // determine if column is NULL or NOT NULL
  363.           if (not FieldByName('NOTNULL').IsNull) and
  364.             (FieldByName('NOTNULL').AsInteger = 1) then
  365.           begin
  366.             SQLScript.Strings[SQLScript.Count - 1] :=
  367.               SQLScript.Strings[SQLScript.Count - 1] + ' NOT NULL';
  368.           end;
  369.  
  370.           SQLScript.Strings[SQLScript.Count - 1] :=
  371.             SQLScript.Strings[SQLScript.Count - 1] + ';';
  372.  
  373.           SQLScript.Add(' ');
  374.           Next;                                // increment lqryGetObjList pointer
  375.           result := true;
  376.         end;
  377.         Close;
  378.       except
  379.         on E:EIBError do
  380.         begin
  381.           // if an exception occurs then catch it and show error message
  382.           // return result as false
  383.           DisplayMsg(ERR_GET_DDL, E.Message);
  384.           result := false;
  385.         end;
  386.       end;
  387.     end;
  388.   finally
  389.     // close datasets and deallocate memeory
  390.     lqryGetObjList.Close;
  391.     lqryGetObjList.Free;
  392.   end;
  393. end;
  394.  
  395. {****************************************************************
  396. *
  397. *  G e t D D L D a t a b a s e ( )
  398. *
  399. ****************************************************************
  400. *  Author: The Client Server Factory Inc.
  401. *  Date:   March 1, 1999
  402. *
  403. *  Input:  TStringList (variable)   - Gets populated with metadata for tables.
  404. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  405. *          Boolean (value)          - Specifies whether or not to include system data.
  406. *
  407. *  Return: Boolean - Indicates the success/failure of the operation
  408. *
  409. *  Description:  Retrieves metadata for all tables in the database.
  410. *
  411. *****************************************************************
  412. * Revisions:
  413. *
  414. *****************************************************************}
  415. function GetDDLDatabase(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): boolean;
  416. var
  417.   lStr: String;
  418.   lCnt: integer;
  419.   lRelations: TStringList;
  420.   lQry: TIBSql;
  421.   lDbInfo: TIBDatabaseInfo;
  422.  
  423. begin
  424.   lRelations := TStringList.Create;
  425.   try
  426.     // Get a list of all the relations
  427.     dmMain.GetTableList (lRelations, SelDatabaseNode, SystemData);
  428.  
  429.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  430.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  431.  
  432.     // show header
  433.     lDbInfo := TIBDatabaseInfo.Create (nil);
  434.     lDBInfo.Database := SelDatabaseNode;
  435.     lStr := Format('/* CREATE DATABASE ''%s'' PAGE_SIZE %ld;', [SelDatabaseNode.DatabaseName, lDbInfo.PageSize ])
  436.  
  437.     lQry := TIBSql.Create (nil);
  438.     with lQry do
  439.     begin
  440.       Transaction := SelDatabaseNode.DefaultTransaction;
  441.       Database := SelDatabaseNode;
  442.       SQL.Add ('select * from rdb$database where rdb$character_set_name is not null and rdb$character_set_name != '' ''');
  443.       Prepare;
  444.       ExecQuery;
  445.       if not EOF then
  446.         lStr := Format ('%s DEFAULT CHARACTER SET %s', [lStr, Trim(FieldByName('RDB$CHARACTER_SET'))]);
  447.       Close;
  448.  
  449.       SQLSCript.Add(lStr);
  450.       SQLScript.Add('');
  451.  
  452.       { Now list all secondary files and shadow files for the database }
  453.       SQL.Clear;
  454.       SQL.Add ('select * from rdb$files order by rdb$shadow_number, rdb$file_sequence');
  455.       Prepare;
  456.       ExecQuery;
  457.  
  458.       if not EOF then
  459.         SQLScript.Add ('/* Add secondary files in comments');
  460.       while not EOF do
  461.       begin
  462.         if (FieldByName('RDB$FILE_FLAGS').AsInteger = 0 then
  463.         begin
  464.           SQLSCript.Add (Format('ALTER DATABASE ADD FILE ''%s''',[Trim(FieldByName('RDB$FILE_NAME'))]));
  465.           if not (FieldByName('RDB$FILE_START').IsNull) then
  466.             SQLScript.Add (Format('STARTING %ld', [FieldByName('RDB$FILE_START').AsInteger]));
  467.  
  468.           if not (FieldByName('RDB$FILE_LENGTH').IsNull) then
  469.             SQLScript.Add (Format('LENGTH %ld', [FieldByName('RDB$FILE_LENGTH').AsInteger]));
  470.           Next;
  471.           Continue;
  472.         end;
  473.  
  474.         if (FieldByName('RDB$FILE_FLAGS').AsInteger and FILE_cache) then
  475.         begin
  476.           SqlScript.Add (Format('ALTER DATABASE ADD CACHE ''%s'' LENGTH %ld',[Trim(FieldByName('RDB$FILE_NAME')),
  477.                                                                               FieldByName('RDB$FILE_LENGTH').AsInteger]));
  478.           Next;
  479.           Continue;
  480.         end;
  481.  
  482.         if (FieldByName('RDB$FILE_FLAGS').AsInteger and FILE_shadow) then
  483.         begin
  484.           if FieldByName('RDB$FILE_SEQUENCE').AsInteger > 0 then
  485.             SqlScript.Add (Format ('FILE ''%s''', [Trim(FieldByName('RDB$FILE_NAME').AsString])
  486.           else
  487.           begin
  488.             lStr := Format ('CREATE SHADOW %d ''%s''', [FieldByName('RDB$SHADOW_NUMBER').AsInteger,
  489.                                                         Trim(FieldByName('RDB$FILE_NAME').AsString)]);
  490.  
  491.             if FieldByName ('RDB$FILE_FLAGS').AsInteger and FILE_inactive) then
  492.               lStr := Format ('%s INACITVE', [lStr]);
  493.  
  494.             if FieldByName ('RDB$FILE_FLAGS').AsInteger and FILE_manual) then
  495.               lStr := Format ('%s MANUAL', [lStr])
  496.             else
  497.               lStr := Format ('%s AUTO', [lStr]);
  498.  
  499.             if FieldByName ('RDB$FILE_FLAGS').AsInteger and FILE_conditional) then
  500.               lStr := Format ('%s CONDITIONAL', [lStr]);
  501.  
  502.             SqlScript.Add (lStr);
  503.           end;
  504.  
  505.           if FieldByName('RDB$FILE_LENGTH').AsInteger > 0 then
  506.             SqlScript.Add (Format ('LENGTH %ld', [FieldByName('RDB$FILE_LENGTH').AsInteger]));
  507.  
  508.           if FieldByName('RDB$FILE_START').AsInteger > 0 then
  509.             SqlScript.Add (Format ('STARTING %ld', [FieldByName('RDB$FILE_START').AsInteger]));
  510.           Next;
  511.           Continue;
  512.         end;
  513.       end;
  514.     end;
  515.  
  516.  
  517.     GetDDLBlobFilters (SQLScript, SelDatabasenode, SystemData, '');
  518.     GetDDLFunctions (SQLScript, SelDatabaseNode, SystemData, '');
  519.     GetDDLDomains (SqlScript, SelDatabaseNode, SystemData, '');
  520.     GetDDLTables (SQLScript, SeldatabaseNode, SystemData);
  521.  
  522.     { TODO : Extract all indexes }
  523.     for lCnt := 0 to lRelations.Count - 1 do
  524.       GetDDLIndexes (SqlScript, SeldatabaseNode, lRelations.Strings[lCnt]);
  525.  
  526.     { TODO : Extract foriegn keys }
  527.     for lCnt := 0 to lRelations.Count - 1 do
  528.       GetDDLUniqueConst (SQLScript, SelDatabaseNode, lRelations.Strings[lCnt]);
  529.  
  530.     for lCnt := 0 to lRelations.Count - 1 do
  531.       GetDDLReferentialConst (SQLScript, SelDatabaseNode, lRelations.Strings[lCnt]);
  532.  
  533.     GetDDLGenerators (SQLScript, SeldatabaseNode, SystemData, '');
  534.     GetDDLViews (SqlScript, SelDatabaseNode, SystemData, '');
  535.  
  536.     { TODO : Extract all check constraints }
  537.     for lCnt := 0 to lRelations.Count - 1 do
  538.       GetDDLCheckConst (SqlScript, SelDatabaseNode, lRelations.Strings[lCnt]);
  539.  
  540.     GetDDLExceptions (SqlScript, SelDatabaseNode, SystemData, '');
  541.     GetDDLProcedures (SqlScript, SelDatabaseNode, SystemData, '');
  542.  
  543.     { TODO : Extract all triggers }
  544.     for lCnt := 0 to lRelations.Count - 1 do
  545.       GetDDLTriggers (SqlScript, SelDatabaseNode, lRelations.Strings[lCnt]);
  546.  
  547.     GetDDLRoles (SqlScript, SelDatabaseNode, SystemData, '');
  548.  
  549.     { TODO : Extract all permissions }
  550.   finally
  551.     lRelations.Free;
  552.   end;
  553. end;
  554.  
  555. {****************************************************************
  556. *
  557. *  G e t D D L D o m a i n s ( )
  558. *
  559. ****************************************************************
  560. *  Author: The Client Server Factory Inc.
  561. *  Date:   March 1, 1999
  562. *
  563. *  Input:  TStringList (variable)   - Gets populated with domain metadata.
  564. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  565. *          Boolean (value)          - Specifies whether or not to include system data.
  566. *
  567. *  Return: Boolean - Indicates the success/failure of the operation
  568. *
  569. *  Description:  Retrieves metadata for domains.
  570. *
  571. *****************************************************************
  572. * Revisions:
  573. *
  574. *****************************************************************}
  575. // Missing support for collation sequences
  576. function GetDDLDomains(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  577.                        const SystemData: boolean; const ObjName: String): boolean;
  578. var
  579.   lStr, lSQLStr: string;
  580.   lqryGetObjList: TIBSQL;
  581.  
  582. begin
  583.   // initialize
  584.   lqryGetObjList := nil;
  585.  
  586.   try
  587.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  588.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  589.  
  590.     // query for field names
  591.     lqryGetObjList := TIBSQL.Create(dmMain);
  592.     lqryGetObjList.Database := SelDatabaseNode;
  593.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  594.  
  595.     with lqryGetObjList do
  596.     begin
  597.       // get all field names from the RDB$FIELDS system table
  598.       lSQLStr := 'SELECT RDB$FIELD_NAME,RDB$FIELD_TYPE,RDB$FIELD_SUB_TYPE,RDB$FIELD_LENGTH,RDB$FIELD_SCALE,RDB$NULL_FLAG,RDB$SEGMENT_LENGTH,';
  599.       lSQLStr := Format('%s RDB$DEFAULT_SOURCE,RDB$VALIDATION_SOURCE,RDB$DESCRIPTION,RDB$DIMENSIONS FROM RDB$FIELDS',[lSQLStr]);
  600.  
  601.       // check whether or not to include columns/domains belonging to system tables
  602.       if not SystemData then
  603.       begin
  604.         lSQLStr := Format('%s WHERE (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  605.       end;
  606.  
  607.       if ObjName <> '' then
  608.       begin
  609.         if not SystemData then
  610.           lSQLStr := Format('%s AND RDB$FIELD_NAME = ''%s''', [lSQLStr, ObjName])
  611.         else
  612.           lSQLStr := Format('%s WHERE RDB$FIELD_NAME = ''%s''', [lSQLStr, ObjName]);
  613.       end;
  614.  
  615.       lSQLStr := Format('%s ORDER BY RDB$FIELD_NAME',[lSQLStr]);
  616.       SQL.Clear;
  617.       SQL.Add(lSQLStr);
  618.       try
  619.         Prepare;
  620.         ExecQuery;
  621.         result := false;
  622.         while not EOF do
  623.         begin
  624.           // loop through list of fields (this is the reference point)
  625.           SQLScript.Add(Format('/*  Type: %s  */',[Trim(FieldbyName('RDB$FIELD_NAME').AsString)]));
  626.           SQLScript.Add(Format('CREATE DOMAIN %s AS ',[Trim(FieldbyName('RDB$FIELD_NAME').AsString)]));
  627.  
  628.           if FieldByName('RDB$DIMENSIONS').AsInteger > 0 then
  629.              GetArrayField(lStr, Database, Trim(FieldByName('RDB$FIELD_SOURCE').AsString));
  630.  
  631.           lStr := Format('%s %s',[lStr , GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  632.                                                FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  633.                                                FieldByName('RDB$FIELD_LENGTH').AsInteger,
  634.                                                FieldByName('RDB$FIELD_SCALE').AsInteger,
  635.                                                FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  636.                                                FieldByName('RDB$FIELD_PRECISION').AsInteger)]);
  637.           // add to script
  638.           SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + lStr;
  639.  
  640.           // add default source, if any
  641.           if not FieldByName('RDB$DEFAULT_SOURCE').IsNull then
  642.           begin
  643.             SQLScript.Strings[SQLScript.Count - 1] :=
  644.               SQLScript.Strings[SQLScript.Count - 1] + ' ' +
  645.               Trim(FieldByName('RDB$DEFAULT_SOURCE').AsString);
  646.           end;
  647.  
  648.           // determine if column is NULL or NOT NULL
  649.           if (not FieldByName('RDB$NULL_FLAG').IsNull) and
  650.             (FieldByName('RDB$NULL_FLAG').AsInteger = 1) then
  651.           begin
  652.             SQLScript.Strings[SQLScript.Count - 1] :=
  653.               SQLScript.Strings[SQLScript.Count - 1] + ' NOT NULL';
  654.           end;
  655.  
  656.           SQLScript.Strings[SQLScript.Count - 1] :=
  657.             SQLScript.Strings[SQLScript.Count - 1] + ';';
  658.  
  659.           SQLScript.Add(' ');
  660.           Next;                                // increment lqryGetObjList pointer
  661.           result := true;
  662.         end;
  663.         Close;
  664.       except
  665.         on E:EIBError do
  666.         begin
  667.           // if an exception occurs then catch it and display the error message
  668.           // return result as false
  669.           DisplayMsg(ERR_GET_DDL, E.Message);
  670.           result := false;
  671.         end;
  672.       end;
  673.     end;
  674.   finally
  675.     // close queries and deallocate memory
  676.     lqryGetObjList.Close;
  677.     lqryGetObjList.Free;
  678.   end;
  679. end;
  680.  
  681. {****************************************************************
  682. *
  683. *  G e t D D L E x c e p t i o n s ( )
  684. *
  685. ****************************************************************
  686. *  Author: The Client Server Factory Inc.
  687. *  Date:   March 1, 1999
  688. *
  689. *  Input:  TStringList (variable)   - Gets populated with metadata for exceptions.
  690. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  691. *          Boolean (value)          - Specifies whether or not to include system data.
  692. *
  693. *  Return: Boolean - Indicates the success/failure of the operation
  694. *
  695. *  Description:  Retrieves metadata for all exceptions in the database.
  696. *
  697. *****************************************************************
  698. * Revisions:
  699. *
  700. *****************************************************************}
  701. function GetDDLExceptions(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  702.                           const SystemData: boolean; const ObjName: String): boolean;
  703. var
  704.   lSQLStr: string;
  705.   lqryGetObjList: TIBSql;
  706. begin
  707.   // initialize
  708.   lqryGetObjList := nil;
  709.   try
  710.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  711.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  712.  
  713.     // query to get list of exceptions
  714.     lqryGetObjList := TIBSql.Create(dmMain);
  715.     lqryGetObjList.Database := SelDatabaseNode;
  716.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  717.  
  718.     with lqryGetObjList do
  719.     begin
  720.       lSQLStr := 'SELECT RDB$EXCEPTION_NAME,RDB$MESSAGE FROM RDB$EXCEPTIONS';
  721.  
  722.       // if the system data menu item is selected then include system data in query
  723.       if not SystemData then
  724.       begin
  725.         lSQLStr := Format('%s WHERE (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  726.       end;
  727.  
  728.       if ObjName <> '' then
  729.       begin
  730.         if not SystemData then
  731.           lSQLStr := Format('%s AND RDB$EXCEPTION_NAME = ''%s''', [lSQLStr, ObjName])
  732.         else
  733.           lSQLStr := Format('%s WHERE RDB$EXCEPTION_NAME = ''%s''', [lSQLStr, ObjName]);
  734.       end;
  735.  
  736.       lSQLStr := Format('%s ORDER BY RDB$EXCEPTION_NAME',[lSQLStr]);
  737.       SQL.Clear;
  738.       SQL.Add(lSQLStr);
  739.       try
  740.         Prepare;
  741.         ExecQuery;
  742.         result := false;
  743.         while not EOF do
  744.         begin
  745.           // show header
  746.           SQLScript.Add(Format('/*  Exception %s  */',[Trim(FieldbyName('RDB$EXCEPTION_NAME').AsString)]));
  747.           SQLScript.Add(Format('CREATE EXCEPTION %s ''%s'';',[Trim(FieldbyName('RDB$EXCEPTION_NAME').AsString),
  748.             Trim(FieldbyName('RDB$MESSAGE').AsString)]));
  749.           SQLScript.Add(' ');
  750.           Next;                                // increment lqryGetObhList pointer
  751.           // return result as true
  752.           result := true;
  753.         end;
  754.         Close;
  755.       except
  756.         on E:EIBError do
  757.         begin
  758.           // if an exception occurs then catch it and show error message
  759.           // return result as false
  760.           DisplayMsg(ERR_GET_DDL, E.Message);
  761.           result := false;
  762.         end;
  763.       end;
  764.     end;
  765.   finally
  766.     // close dataset and deallocate memory
  767.     lqryGetObjList.Close;
  768.     lqryGetObjList.Free;
  769.   end;
  770. end;
  771.  
  772. {****************************************************************
  773. *
  774. *  G e t D D L F u n c t i o n s ( )
  775. *
  776. ****************************************************************
  777. *  Author: The Client Server Factory Inc.
  778. *  Date:   March 1, 1999
  779. *
  780. *  Input:  TStringList (variable)   - Gets populated with metadata for functions.
  781. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  782. *          Boolean (value)          - Specifies whether or not to include system data.
  783. *
  784. *  Return: Boolean - Indicates the success/failure of the operation
  785. *
  786. *  Description:  Retrieves metadata for all functions in the database.
  787. *
  788. *****************************************************************
  789. * Revisions:
  790. *
  791. *****************************************************************}
  792. function GetDDLFunctions(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  793.                          const SystemData: boolean; const ObjName: String): boolean;
  794. var
  795.   lSQLStr   : string;
  796.   lStr      : string;                  // temporary string
  797.   lReturn   : string;                  // stores what functionr returns
  798.   lFirst    : Boolean;
  799.  
  800.   lqryGetObjList : TIBSql;
  801.   lqryGetObjDetails : TIBSql;
  802. begin
  803.   // initialize
  804.   lqryGetObjList := nil;
  805.   lqryGetObjDetails := nil;
  806.  
  807.   try
  808.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  809.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  810.  
  811.     // query to get functions
  812.     lqryGetObjList := TIBSql.Create(dmMain);
  813.     lqryGetObjList.Database := SelDatabaseNode;
  814.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  815.  
  816.     // query to get function details
  817.     lqryGetObjDetails := TIBSql.Create(dmMain);
  818.     lqryGetObjDetails.Database := SelDatabaseNode;
  819.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  820.  
  821.     with lqryGetObjList do
  822.     begin
  823.       lSQLStr := 'SELECT RDB$FUNCTION_NAME, RDB$MODULE_NAME, RDB$ENTRYPOINT ENTRY,';
  824.       lSQLStr := Format('%s RDB$RETURN_ARGUMENT FROM RDB$FUNCTIONS', [lSQLStr]);
  825.  
  826.       // if the system data menu item is selected then include system data in query
  827.       if not SystemData then
  828.       begin
  829.         lSQLStr := Format('%s WHERE (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  830.       end;
  831.  
  832.       if ObjName <> '' then
  833.       begin
  834.         if not SystemData then
  835.           lSQLStr := Format('%s AND RDB$FUNCTION_NAME = ''%s''', [lSQLStr, ObjName])
  836.         else
  837.           lSQLStr := Format('%s WHERE RDB$FUNCTION_NAME = ''%s''', [lSQLStr, ObjName]);
  838.       end;
  839.  
  840.       lSQLStr := Format('%s ORDER BY RDB$FUNCTION_NAME', [lSQLStr]);
  841.  
  842.       SQL.Clear;
  843.       SQL.Add(lSQLStr);
  844.       try
  845.         Prepare;
  846.         ExecQuery;
  847.         result := false;
  848.         while not EOF do
  849.         begin
  850.           // loop through list of functions
  851.           // this is the main compare loop
  852.           lStr:='';
  853.           // show header
  854.           SQLScript.Add(Format('/*  Function: %s  */',[Trim(FieldbyName('RDB$FUNCTION_NAME').AsString)]));
  855.           SQLScript.Add(Format('DECLARE EXTERNAL FUNCTION %s',[Trim(FieldbyName('RDB$FUNCTION_NAME').AsString)]));
  856.           SQLScript.Add('  ');
  857.  
  858.           lFirst := True;
  859.  
  860.           // get function arguments
  861.           lqryGetObjDetails.Close;
  862.           lqryGetObjDetails.SQL.Clear;
  863.           lqryGetObjDetails.SQL.Add('SELECT * FROM RDB$FUNCTION_ARGUMENTS');
  864.           lqryGetObjDetails.SQL.Add(Format('WHERE RDB$FUNCTION_NAME = ''%s''',
  865.             [Trim(FieldByName('RDB$FUNCTION_NAME').AsString)]));
  866.           lqryGetObjDetails.SQL.Add('ORDER BY RDB$ARGUMENT_POSITION ASC');
  867.  
  868.           try
  869.             with lQryGetObjDetails do
  870.             begin
  871.               lqryGetObjDetails.Prepare;
  872.               lqryGetObjDetails.ExecQuery;
  873.               while not lqryGetObjDetails.EOF do
  874.               begin
  875.                   // determine the data type of the arguements
  876.                 lStr := GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  877.                                       FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  878.                                       FieldByName('RDB$FIELD_LENGTH').AsInteger,
  879.                                       FieldByName('RDB$FIELD_SCALE').AsInteger,
  880.                                       FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  881.                                       FieldByName('RDB$FIELD_PRECISION').AsInteger);
  882.  
  883.  
  884.                 // first determine if the current argument is the return argument
  885.                 if FieldByName('RDB$ARGUMENT_POSITION').AsInteger =
  886.                   FieldByName('RDB$RETURN_ARGUMENT').AsInteger then
  887.                 begin
  888.  
  889.                   // determine if the argument is passed by reference or by value
  890.                   case FieldByName('RDB$MECHANISM').AsInteger of
  891.                     0 : lReturn:=Format('  RETURNS %s BY VALUE', [lStr]);
  892.                     1 : lReturn:=Format('  RETURNS %s BY REFERENCE', [lStr]);
  893.                     else
  894.                     begin
  895.                       case FieldbyName('RDB$FIELD_TYPE').AsInteger of
  896.                         261 :
  897.                           lReturn:=Format('  %s RETURNS PARAMETER %s',[lStr, Trim(FieldByName('RDB$RETURN_ARGUMENT').AsString)]);
  898.                         else
  899.                           lReturn:=Format('  RETURNS %s %s',[lStr, Trim(FieldByName('RDB$MECHANISM').AsString)]);;
  900.                       end;  // of case statement
  901.                     end;  // of else not returned by reference or by value
  902.                   end;
  903.                 end
  904.                 else
  905.                 begin
  906.                   lFirst := False;
  907.                   // if this is not the return argument then just add to script as argument
  908.                   SQLScript.Strings[SQLScript.Count - 1] :=
  909.                     SQLScript.Strings[SQLScript.Count - 1] + lStr;
  910.                 end;
  911.                 Next;        // increment the lqryGetObjDetails pointer
  912.  
  913.                 // add a comma if this is not the first argument
  914.                 if (not lFirst) and (not lqryGetObjDetails.EOF) then
  915.                   SQLScript.Strings[SQLScript.Count - 1] :=
  916.                     SQLScript.Strings[SQLScript.Count - 1] + ', ';
  917.  
  918.                 lFirst := False;
  919.               end;
  920.               // add return format and entry point to script
  921.               SQLScript.Add(lReturn);
  922.               SQLScript.Add(Format('  ENTRY_POINT "%s" MODULE_NAME "%s";',
  923.                 [Trim(FieldByName('ENTRY').AsString),
  924.                 Trim(FieldByName('RDB$MODULE_NAME').AsString)]));
  925.             end;
  926.           except
  927.             on E:EIBError do
  928.             begin
  929.               // if an exception occurs then
  930.               // return result as false
  931.               result := false;
  932.             end;
  933.           end;
  934.           SQLScript.Add(' ');
  935.           Next;                                // increment the lqryGetObjList pointer
  936.           result := true;                        // return result as true
  937.         end;
  938.         Close;
  939.       except
  940.         on E:EIBError do
  941.         begin
  942.           // if an exception occurs then catch hit and show error message
  943.           // return result as false
  944.           DisplayMsg(ERR_GET_DDL, E.Message);
  945.           result := false;
  946.         end;
  947.       end;
  948.     end;
  949.   finally
  950.     // close datasets and deallocate memory
  951.     lqryGetObjList.Close;
  952.     lqryGetObjDetails.Close;
  953.     lqryGetObjList.Free;
  954.     lqryGetObjDetails.Free;
  955.   end;
  956. end;
  957.  
  958. {****************************************************************
  959. *
  960. *  G e t D D L G e n e r a t o r s ( )
  961. *
  962. ****************************************************************
  963. *  Author: The Client Server Factory Inc.
  964. *  Date:   March 1, 1999
  965. *
  966. *  Input:  TStringList (variable)   - Gets populated with metadata for generators.
  967. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  968. *          Boolean (value)          - Specifies whether or not to include system data.
  969. *
  970. *  Return: Boolean - Indicates the success/failure of the operation
  971. *
  972. *  Description:  Retrieves metadata for all generators in the database.
  973. *
  974. *****************************************************************
  975. * Revisions:
  976. *
  977. *****************************************************************}
  978. function GetDDLGenerators(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  979.                           const SystemData: boolean; const ObjName: String): boolean;
  980. var
  981.   lSQLStr: string;
  982.   lqryGetObjList: TIBSql;
  983.   
  984. begin
  985.   // initialize
  986.   lqryGetObjList := nil;
  987.   try
  988.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  989.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  990.  
  991.     // query to get generator information
  992.     lqryGetObjList := TIBSql.Create(dmMain);
  993.     lqryGetObjList.Database := SelDatabaseNode;
  994.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  995.  
  996.     with lqryGetObjList do
  997.     begin
  998.       lSQLStr := 'SELECT RDB$GENERATOR_NAME FROM RDB$GENERATORS';
  999.  
  1000.       // if the system data menu item is selected then include system data in query
  1001.       if not SystemData then
  1002.       begin
  1003.         lSQLStr := Format('%s WHERE (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  1004.       end;
  1005.  
  1006.       if ObjName <> '' then
  1007.       begin
  1008.         if not SystemData then
  1009.           lSQLStr := Format('%s AND RDB$GENERATOR_NAME = ''%s''', [lSQLStr, ObjName])
  1010.         else
  1011.           lSQLStr := Format('%s WHERE RDB$GENERATOR_NAME = ''%s''', [lSQLStr, ObjName]);
  1012.       end;
  1013.  
  1014.       SQL.Clear;
  1015.       SQL.Add(lSQLStr);
  1016.       try
  1017.         Prepare;
  1018.         ExecQuery;
  1019.         result := false;
  1020.         while not EOF do
  1021.         begin
  1022.           // show header
  1023.           SQLScript.Add(Format('/*  Generator: %s  */',[Trim(FieldbyName('RDB$GENERATOR_NAME').AsString)]));
  1024.           SQLScript.Add(Format('CREATE GENERATOR %s;',[Trim(FieldbyName('RDB$GENERATOR_NAME').AsString)]));
  1025.           SQLScript.Add(' ');
  1026.           Next;                                // increment lqryGetObjList pointer
  1027.           // return result as true
  1028.           result := true;
  1029.         end;
  1030.         Close;
  1031.       except
  1032.         on E:EIBError do
  1033.         begin
  1034.           // if an exception occurs then catch it and show error message
  1035.           // return result as false
  1036.           DisplayMsg(ERR_GET_DDL, E.Message);
  1037.           result := false;
  1038.         end;
  1039.       end;
  1040.     end;
  1041.   finally
  1042.     // close dataset and deallocate memory
  1043.     lqryGetObjList.Close;
  1044.     lqryGetObjList.Free;
  1045.   end;
  1046. end;
  1047.  
  1048. {****************************************************************
  1049. *
  1050. *  G e t D D L I n d i c e s ( )
  1051. *
  1052. ****************************************************************
  1053. *  Author: The Client Server Factory Inc.
  1054. *  Date:   March 1, 1999
  1055. *
  1056. *  Input:  TStringList (variable)   - Gets populated with metadata for indexes.
  1057. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  1058. *          String (value)           - Specifies a table name.
  1059. *
  1060. *  Return: Boolean - Indicates the success/failure of the operation
  1061. *
  1062. *  Description:  Retrieves metadata for all indexes in a specified table.
  1063. *
  1064. *****************************************************************
  1065. * Revisions:
  1066. *
  1067. *****************************************************************}
  1068. function GetDDLIndexes(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  1069. var
  1070.   lSQLStr: string;
  1071.   lStr : string;
  1072.   lqryGetObjList : TIBSql;
  1073.   lqryGetObjDetails : TIBSql;
  1074. begin
  1075.   // initialize
  1076.   lqryGetObjList := nil;
  1077.   lqryGetObjDetails := nil;
  1078.   try
  1079.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  1080.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  1081.  
  1082.     // query to get list of indexes
  1083.     lqryGetObjList := TIBsql.Create(dmMain);
  1084.     lqryGetObjList.Database := SelDatabaseNode;
  1085.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  1086.  
  1087.     // query to get index information
  1088.     lqryGetObjDetails := TIBsql.Create(dmMain);
  1089.     lqryGetObjDetails.Database := SelDatabaseNode;
  1090.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  1091.  
  1092.     with lqryGetObjList do
  1093.     begin
  1094.       // get all index information pertaining to specific table
  1095.       lSQLStr:='SELECT RDB$INDEX_NAME, RDB$RELATION_NAME, RDB$UNIQUE_FLAG, RDB$INDEX_TYPE FROM RDB$INDICES ';
  1096.       lSQLStr:=Format('%s WHERE RDB$RELATION_NAME = ''' + TableName + ''' ORDER BY RDB$INDEX_NAME', [lSQLStr]);
  1097.       SQL.Clear;
  1098.       SQL.Add(lSQLStr);
  1099.       try
  1100.         Prepare;
  1101.         ExecQuery;
  1102.         result := false;
  1103.         while not EOF do
  1104.         begin
  1105.             lStr:='';
  1106.             // show header
  1107.             SQLScript.Add(Format('/*  Index: %s  */',[Trim(FieldbyName('RDB$INDEX_NAME').AsString)]));
  1108.  
  1109.             // if unique flag is set then add the UNIQUE token
  1110.             if FieldByName('RDB$UNIQUE_FLAG').AsInteger = 1 then
  1111.               lStr:=' UNIQUE';
  1112.  
  1113.             // determine if this index is ascending or descending
  1114.             if FieldByName('RDB$INDEX_TYPE').AsInteger = 1 then
  1115.               lStr:=lStr + ' DESCENDING'
  1116.             else
  1117.               lStr:=lStr + ' ASCENDING';
  1118.  
  1119.             // create script
  1120.             SQLScript.Add(Format('CREATE' + lStr + ' INDEX %s ON %s',
  1121.                 [Trim(FieldbyName('RDB$INDEX_NAME').AsString),
  1122.                 Trim(FieldByName('RDB$RELATION_NAME').AsString)]));
  1123.  
  1124.             // get index details
  1125.             lqryGetObjDetails.Close;
  1126.             lqryGetObjDetails.SQL.Clear;
  1127.             lqryGetObjDetails.SQL.Add('SELECT RDB$INDEX_NAME, RDB$FIELD_NAME, RDB$FIELD_POSITION');
  1128.             lqryGetObjDetails.SQL.Add(' FROM RDB$INDEX_SEGMENTS WHERE ');
  1129.             lqryGetObjDetails.SQL.Add(Format(' RDB$INDEX_NAME = ''%s'' ORDER BY RDB$FIELD_POSITION',
  1130.                 [Trim(FieldbyName('RDB$INDEX_NAME').AsString)]));
  1131.             try
  1132.               with lqryGetObjDetails do
  1133.               begin
  1134.                 Prepare;
  1135.                 ExecQuery;
  1136.                 if not EOF then
  1137.                   SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ' (';
  1138.                 while not EOF do
  1139.                 begin
  1140.                   lStr:=Trim(lqryGetObjDetails.FieldByName('RDB$FIELD_NAME').AsString);
  1141.                   SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + lStr;
  1142.                   lqryGetObjDetails.Next;        // increment lqryObjDetails pointer
  1143.  
  1144.                   // if there are more fields then add comma
  1145.                   if Not lqryGetObjDetails.EOF then
  1146.                     SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ', ';
  1147.                 end;
  1148.                 SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + '); ';
  1149.               end;
  1150.             except
  1151.               on E:EIBError do
  1152.               begin
  1153.                 // if an exception occurs then catch it
  1154.                 // return result as false
  1155.                 result := false;
  1156.               end;
  1157.             end;
  1158.  
  1159.             SQLScript.Add(' ');
  1160.             Next;                                // increment lqryGetObjList pointer
  1161.           result := true;
  1162.         end;
  1163.         Close;
  1164.       except
  1165.         on E:EIBError do
  1166.         begin
  1167.           // if an except occurs then catch it and shoe error message
  1168.           // return result as false
  1169.           DisplayMsg(ERR_GET_DDL, E.Message);
  1170.           result := false;
  1171.         end;
  1172.       end;
  1173.     end;
  1174.   finally
  1175.     // close datasets and deallocate memory
  1176.     lqryGetObjList.Close;
  1177.     lqryGetObjDetails.Close;
  1178.     lqryGetObjList.Free;
  1179.     lqryGetObjDetails.Free;
  1180.   end;
  1181. end;
  1182.  
  1183. {****************************************************************
  1184. *
  1185. *  G e t D D L P r o c e d u r e s ( )
  1186. *
  1187. ****************************************************************
  1188. *  Author: The Client Server Factory Inc.
  1189. *  Date:   March 1, 1999
  1190. *
  1191. *  Input:  TStringList (variable)   - Gets populated with metadata for procedures.
  1192. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  1193. *          Boolean (value)          - Specifies whether or not to include system data.
  1194. *
  1195. *  Return: Boolean - Indicates the success/failure of the operation
  1196. *
  1197. *  Description:  Retrieves metadata for all procedures in the database.
  1198. *
  1199. *****************************************************************
  1200. * Revisions:
  1201. *
  1202. *****************************************************************}
  1203. function GetDDLProcedures(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  1204.                           const SystemData: boolean; const ObjName: String): boolean;
  1205. var
  1206.   lStr, lSQLStr: string;
  1207.   lqryGetObjList : TIBSql;
  1208.   lqryGetObjDetails : TIBSql;
  1209. begin
  1210.   // initialize
  1211.   lqryGetObjList := nil;
  1212.   lqryGetObjDetails := nil;
  1213.   try
  1214.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  1215.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  1216.  
  1217.     // query to get list of procedures
  1218.     lqryGetObjList := TIBSql.Create(dmMain);
  1219.     lqryGetObjList.Database := SelDatabaseNode;
  1220.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  1221.  
  1222.     // query to get procedure details
  1223.     lqryGetObjDetails := TIBsql.Create(dmMain);
  1224.     lqryGetObjDetails.Database := SelDatabaseNode;
  1225.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  1226.  
  1227.     with lqryGetObjList do
  1228.     begin
  1229.       lSQLStr := 'SELECT RDB$PROCEDURE_NAME,RDB$OWNER_NAME,RDB$PROCEDURE_SOURCE FROM RDB$PROCEDURES';
  1230.  
  1231.       // if the system data menu item is selected then include system data in query
  1232.       if not SystemData then
  1233.       begin
  1234.         lSQLStr := Format('%s WHERE (RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  1235.       end;
  1236.  
  1237.       if ObjName <> '' then
  1238.       begin
  1239.         if not SystemData then
  1240.           lSQLStr := Format('%s AND RDB$PROCEDURE_NAME = ''%s''', [lSQLStr, ObjName])
  1241.         else
  1242.           lSQLStr := Format('%s WHERE RDB$PROCEDURE_NAME = ''%s''', [lSQLStr, ObjName]);
  1243.       end;
  1244.  
  1245.       lSQLStr := Format('%s ORDER BY RDB$PROCEDURE_NAME',[lSQLStr]);
  1246.       SQL.Clear;
  1247.       SQL.Add(lSQLStr);
  1248.       try
  1249.         Prepare;
  1250.         ExecQuery;
  1251.         result := false;
  1252.         if not EOF then
  1253.         begin
  1254.           // set terminator to the terminator defined in TERMINATOR constant
  1255.           SQLScript.Add(Format('SET TERM %s ;', [TERMINATOR]));
  1256.           SQLScript.Add('');
  1257.         end;
  1258.  
  1259.           // get list of procedures
  1260.           // this is the main compare loop
  1261.         while not EOF do
  1262.           begin
  1263.             // show header
  1264.             SQLScript.Add(Format('/*  Procedure %s, Owner: %s  */',[Trim(FieldbyName('RDB$PROCEDURE_NAME').AsString),
  1265.               Trim(FieldbyName('RDB$OWNER_NAME').AsString)]));
  1266.             SQLScript.Add(Format('CREATE PROCEDURE %s ',[Trim(FieldbyName('RDB$PROCEDURE_NAME').AsString)]));
  1267.  
  1268.             // get input Parameters
  1269.             lqryGetObjDetails.Close;
  1270.             lqryGetObjDetails.SQL.Clear;
  1271.             lqryGetObjDetails.SQL.Add('SELECT A.RDB$PARAMETER_NAME,B.RDB$FIELD_TYPE,B.RDB$FIELD_SCALE,B.RDB$FIELD_LENGTH');
  1272.             lqryGetObjDetails.SQL.Add('FROM RDB$PROCEDURE_PARAMETERS A, RDB$FIELDS B');
  1273.             lqryGetObjDetails.SQL.Add('WHERE A.RDB$FIELD_SOURCE = B.RDB$FIELD_NAME');
  1274.             lqryGetObjDetails.SQL.Add(Format('AND A.RDB$PROCEDURE_NAME = ''%s''',[Trim(FieldbyName('RDB$PROCEDURE_NAME').AsString)]));
  1275.             lqryGetObjDetails.SQL.Add('AND A.RDB$PARAMETER_TYPE = 0');
  1276.             lqryGetObjDetails.SQL.Add('ORDER BY A.RDB$PARAMETER_NUMBER');
  1277.             try
  1278.               with lqryGetObjDetails do
  1279.               begin
  1280.                 Prepare;
  1281.                 ExecQuery;
  1282.                 if not lqryGetObjDetails.EOF then
  1283.                   SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ' (';
  1284.  
  1285.                 while not EOF do
  1286.                 begin
  1287.                   lStr := GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  1288.                                         FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  1289.                                         FieldByName('RDB$FIELD_LENGTH').AsInteger,
  1290.                                         FieldByName('RDB$FIELD_SCALE').AsInteger,
  1291.                                         FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  1292.                                         FieldByName('RDB$FIELD_PRECISION').AsInteger);
  1293.                   SQLScript.Add(lStr+',');
  1294.                   Next;
  1295.                 end;
  1296.                 SQLScript.Strings[SQLScript.Count - 1] := Copy(SQLScript.Strings[SQLScript.Count - 1],1,Length(SQLScript.Strings[SQLScript.Count - 1]) - 1 ) + ')';
  1297.                 Close;
  1298.               end;
  1299.             except
  1300.               on E:EIBError do
  1301.               begin
  1302.                 // if an exception occurs then catch it
  1303.                 // return result as false
  1304.                 result := false;
  1305.               end;
  1306.             end;
  1307.  
  1308.             // get output parameters
  1309.             lqryGetObjDetails.Close;
  1310.             lqryGetObjDetails.SQL.Clear;
  1311.             lqryGetObjDetails.SQL.Add('SELECT A.RDB$PARAMETER_NAME,B.RDB$FIELD_TYPE,B.RDB$FIELD_SCALE,B.RDB$FIELD_LENGTH');
  1312.             lqryGetObjDetails.SQL.Add('FROM RDB$PROCEDURE_PARAMETERS A, RDB$FIELDS B');
  1313.             lqryGetObjDetails.SQL.Add('WHERE A.RDB$FIELD_SOURCE = B.RDB$FIELD_NAME');
  1314.             lqryGetObjDetails.SQL.Add(Format('AND A.RDB$PROCEDURE_NAME = ''%s''',[Trim(FieldbyName('RDB$PROCEDURE_NAME').AsString)]));
  1315.             lqryGetObjDetails.SQL.Add('AND A.RDB$PARAMETER_TYPE = 1');
  1316.             lqryGetObjDetails.SQL.Add('ORDER BY A.RDB$PARAMETER_NUMBER');
  1317.  
  1318.             try
  1319.               with lqryGetObjDetails do
  1320.               begin
  1321.                 Prepare;
  1322.                 ExecQuery;
  1323.                 if not lqryGetObjDetails.EOF then
  1324.                   SQLScript.Add('RETURNS (');
  1325.  
  1326.                 while not EOF do
  1327.                 begin
  1328.                   lStr := GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  1329.                                         FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  1330.                                         FieldByName('RDB$FIELD_LENGTH').AsInteger,
  1331.                                         FieldByName('RDB$FIELD_SCALE').AsInteger,
  1332.                                         FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  1333.                                         FieldByName('RDB$FIELD_PRECISION').AsInteger);
  1334.                   SQLScript.Add(lStr+',');
  1335.                   Next;
  1336.                 end;
  1337.                 SQLScript.Strings[SQLScript.Count - 1] := Copy(SQLScript.Strings[SQLScript.Count - 1],1,Length(SQLScript.Strings[SQLScript.Count - 1]) - 1 ) + ')';
  1338.                 Close;
  1339.               end;
  1340.             except
  1341.               on E:EIBError do
  1342.               begin
  1343.                 // if an exception occurs then catch it
  1344.                 // return result as false
  1345.                 result := false;
  1346.               end;
  1347.             end;
  1348.             SQLScript.Add(Format('AS %s',[Trim(FieldbyName('RDB$PROCEDURE_SOURCE').AsString)]));
  1349.             Next;                                // increment the lqryGetObjList pointer
  1350.             SQLScript.Strings[SQLScript.Count - 1] :=
  1351.               SQLScript.Strings[SQLScript.Count - 1] + TERMINATOR;
  1352.             SQLScript.Add(' ');                  // add new terminator to end of procedure definition
  1353.           // reset the terminator
  1354.           SQLScript.Add(Format('COMMIT WORK%s', [TERMINATOR]));
  1355.           SQLScript.Add(Format('SET TERM ; %s', [TERMINATOR]));
  1356.           result := true;
  1357.         end;
  1358.         Close;
  1359.       except
  1360.         on E:EIBError do
  1361.         begin
  1362.           // if an exception occurs then catch it and display error message
  1363.           // return result as false
  1364.           DisplayMsg(ERR_GET_DDL, E.Message);
  1365.           result := false;
  1366.         end;
  1367.       end;
  1368.     end;
  1369.   finally
  1370.     // close datasets and deallocate memory
  1371.     lqryGetObjList.Close;
  1372.     lqryGetObjDetails.Close;
  1373.     lqryGetObjList.Free;
  1374.     lqryGetObjDetails.Free;
  1375.   end;
  1376. end;
  1377.  
  1378. {****************************************************************
  1379. *
  1380. *  G e t D D L R e f e r e n t i a l C o n s t ( )
  1381. *
  1382. ****************************************************************
  1383. *  Author: The Client Server Factory Inc.
  1384. *  Date:   March 1, 1999
  1385. *
  1386. *  Input:  TStringList (variable)   - Gets populated with metadata for referential constraints.
  1387. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  1388. *          String (value)           - Specifies a table name.
  1389. *
  1390. *  Return: Boolean - Indicates the success/failure of the operation
  1391. *
  1392. *  Description:  Retrieves metadata for all referential constraints in a specified table.
  1393. *
  1394. *****************************************************************
  1395. * Revisions:
  1396. *
  1397. *****************************************************************}
  1398. function GetDDLReferentialConst(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  1399. var
  1400.   lSQLStr: string;
  1401.   lStr: string;
  1402.   lqryGetObjList : TIBSql;
  1403.   lqryGetObjDetails : TIBSql;
  1404. begin
  1405.   // initialize
  1406.   lqryGetObjList := nil;
  1407.   lqryGetObjDetails := nil;
  1408.   try
  1409.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  1410.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  1411.  
  1412.     // query to get referential constraints
  1413.     lqryGetObjList := TIBSql.Create(dmMain);
  1414.     lqryGetObjList.Database := SelDatabaseNode;
  1415.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  1416.  
  1417.     // query to get child and parent columns that are
  1418.     // part of the referential constraint
  1419.     lqryGetObjDetails := TIBSql.Create(dmMain);
  1420.     lqryGetObjDetails.Database := SelDatabaseNode;
  1421.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  1422.  
  1423.     try
  1424.       // get columns that are part of the referential constraint
  1425.       lqryGetObjDetails.Close;
  1426.       lqryGetObjDetails.SQL.Clear;
  1427.       lqryGetObjDetails.SQL.Add('SELECT RDB$INDEX_NAME, RDB$FIELD_NAME,');
  1428.       lqryGetObjDetails.SQL.Add('RDB$FIELD_POSITION FROM RDB$INDEX_SEGMENTS');
  1429.       lqryGetObjDetails.SQL.Add('ORDER BY RDB$INDEX_NAME, RDB$FIELD_POSITION');
  1430.       lqryGetObjDetails.Prepare;
  1431.       lqryGetObjDetails.ExecQuery;
  1432.     except
  1433.       on E:EIBError do
  1434.       begin
  1435.         // if an exception occurs then catch it and show error message
  1436.         // return result as false
  1437.         DisplayMsg(ERR_GET_DDL, E.Message);
  1438.         result := false;
  1439.       end;
  1440.     end;
  1441.  
  1442.     with lqryGetObjList do
  1443.     begin
  1444.       // get list of referential constraints pertaining to a specific table
  1445.       lSQLStr:='SELECT A.RDB$CONSTRAINT_NAME, A.RDB$CONSTRAINT_TYPE, A.RDB$RELATION_NAME,';
  1446.       lSQLStr:=Format('%s A.RDB$INDEX_NAME, B.RDB$INDEX_NAME, B.RDB$RELATION_NAME,', [lSQLStr]);
  1447.       lSQLStr:=Format('%s B.RDB$FOREIGN_KEY, C.RDB$FOREIGN_KEY, C.RDB$RELATION_NAME PARENT', [lSQLStr]);
  1448.       lSQLStr:=Format('%s FROM RDB$RELATION_CONSTRAINTS A, RDB$INDICES B, RDB$INDICES C', [lSQLStr]);
  1449.       lSQLStr:=Format('%s WHERE A.RDB$RELATION_NAME=''%s'' AND', [lSQLStr, TableName]);
  1450.       lSQLStr:=Format('%s B.RDB$RELATION_NAME=''%s'' AND', [lSQLStr, TableName]);
  1451.       lSQLStr:=Format('%s A.RDB$CONSTRAINT_TYPE=''FOREIGN KEY'' AND', [lSQLStr]);
  1452.       lSQLStr:=Format('%s B.RDB$FOREIGN_KEY = C.RDB$INDEX_NAME AND', [lSQLStr]);
  1453.       lSQLStr:=Format('%s A.RDB$INDEX_NAME=B.RDB$INDEX_NAME', [lSQLStr]);
  1454.       lSQLStr:=Format('%s ORDER BY A.RDB$CONSTRAINT_NAME', [lSQLStr]);
  1455.       SQL.Clear;
  1456.       SQL.Add(lSQLStr);
  1457.       try
  1458.         Prepare;
  1459.         ExecQuery;
  1460.         result := false;
  1461.         while not EOF do
  1462.         begin
  1463.           SQLScript.Add(Format('/*  Foreign Key: %s  */',[Trim(FieldbyName('RDB$CONSTRAINT_NAME').AsString)]));
  1464.           SQLScript.Add(Format('ALTER TABLE %s ',[Trim(FieldbyName('RDB$RELATION_NAME').AsString)]));
  1465.           SQLScript.Add(Format('  ADD CONSTRAINT %s',[Trim(FieldbyName('RDB$CONSTRAINT_NAME').AsString)]));
  1466.           SQLScript.Add('  FOREIGN KEY');
  1467.           lStr:='';
  1468.           try
  1469.             // get child columns
  1470.             lqryGetObjDetails.ExecQuery;
  1471.  
  1472.             // increment pointer to first child column in referential constaint
  1473.             while (not lqryGetObjDetails.EOF) and
  1474.               (Trim(FieldByName('RDB$INDEX_NAME').AsString) <> Trim(lqryGetObjDetails.FieldByName('RDB$INDEX_NAME').AsString)) do
  1475.               lqryGetObjDetails.Next;
  1476.  
  1477.             // determine whether or not at end of dataset
  1478.             if not lqryGetObjDetails.EOF then
  1479.               SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + '(';
  1480.  
  1481.             // loop though list of constraint details
  1482.             while (not lqryGetObjDetails.EOF) and
  1483.               (Trim(FieldByName('RDB$INDEX_NAME').AsString) = Trim(lqryGetObjDetails.FieldByName('RDB$INDEX_NAME').AsString)) do
  1484.             begin
  1485.               // store first child column
  1486.               lStr:=Trim(lqryGetObjDetails.FieldByName('RDB$FIELD_NAME').AsString);
  1487.  
  1488.               lqryGetObjDetails.Next;          // increment lqryGetObjDetails pointer
  1489.  
  1490.               // add child column to script
  1491.               SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + lStr;
  1492.  
  1493.               // if there are more child columns then add a comma between them
  1494.               if (not lqryGetObjDetails.EOF) and
  1495.                 (Trim(FieldByName('RDB$INDEX_NAME').AsString) = Trim(lqryGetObjDetails.FieldByName('RDB$INDEX_NAME').AsString))
  1496.                 then
  1497.                 SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ', ';
  1498.             end;
  1499.             SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ') ';
  1500.             SQLScript.Add(Format('  REFERENCES %s', [Trim(FieldByName('PARENT').AsString)]));
  1501.  
  1502.             // Get parent columns
  1503.             lqryGetObjDetails.ExecQuery;
  1504.             // increment pointer to first parent column in referential constaint
  1505.             while (not lqryGetObjDetails.EOF) and
  1506.               (Trim(FieldByName('RDB$FOREIGN_KEY').AsString) <> Trim(lqryGetObjDetails.FieldByName('RDB$INDEX_NAME').AsString)) do
  1507.               lqryGetObjDetails.Next;
  1508.  
  1509.             // determine whether or not at end of dataset
  1510.             if not lqryGetObjDetails.EOF then
  1511.               SQLScript[SQLScript.Count - 1] := SQLScript[SQLScript.Count - 1] + '(';
  1512.  
  1513.             // loop though list of constraint details
  1514.             while (not lqryGetObjDetails.EOF) and
  1515.               (Trim(FieldByName('RDB$FOREIGN_KEY').AsString) = Trim(lqryGetObjDetails.FieldByName('RDB$INDEX_NAME').AsString)) do
  1516.             begin
  1517.               // store first parent column
  1518.               lStr:=Trim(lqryGetObjDetails.FieldByName('RDB$FIELD_NAME').AsString);
  1519.  
  1520.               lqryGetObjDetails.Next;          // increment lqryGetObjDetails pointer
  1521.  
  1522.               // add parent column to script
  1523.               SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + lStr;
  1524.  
  1525.               // if there are more parent columns then add a comma between them
  1526.               if (not lqryGetObjDetails.EOF) and
  1527.                 (Trim(FieldByName('RDB$FOREIGN_KEY').AsString) = Trim(lqryGetObjDetails.FieldByName('RDB$INDEX_NAME').AsString))
  1528.                 then
  1529.                 SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ', ';
  1530.  
  1531.             end;
  1532.             SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ');';
  1533.           except
  1534.             on E:EIBError do
  1535.             begin
  1536.               // if an exception occurs then catch it
  1537.               // return result as false
  1538.               result := false;
  1539.             end;
  1540.           end;
  1541.  
  1542.           SQLScript.Add(' ');
  1543.           Next;                                // increment lqryGetObjList pointer
  1544.           result := true;
  1545.         end;
  1546.         Close;
  1547.       except
  1548.         on E:EIBError do
  1549.         begin
  1550.           // if an exception occurs then catch it and show error message
  1551.           // return result as false
  1552.           DisplayMsg(ERR_GET_DDL, E.Message);
  1553.           result := false;
  1554.         end;
  1555.       end;
  1556.     end;
  1557.   finally
  1558.     // close datasets and deallocate memory
  1559.     lqryGetObjList.Close;
  1560.     lqryGetObjDetails.Close;
  1561.     lqryGetObjList.Free;
  1562.     lqryGetObjDetails.Free;
  1563.   end;
  1564. end;
  1565.  
  1566. {****************************************************************
  1567. *
  1568. *  G e t D D L D D L R o l e s ( )
  1569. *
  1570. ****************************************************************
  1571. *  Author: The Client Server Factory Inc.
  1572. *  Date:   March 1, 1999
  1573. *
  1574. *  Input:  TStringList (variable)   - Gets populated with metadata for roles.
  1575. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  1576. *          Boolean (value)          - Specifies whether or not to include system data.
  1577. *
  1578. *  Return: Boolean - Indicates the success/failure of the operation
  1579. *
  1580. *  Description:  Retrieves metadata for all roles in the database.
  1581. *
  1582. *****************************************************************
  1583. * Revisions:
  1584. *
  1585. *****************************************************************}
  1586. function GetDDLRoles(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  1587.                      const SystemData: boolean; const ObjName: String): boolean;
  1588. var
  1589.   lSQLStr: String;
  1590.   lqryGetObjList: TIBSql;
  1591.   lqryGetObjDetails: TIBSql;
  1592.   lTableName : String;
  1593.   lUserName : String;
  1594.   lGrantOption : Integer;
  1595.   lStr : String;
  1596.  
  1597. begin
  1598.   // initialize
  1599.   lqryGetObjList := nil;
  1600.   lqryGetObjDetails := nil;
  1601.   try
  1602.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  1603.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  1604.  
  1605.     // query to get list of roles
  1606.     lqryGetObjList := TIBSql.Create(dmMain);
  1607.     lqryGetObjList.Database := SelDatabaseNode;
  1608.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  1609.  
  1610.     // query to get array information
  1611.     lqryGetObjDetails := TIBSql.Create(dmMain);
  1612.     lqryGetObjDetails.Database := SelDatabaseNode;
  1613.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  1614.  
  1615.     with lqryGetObjList do
  1616.     begin
  1617.       lSQLStr := 'SELECT RDB$ROLE_NAME,RDB$OWNER_NAME';
  1618.       lSQLStr := Format('%s FROM RDB$ROLES',[lSQLStr]);
  1619.  
  1620.       if ObjName <> '' then
  1621.           lSQLStr := Format('%s WHERE RDB$ROLE_NAME = ''%s''', [lSQLStr, ObjName]);
  1622.  
  1623.       lSQLStr := Format('%s ORDER BY RDB$OWNER_NAME, RDB$ROLE_NAME',[lSQLStr]);
  1624.       SQL.Clear;
  1625.       SQL.Add(lSQLStr);
  1626.       try
  1627.         Prepare;
  1628.         ExecQuery;
  1629.         result := false;
  1630.         while not EOF do
  1631.         begin
  1632.           SQLScript.Add(Format('/*  Role: %s, Owner: %s  */',[Trim(FieldbyName('RDB$ROLE_NAME').AsString),
  1633.             Trim(FieldbyName('RDB$OWNER_NAME').AsString)]));
  1634.           SQLScript.Add(Format('CREATE ROLE %s;',[Trim(FieldbyName('RDB$ROLE_NAME').AsString)]));
  1635.           SQLScript.Add('');
  1636.  
  1637.           lqryGetObjDetails.SQL.Clear;
  1638.           lqryGetObjDetails.SQL.Add('SELECT * FROM RDB$USER_PRIVILEGES');
  1639.           lqryGetObjDetails.SQL.Add('WHERE RDB$RELATION_NAME NOT LIKE ''RDB$%''');
  1640.           lqryGetObjDetails.SQL.Add('AND RDB$USER <> ''SYSDBA'' AND RDB$USER <> RDB$GRANTOR');
  1641.           lqryGetObjDetails.SQL.Add(Format('AND RDB$USER = ''%s''', [Trim(FieldbyName('RDB$ROLE_NAME').AsString)]));
  1642.           lqryGetObjDetails.SQL.Add('ORDER BY RDB$OBJECT_TYPE, RDB$RELATION_NAME, RDB$USER, RDB$PRIVILEGE');
  1643.  
  1644.           try
  1645.             lqryGetObjDetails.Prepare;
  1646.             lqryGetObjDetails.ExecQuery;
  1647.  
  1648.             if not lqryGetObjDetails.EOF then
  1649.             begin
  1650.               lStr:='';
  1651.               SQLScript.Add(Format('/*  SQL Privileges for Role %s  */', [Trim(FieldbyName('RDB$ROLE_NAME').AsString)]));
  1652.             end;
  1653.  
  1654.             while not lqryGetObjDetails.EOF do
  1655.             begin
  1656.             // determine the privilege
  1657.               if Trim(lqryGetObjDetails.FieldByName('RDB$PRIVILEGE').AsString) = 'X' then
  1658.               begin
  1659.                 lStr:='EXECUTE';
  1660.                 SQLScript.Add(Format('GRANT EXECUTE ON PROCEDURE %s TO %s;',
  1661.                   [Trim(lqryGetObjDetails.FieldByName('RDB$RELATION_NAME').AsString),
  1662.                   Trim(lqryGetObjDetails.FieldByName('RDB$USER').AsString)]));
  1663.                 lStr:='';
  1664.                 Continue;
  1665.               end;
  1666.  
  1667.               if Trim(lqryGetObjDetails.FieldByName('RDB$PRIVILEGE').AsString) = 'D' then
  1668.                 lStr:=lStr + 'DELETE'
  1669.               else if Trim(lqryGetObjDetails.FieldByName('RDB$PRIVILEGE').AsString) = 'S' then
  1670.                 lStr:=lStr + 'SELECT'
  1671.               else if Trim(lqryGetObjDetails.FieldByName('RDB$PRIVILEGE').AsString) = 'U' then
  1672.                 lStr:=lStr + 'UPDATE'
  1673.               else if Trim(lqryGetObjDetails.FieldByName('RDB$PRIVILEGE').AsString) = 'I' then
  1674.                 lStr:=lStr + 'INSERT'
  1675.               else if Trim(lqryGetObjDetails.FieldByName('RDB$PRIVILEGE').AsString) = 'R' then
  1676.                 lStr:=lStr + 'REFERENCES';
  1677.  
  1678.               // store tablename, username, grant options and object type
  1679.               lTableName:=Trim(lqryGetObjDetails.FieldByName('RDB$RELATION_NAME').AsString);
  1680.               lUserName:=Trim(lqryGetObjDetails.FieldByName('RDB$USER').AsString);
  1681.               lGrantOption:=lqryGetObjDetails.FieldByName('RDB$GRANT_OPTION').AsInteger;
  1682.               // lObjectType:=lqryGetObjDetails.FieldByName('RDB$OBJECT_TYPE').AsInteger;
  1683.  
  1684.               lqryGetObjDetails.Next;                                // increment lqryGetObjList
  1685.  
  1686.               if (lStr <> '') and
  1687.                 ((lTableName <> Trim(lqryGetObjDetails.FieldByName('RDB$RELATION_NAME').AsString))
  1688.                 or (lqryGetObjDetails.Eof)) then
  1689.               begin
  1690.                 if lStr <> '' then
  1691.                   lStr:=lStr + ' ON ';
  1692.  
  1693.                 // determine grant option
  1694.                 SQLScript.Add(Format('GRANT %s%s TO %s', [lStr, lTableName, lUserName]));
  1695.                 case lGrantOption of
  1696.                   0 : SQLScript[SQLScript.Count - 1] := SQLScript[SQLScript.Count - 1] + ';';
  1697.                   1 : SQLScript[SQLScript.Count - 1] := SQLScript[SQLScript.Count - 1] + ' WITH GRANT OPTION;';
  1698.                   2 : SQLScript[SQLScript.Count - 1] := SQLScript[SQLScript.Count - 1] + ' WITH ADMIN OPTION;';
  1699.                 end;
  1700.                 lStr:='';
  1701.               end;
  1702.  
  1703.               // add comma between privileges
  1704.               if lStr <> '' then
  1705.                 lStr:=lStr + ', ';
  1706.             end;
  1707.           except
  1708.             on E:EIBError do
  1709.             begin
  1710.               // if an exception occurs then catch it and show error message
  1711.               // return result as false
  1712.               DisplayMsg(ERR_GET_DDL, E.Message);
  1713.               result := false;
  1714.             end;
  1715.           end;
  1716.           Next;                                // increment lqryGetObjList pointer
  1717.           result := true;
  1718.         end;
  1719.         Close;
  1720.       except
  1721.         on E:EIBError do
  1722.         begin
  1723.           // if an exception occurs then catch it and show error message
  1724.           // return result as false
  1725.           DisplayMsg(ERR_GET_DDL, E.Message);
  1726.           result := false;
  1727.         end;
  1728.       end;
  1729.     end;
  1730.   finally
  1731.     // close dataset and deallocate memory
  1732.     lqryGetObjList.Close;
  1733.     lqryGetObjDetails.Close;
  1734.     lqryGetObjList.Free;
  1735.     lqryGetObjDetails.Free;
  1736.   end;
  1737. end;
  1738.  
  1739. {****************************************************************
  1740. *
  1741. *  G e t D D L T a b l e ( )
  1742. *
  1743. ****************************************************************
  1744. *  Author: The Client Server Factory Inc.
  1745. *  Date:   March 1, 1999
  1746. *
  1747. *  Input:  TStringList (variable)   - Gets populated with metadata for one table.
  1748. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  1749. *          String (value)           - Specifies a table name.
  1750. *
  1751. *  Return: Boolean - Indicates the success/failure of the operation
  1752. *
  1753. *  Description:  Retrieves metadata for a specified table.
  1754. *
  1755. *****************************************************************
  1756. * Revisions:
  1757. *
  1758. *****************************************************************}
  1759. function GetDDLTable(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  1760. var
  1761.   lQry: TIBSql;
  1762.   lSQLStr: string;
  1763.   lCnt: integer;
  1764.   lDomains: TStringList;
  1765. begin
  1766.   lDomains := TStringList.Create;
  1767.   GetDDLDomains (lDomains, SelDatabaseNode, False, TableName);
  1768.  
  1769.   try
  1770.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  1771.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  1772.  
  1773.     lQry := TIBSQL.Create (dmMain);
  1774.  
  1775.     // show header
  1776.     SQLScript.Add(Format('/*  Extract Table %s  */', [TableName]));
  1777.     SQLScript.Add('');
  1778.     SQLScript.Add('/*  Domain Definitions  */');
  1779.     SQLSCript.Add('');
  1780.     for lCnt := 0 to lDomains.Count-1 do
  1781.       SQLSCript.Add (lDomains.Strings[lCnt]);
  1782.  
  1783.     SQLScript.Add('');
  1784.  
  1785.     // extract column information
  1786.     with lQry do
  1787.     begin
  1788.       lQry.Transaction := SeldatabaseNode.DefaultTransaction;
  1789.       lQry.Database := SeldatabaseNode;
  1790.  
  1791.       lSQLStr := 'SELECT RDB$RELATION_NAME,RDB$OWNER_NAME,RDB$DESCRIPTION FROM RDB$RELATIONS';
  1792.       lSQLStr := Format('%s WHERE RDB$RELATION_NAME NOT IN (',[lSQLStr]);
  1793.       lSQLStr := Format('%s SELECT RDB$VIEW_NAME FROM RDB$VIEW_RELATIONS)',[lSQLStr]);
  1794.  
  1795.       lQry.SQL.Add (lSQlStr);
  1796.  
  1797.       Prepare;
  1798.       ExecQuery;
  1799.       // show header
  1800.       SQLScript.Add(Format('/*  Table: %s, Owner: %s  */',[TableName, Trim(FieldByName('RDB$OWNER_NAME').AsString)]));
  1801.       SQLScript.Add(Format('CREATE TABLE %s ',[TableName]));
  1802.       SQLScript.Add('(');
  1803.       Close;
  1804.       Free;
  1805.     end;
  1806.     GetDDLColumns (SQLScript, SelDatabaseNode, TableName);
  1807.   finally
  1808.     lDomains.Free;
  1809.   end;
  1810. end;
  1811.  
  1812. {****************************************************************
  1813. *
  1814. *  G e t D D L T a b l e s ( )
  1815. *
  1816. ****************************************************************
  1817. *  Author: The Client Server Factory Inc.
  1818. *  Date:   March 1, 1999
  1819. *
  1820. *  Input:  TStringList (variable)   - Gets populated with metadata for tables.
  1821. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  1822. *          Boolean (value)          - Specifies whether or not to include system data.
  1823. *
  1824. *  Return: Boolean - Indicates the success/failure of the operation
  1825. *
  1826. *  Description:  Retrieves metadata for all tables in the database.
  1827. *
  1828. *****************************************************************
  1829. * Revisions:
  1830. *
  1831. *****************************************************************}
  1832. function GetDDLTables(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): boolean;
  1833. var
  1834.   lSQLStr : string;
  1835.   lStr : string;
  1836.   lTok : string;                                 // token to search for when filtering out domains
  1837.   lTableName : string;                           // stores previous tablename
  1838.   lLastTable : string;
  1839.   lUsername : string;
  1840.   lGrantOption : Integer;
  1841.   lObjectType : Integer;
  1842.   lHeader : Boolean;                             // specifies whether or not to print a section header
  1843.   lDuplicates : TStringList;                     // stores duplicate domain entries
  1844.   lqryGetObjList : TIBSql;
  1845.   lqryGetObjDetails : TIBSql;
  1846.   lqryGetObjDimensions : TIBSql;
  1847.   lqryGetObjIndexes : TIBSql;
  1848.   lqryGetObjPrimary : TIBSql;
  1849. begin
  1850.   // initialize
  1851.   lqryGetObjList := nil;
  1852.   lqryGetObjDimensions := nil;
  1853.   lqryGetObjIndexes := nil;
  1854.   lqryGetObjPrimary := nil;
  1855.   lqryGetObjDetails := nil;
  1856.   lDuplicates := nil;
  1857.   try
  1858.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  1859.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  1860.  
  1861.     // stringlist to store duplicate domains
  1862.     lDuplicates:=TStringList.Create;
  1863.     lDuplicates.Clear;
  1864.  
  1865.     // query to get list of tables
  1866.     lqryGetObjList := TIBSql.Create(dmMain);
  1867.     lqryGetObjList.Database := SelDatabaseNode;
  1868.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  1869.  
  1870.     // query to get array dimensions
  1871.     lqryGetObjDimensions := TIBSql.Create(dmMain);
  1872.     lqryGetObjDimensions.Database := SelDatabaseNode;
  1873.     lqryGetObjDimensions.Transaction := SelDatabaseNode.DefaultTransaction;
  1874.  
  1875.     // query to get a list of indexes
  1876.     lqryGetObjIndexes := TIBSql.Create(dmMain);
  1877.     lqryGetObjIndexes.Database := SelDatabaseNode;
  1878.     lqryGetObjIndexes.Transaction := SelDatabaseNode.DefaultTransaction;
  1879.  
  1880.     // query to get primary key information
  1881.     lqryGetObjPrimary := TIBSql.Create(dmMain);
  1882.     lqryGetObjPrimary.Database := SelDatabaseNode;
  1883.     lqryGetObjPrimary.Transaction := SelDatabaseNode.DefaultTransaction;
  1884.  
  1885.     // query to get sql priviliges
  1886.     lqryGetObjDetails := TIBSql.Create(dmMain);
  1887.     lqryGetObjDetails.Database := SelDatabaseNode;
  1888.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  1889.  
  1890.     try
  1891.       // get a list of fields/domains
  1892.       lqryGetObjDimensions.SQL.Clear;
  1893.       lqryGetObjDimensions.SQL.Add('SELECT RDB$FIELD_NAME, RDB$DIMENSION, RDB$LOWER_BOUND, ');
  1894.       lqryGetObjDimensions.SQL.Add('RDB$UPPER_BOUND FROM RDB$FIELD_DIMENSIONS');
  1895.       lqryGetObjDimensions.SQL.ADD('ORDER BY RDB$FIELD_NAME, RDB$DIMENSION');
  1896.       lqryGetObjDimensions.Prepare;
  1897.       lqryGetObjDimensions.ExecQuery;
  1898.  
  1899.       // get a list of indexes
  1900.       lqryGetObjIndexes.SQL.Clear;
  1901.       lqryGetObjIndexes.SQL.Add('SELECT A.RDB$CONSTRAINT_NAME, A.RDB$RELATION_NAME, A.RDB$CONSTRAINT_TYPE,');
  1902.       lqryGetObjIndexes.SQL.Add('A.RDB$INDEX_NAME, B.RDB$INDEX_NAME, B.RDB$FIELD_NAME, B.RDB$FIELD_POSITION');
  1903.       lqryGetObjIndexes.SQL.Add('FROM RDB$RELATION_CONSTRAINTS A, RDB$INDEX_SEGMENTS B');
  1904.       lqryGetObjIndexes.SQL.Add('WHERE A.RDB$INDEX_NAME = B.RDB$INDEX_NAME AND');
  1905.       lqryGetObjIndexes.SQL.Add('A.RDB$CONSTRAINT_TYPE = ''UNIQUE''');
  1906.       lqryGetObjIndexes.SQL.Add('ORDER BY A.RDB$RELATION_NAME, B.RDB$FIELD_POSITION');
  1907.       lqryGetObjIndexes.Prepare;
  1908.       lqryGetObjIndexes.Execquery;
  1909.  
  1910.       // get a list of primary key columns
  1911.       lqryGetObjPrimary.SQL.Clear;
  1912.       lqryGetObjPrimary.SQL.Add('SELECT A.RDB$RELATION_NAME, A.RDB$CONSTRAINT_TYPE, A.RDB$INDEX_NAME,');
  1913.       lqryGetObjPrimary.SQL.Add('B.RDB$INDEX_NAME, B.RDB$FIELD_NAME, B.RDB$FIELD_POSITION');
  1914.       lqryGetObjPrimary.SQL.Add('FROM RDB$RELATION_CONSTRAINTS A, RDB$INDEX_SEGMENTS B');
  1915.       lqryGetObjPrimary.SQL.Add('WHERE A.RDB$INDEX_NAME = B.RDB$INDEX_NAME AND');
  1916.       lqryGetObjPrimary.SQL.Add('A.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''');
  1917.       lqryGetObjPrimary.SQL.Add('ORDER BY A.RDB$RELATION_NAME, B.RDB$FIELD_POSITION');
  1918.       lqryGetObjPrimary.Prepare;
  1919.       lqryGetObjPrimary.ExecQuery;
  1920.  
  1921.       // get a list of sql prviliges
  1922.       lqryGetObjDetails.SQL.Clear;
  1923.       lqryGetObjDetails.SQL.Add('SELECT * FROM RDB$USER_PRIVILEGES');
  1924.       lqryGetObjDetails.SQL.Add('WHERE RDB$RELATION_NAME NOT LIKE ''RDB$%''');
  1925.       lqryGetObjDetails.SQL.Add('AND RDB$USER <> ''SYSDBA'' AND RDB$USER <> RDB$GRANTOR');
  1926.       lqryGetObjDetails.SQL.Add('AND RDB$OBJECT_TYPE = 0');
  1927.       lqryGetObjDetails.SQL.Add('ORDER BY RDB$OBJECT_TYPE, RDB$RELATION_NAME, RDB$USER, RDB$PRIVILEGE');
  1928.       lqryGetObjDetails.Prepare;
  1929.       lqryGetObjDetails.ExecQuery;
  1930.     except
  1931.       on E:EIBError do
  1932.       begin
  1933.         DisplayMsg(ERR_GET_DDL, E.Message);
  1934.         result := false;
  1935.       end;
  1936.     end;
  1937.  
  1938.     // determine which domains must be created before the table
  1939.     with lqryGetObjList do
  1940.     begin
  1941.       // get list of tables and their columns
  1942.       lSQLStr:='SELECT A.RDB$FIELD_NAME, A.RDB$RELATION_NAME, A.RDB$NULL_FLAG NOTNULL, A.RDB$FIELD_POSITION,';
  1943.       lSQLStr:=Format('%s A.RDB$DEFAULT_SOURCE DEF, A.RDB$FIELD_SOURCE, B.RDB$FIELD_NAME, B.RDB$NULL_FLAG DOMNULL,', [lSQLStr]);
  1944.       lSQLStr:=FOrmat('%s B.RDB$DIMENSIONS, B.RDB$FIELD_TYPE, B.RDB$VALIDATION_SOURCE,', [lSQLStr]);
  1945.       lSQLStr:=Format('%s B.RDB$FIELD_SUB_TYPE, B.RDB$SEGMENT_LENGTH, B.RDB$COMPUTED_SOURCE,', [lSQLStr]);
  1946.       lSQLStr:=Format('%s B.RDB$FIELD_LENGTH, B.RDB$FIELD_SCALE, C.RDB$OWNER_NAME', [lSQLStr]);
  1947.       lSQLStr:=Format('%s FROM RDB$RELATION_FIELDS A, RDB$FIELDS B, RDB$RELATIONS C WHERE', [lSQLStr]);
  1948.  
  1949.       // check whether or not to include system data
  1950.       if not SystemData then
  1951.       begin
  1952.         lSQLStr:=Format('%s B.RDB$SYSTEM_FLAG <> 1 AND', [lSQLStr]);
  1953.         SQLScript.Add('/*  Extract All Tables (Not Including System Tables)  */');
  1954.         lTok:='RDB$';                            // prefix signifies an InterBase created domain
  1955.       end
  1956.       else
  1957.       begin
  1958.         SQLScript.Add('/*  Extract All Tables (Including System Tables)  */');
  1959.         lTok:='';
  1960.       end;
  1961.  
  1962.       lSQLStr:=Format('%s A.RDB$FIELD_SOURCE = B.RDB$FIELD_NAME AND', [lSQLStr]);
  1963.       lSQLStr:=Format('%s A.RDB$RELATION_NAME = C.RDB$RELATION_NAME', [lSQLStr]);
  1964.       lSQLStr:=Format('%s AND C.RDB$VIEW_SOURCE IS NULL', [lSQLStr]);
  1965.       lSQLStr := Format('%s ORDER BY A.RDB$RELATION_NAME, RDB$FIELD_POSITION', [lSQLStr]);
  1966.       SQL.Clear;
  1967.       SQL.Add(lSQLStr);
  1968.       try
  1969.         // open dataset and place cursor at the beginning
  1970.         Prepare;
  1971.         ExecQuery;
  1972.         lHeader:=False;
  1973.         while not EOF do
  1974.         begin
  1975.           // loop through list of domains, if lTok = 'RDB$' then do not show system data
  1976.           if StrPos(PChar(FieldByName('RDB$FIELD_SOURCE').AsString), PChar(lTok)) = Nil then
  1977.           begin
  1978.             // if lHeader is false then add the Domain Definitions header to script
  1979.             if not lHeader then
  1980.             begin
  1981.               lHeader:=True;
  1982.               SQLScript.Add('/*  Domain Definitions  */');
  1983.             end;
  1984.  
  1985.             // check if this domain has already been acknowledged - if not then add to script
  1986.             // duplicate domains will be added to the lDuplicates stringlist
  1987.             if lDuplicates.IndexOf(Trim(FieldbyName('RDB$FIELD_SOURCE').AsString)) = -1 then
  1988.             begin
  1989.               SQLScript.Add(Format('CREATE DOMAIN %s AS ',[Trim(FieldbyName('RDB$FIELD_SOURCE').AsString)]));
  1990.               GetDDLDomains (SQLScript, SeldatabaseNode, SystemData, Trim(FieldbyName('RDB$FIELD_SOURCE').AsString);
  1991.               lDuplicates.Add(Trim(FieldByName('RDB$FIELD_SOURCE').AsString));
  1992.             end;
  1993.           end;
  1994.           Next;                                  // increment lqryGetObjList pointer
  1995.         end;
  1996.         // return result as true
  1997.         Result:=True;
  1998.       except
  1999.         on E:EIBError do
  2000.         begin
  2001.           // if an exception occurs catch it and display error message
  2002.           // return result as false
  2003.           DisplayMsg(ERR_GET_DDL, E.Message);
  2004.           result := false;
  2005.         end;
  2006.       end;
  2007.     end;
  2008.  
  2009.     // extract column information
  2010.     with lqryGetObjList do
  2011.     begin
  2012.       try
  2013.         SQLScript.Add('');
  2014.         if not EOF then
  2015.         begin
  2016.           SQLScript.Add(Format('/*  Table: %s, Owner: %s  */',[Trim(FieldByName('RDB$RELATION_NAME').AsString), Trim(FieldByName('RDB$OWNER_NAME').AsString)]));
  2017.           SQLScript.Add(Format('CREATE TABLE %s ',[Trim(FieldByName('RDB$RELATION_NAME').AsString)]));
  2018.           SQLScript.Add('(');
  2019.           SQLScript.Add('  ');
  2020.           // store current table name
  2021.           lLastTable:=Trim(FieldByName('RDB$RELATION_NAME').AsString);
  2022.           while not EOF do
  2023.           begin
  2024.           GetDDLColumns (SqlScript, SeldatabaseNode, lLastTable);
  2025.  
  2026.           // loop through list of tables and columns
  2027.           repeat
  2028.           begin
  2029.             Next;                                // increment lqryGetObjList pointer
  2030.  
  2031.             // start getting index information once all field type data has
  2032.             // been extracted for the specific table
  2033.             if (lLastTable <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) and (not EOF) then
  2034.             begin
  2035.               // extract unique index information
  2036.               with lqryGetObjIndexes do
  2037.               begin
  2038.                 try
  2039.                   First;
  2040.  
  2041.                   // advance pointer to first index associated with the current table
  2042.                   while (not EOF) and (lLastTable <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2043.                     Next;
  2044.  
  2045.                   // if an index associated with the current table is found then add to script
  2046.                   if (not EOF) and (lLastTable = Trim(lqryGetObjIndexes.FieldByName('RDB$RELATION_NAME').AsString)) then
  2047.                   begin
  2048.                     // determine if there is a column name present
  2049.                     if FieldByName('RDB$FIELD_NAME').AsString <> '' then
  2050.                     begin
  2051.                       // add a comma to the last line in the script
  2052.                       SQLScript[SQLScript.Count - 1] :=
  2053.                         SQLScript[SQLScript.Count - 1] + ',';
  2054.  
  2055.                       // determine if the unique constraint has a user defined name
  2056.                       // if so then add it to script
  2057.                       if StrPos(PChar(FieldByName('RDB$CONSTRAINT_NAME').AsString), PChar('INTEG')) = Nil then
  2058.                         lStr:='  CONSTRAINT UNIQUE ' + Trim(FIeldByName('RDB$CONSTRAINT_NAME').AsString) + ' ('
  2059.                       else
  2060.                         lStr:='  UNIQUE (';
  2061.  
  2062.                       // keep adding column names to temporary string
  2063.                       while (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2064.                       begin
  2065.                         lStr:=lStr + Trim(FieldByName('RDB$FIELD_NAME').AsString);
  2066.                         Next;                    // increment lqryGetObjIndices pointer
  2067.                         // if there is more column information then put a comma between them
  2068.                         if (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) then
  2069.                           lStr:=lStr + ', ';
  2070.                       end;
  2071.                       lStr:=lStr + ')';
  2072.                       SQLScript.Add(lStr);
  2073.                     end;
  2074.                   end;
  2075.                   Result:=True;                  // return result as true
  2076.                 except
  2077.                   on E:EIBError do
  2078.                   begin
  2079.                     // if an exception occurs then catch it
  2080.                     // return result as false
  2081.                     DisplayMsg(ERR_GET_DDL, E.Message);
  2082.                     result := false;
  2083.                   end;
  2084.                 end;
  2085.               end;
  2086.  
  2087.               // once all the field and unique index information has been gathered
  2088.               // extract primary key information
  2089.               with lqryGetObjPrimary do
  2090.               begin
  2091.                 try
  2092.                   First;
  2093.  
  2094.                   // advance pointer to first primary key column associated with the current table
  2095.                   while (not EOF) and (lLastTable <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2096.                     Next;
  2097.  
  2098.                   // make sure information is for the current table and the data set is not at the end
  2099.                   if (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) then
  2100.                   begin
  2101.                     // if there is information present then add comma to previous line in script
  2102.                     if FieldByName('RDB$FIELD_NAME').AsString <> '' then
  2103.                     begin
  2104.                       SQLScript[SQLScript.Count - 1] :=
  2105.                         SQLScript[SQLScript.Count - 1] + ',';
  2106.                       lStr:='  PRIMARY KEY (';
  2107.  
  2108.                       // keep adding primary key columns
  2109.                       while (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2110.                       begin
  2111.                         lStr:=lStr + Trim(FieldByName('RDB$FIELD_NAME').AsString);
  2112.                         Next;                    // increment lqryGetObjPrimary pointer
  2113.  
  2114.                         // if there is another primary key column then place a comma between them
  2115.                         if (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) then
  2116.                           lStr:=lStr + ', ';
  2117.                       end;
  2118.                       lStr:=lStr + ')';
  2119.                       SQLScript.Add(lStr);
  2120.                     end;
  2121.                   end;
  2122.                   // return result as true
  2123.                   Result:=True;
  2124.                 except
  2125.                   on E:EIBError do
  2126.                   begin
  2127.                     // if an exception occurs then catch it
  2128.                     // return result as false
  2129.                     DisplayMsg(ERR_GET_DDL, E.Message);
  2130.                     result := false;
  2131.                   end;
  2132.                 end;
  2133.               end;
  2134.  
  2135.               // store next table name
  2136.               //lLastTable:=Trim(FieldByName('RDB$RELATION_NAME').AsString);
  2137.               SQLScript.Add(');');
  2138.               SQLScript.Add('');
  2139.  
  2140.               // add SQL privileges - while not EOF, also checks for privileges when EOF later
  2141.               with lqryGetObjDetails do
  2142.               begin
  2143.                 First;
  2144.                 while (not EOF) and (lLastTable <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2145.                   Next;
  2146.                 try
  2147.                 // show header
  2148.                   if not EOF then
  2149.                   begin
  2150.                     lStr:='';
  2151.                     SQLScript.Add(Format('/*  SQL Privileges for Table %s  */', [lLastTable]));
  2152.  
  2153.                     // get permissions for all objects except procedures
  2154.                     while (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2155.                     begin
  2156.                       // determine the privilege
  2157.                       if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'D' then
  2158.                         lStr:=lStr + 'DELETE'
  2159.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'S' then
  2160.                         lStr:=lStr + 'SELECT'
  2161.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'U' then
  2162.                         lStr:=lStr + 'UPDATE'
  2163.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'I' then
  2164.                         lStr:=lStr + 'INSERT'
  2165.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'R' then
  2166.                         lStr:=lStr + 'REFERENCES';
  2167.  
  2168.                       // store tablename, username, grant options and object type
  2169.                       lTableName:=Trim(FieldByName('RDB$RELATION_NAME').AsString);
  2170.                       lUserName:=Trim(FieldByName('RDB$USER').AsString);
  2171.                       lGrantOption:=FieldByName('RDB$GRANT_OPTION').AsInteger;
  2172.                       lObjectType:=FieldByName('RDB$OBJECT_TYPE').AsInteger;
  2173.  
  2174.                       Next;              // increment lqryGetObjList
  2175.  
  2176.                       // if no longer the same table, user, grant option or
  2177.                       // object is a role then add to script
  2178.                       if ((lTableName <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) or
  2179.                         (lUserName <> Trim(FieldByName('RDB$USER').AsString)) or
  2180.                         (lGrantOption <> FieldByName('RDB$GRANT_OPTION').AsInteger)) and
  2181.                         (lStr <> '') and (lObjectType = 0) or EOF then
  2182.                       begin
  2183.                         if lStr <> '' then
  2184.                           lStr:=lStr + ' ON ';
  2185.  
  2186.                         // determine grant option
  2187.                         SQLScript.Add(Format('GRANT %s%s TO %s', [lStr, lTableName, lUserName]));
  2188.                         case lGrantOption of
  2189.                           0 :
  2190.                           begin
  2191.                             SQLScript[SQLScript.Count - 1] := SQLScript[SQLScript.Count - 1] + ';';
  2192.                           end;
  2193.                           1 :
  2194.                           begin
  2195.                             SQLScript[SQLScript.Count - 1] :=
  2196.                               SQLScript[SQLScript.Count - 1] + ' WITH GRANT OPTION;';
  2197.                           end;
  2198.                           2 :
  2199.                           begin
  2200.                             SQLScript[SQLScript.Count - 1] :=
  2201.                               SQLScript[SQLScript.Count - 1] + ' WITH ADMIN OPTION;';
  2202.                           end;
  2203.                         end;
  2204.                         lStr:='';
  2205.                       end;
  2206.  
  2207.                       // add comma between privileges
  2208.                       if lStr <> '' then
  2209.                         lStr:=lStr + ', ';
  2210.                     end;
  2211.                     SQLScript.Add('');
  2212.                   end;
  2213.                 except
  2214.                   on E:EIBError do
  2215.                   begin
  2216.                     // if an exception occurs then catch it and show error message
  2217.                     // return result as false
  2218.                     DisplayMsg(ERR_GET_DDL, E.Message);
  2219.                     result := false;
  2220.                   end;
  2221.                 end;
  2222.               end;
  2223.  
  2224.               lLastTable:=Trim(FieldByName('RDB$RELATION_NAME').AsString);
  2225.  
  2226.               // start header for next table
  2227.               SQLScript.Add(Format('/*  Table: %s, Owner: %s  */',[Trim(FieldByName('RDB$RELATION_NAME').AsString), Trim(FieldByName('RDB$OWNER_NAME').AsString)]));
  2228.               SQLScript.Add(Format('CREATE TABLE %s ',[Trim(FieldByName('RDB$RELATION_NAME').AsString)]));
  2229.               SQLScript.Add('(');
  2230.               SQLScript.Add('  ');
  2231.  
  2232.             end
  2233.             else if (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) and (not EOF) then
  2234.             begin
  2235.               // if same table then there is more column information, add a comma
  2236.               SQLScript.Strings[SQLScript.Count - 1] :=
  2237.                 SQLScript.Strings[SQLScript.Count - 1] + ',';
  2238.               SQLScript.Add('  ');
  2239.             end
  2240.             else if EOF then
  2241.             begin
  2242.               SQLScript.Add(');');
  2243.               SQLScript.Add('');
  2244.  
  2245.               // add SQL priviliges - check for SQL privileges when EOF
  2246.               with lqryGetObjDetails do
  2247.               begin
  2248.                 First;
  2249.  
  2250.                 while (not EOF) and (lLastTable <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2251.                   Next;
  2252.  
  2253.                 try
  2254.                   // show header
  2255.                   if not EOF then
  2256.                   begin
  2257.                     lStr:='';
  2258.                     SQLScript.Add(Format('/*  SQL Privileges for Table %s  */', [lLastTable]));
  2259.  
  2260.                     // get permissions for all objects except procedures
  2261.                     while (not EOF) and (lLastTable = Trim(FieldByName('RDB$RELATION_NAME').AsString)) do
  2262.                     begin
  2263.  
  2264.                       // determine the privilege
  2265.                       if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'D' then
  2266.                         lStr:=lStr + 'DELETE'
  2267.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'S' then
  2268.                         lStr:=lStr + 'SELECT'
  2269.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'U' then
  2270.                         lStr:=lStr + 'UPDATE'
  2271.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'I' then
  2272.                         lStr:=lStr + 'INSERT'
  2273.                       else if Trim(FieldByName('RDB$PRIVILEGE').AsString) = 'R' then
  2274.                         lStr:=lStr + 'REFERENCES';
  2275.  
  2276.                       // store tablename, username, grant options and object type
  2277.                       lTableName:=Trim(FieldByName('RDB$RELATION_NAME').AsString);
  2278.                       lUserName:=Trim(FieldByName('RDB$USER').AsString);
  2279.                       lGrantOption:=FieldByName('RDB$GRANT_OPTION').AsInteger;
  2280.                       lObjectType:=FieldByName('RDB$OBJECT_TYPE').AsInteger;
  2281.  
  2282.                       Next;              // increment lqryGetObjList
  2283.  
  2284.                       // if no longer the same table, user, grant option or
  2285.                       // object is a role then add to script
  2286.                       if ((lTableName <> Trim(FieldByName('RDB$RELATION_NAME').AsString)) or
  2287.                         (lUserName <> Trim(FieldByName('RDB$USER').AsString)) or
  2288.                         (lGrantOption <> FieldByName('RDB$GRANT_OPTION').AsInteger)) and
  2289.                         (lStr <> '') and (lObjectType = 0) or EOF then
  2290.                       begin
  2291.                         if lStr <> '' then
  2292.                           lStr:=lStr + ' ON ';
  2293.  
  2294.                         // determine grant option
  2295.                         SQLScript.Add(Format('GRANT %s%s TO %s', [lStr, lTableName, lUserName]));
  2296.                         case lGrantOption of
  2297.                           0 :
  2298.                           begin
  2299.                             SQLScript[SQLScript.Count - 1] := SQLScript[SQLScript.Count - 1] + ';';
  2300.                           end;
  2301.                           1 :
  2302.                           begin
  2303.                             SQLScript[SQLScript.Count - 1] :=
  2304.                               SQLScript[SQLScript.Count - 1] + ' WITH GRANT OPTION;';
  2305.                           end;
  2306.                           2 :
  2307.                           begin
  2308.                             SQLScript[SQLScript.Count - 1] :=
  2309.                               SQLScript[SQLScript.Count - 1] + ' WITH ADMIN OPTION;';
  2310.                           end;
  2311.                         end;
  2312.                         lStr:='';
  2313.                       end;
  2314.  
  2315.                       // add comma between privileges
  2316.                       if lStr <> '' then
  2317.                         lStr:=lStr + ', ';
  2318.  
  2319.                     end;
  2320.                     SQLScript.Add('');
  2321.                   end;
  2322.                 except
  2323.                   on E:EIBError do
  2324.                   begin
  2325.                     // if an exception occurs then catch it and show error message
  2326.                     // return result as false
  2327.                     DisplayMsg(ERR_GET_DDL, E.Message);
  2328.                     result := false;
  2329.                   end;
  2330.                 end;  // of try block
  2331.               end;  // of with lqryGetObjDetails
  2332.             end;  // of else EOF
  2333.           end;
  2334.           until EOF;
  2335.           // return result as true
  2336.           result := true;
  2337.         end
  2338.         else
  2339.         begin
  2340.           // if there is no column information then return result as false
  2341.           result := false;
  2342.         end;
  2343.         Close;                                   // close lqryGetObjList
  2344.       except
  2345.         on E:EIBError do
  2346.         begin
  2347.           // if an exception occurs then catch it and show error message
  2348.           // return result as false
  2349.           DisplayMsg(ERR_GET_DDL, E.Message);
  2350.           result := false;
  2351.         end;
  2352.       end;
  2353.     end;
  2354.   finally
  2355.     // close queries and deallocate memory
  2356.     lqryGetObjList.Close;
  2357.     lqryGetObjDimensions.Close;
  2358.     lqryGetObjIndexes.Close;
  2359.     lqryGetObjPrimary.Close;
  2360.     lqryGetObjDetails.Close;
  2361.     lqryGetObjList.Free;
  2362.     lqryGetObjDimensions.Free;
  2363.     lqryGetObjIndexes.Free;
  2364.     lqryGetObjPrimary.Free;
  2365.     lqryGetObjDetails.Free;
  2366.     lDuplicates.Free;
  2367.   end;
  2368. end;
  2369.  
  2370. {****************************************************************
  2371. *
  2372. *  G e t D D L T r i g g e r s ( )
  2373. *
  2374. ****************************************************************
  2375. *  Author: The Client Server Factory Inc.
  2376. *  Date:   March 1, 1999
  2377. *
  2378. *  Input:  TStringList (variable)   - Gets populated with metadata for triggers.
  2379. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  2380. *          String (value)           - Specifies a table name.
  2381. *
  2382. *  Return: Boolean - Indicates the success/failure of the operation
  2383. *
  2384. *  Description:  Retrieves metadata for all triggers in a specified table.
  2385. *
  2386. *****************************************************************
  2387. * Revisions:
  2388. *
  2389. *****************************************************************}
  2390. function GetDDLTriggers(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  2391. var
  2392.   lSQLStr: string;
  2393.   lTriggerType: string;
  2394.   lqryGetObjList : TIBQuery;
  2395.   lqryGetObjDetails: TIBQuery;
  2396. begin
  2397.   // initialize
  2398.   lqryGetObjList := nil;
  2399.   lqryGetObjDetails := nil;
  2400.   try
  2401.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  2402.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  2403.  
  2404.     // query to get triggers
  2405.     lqryGetObjList := TIBQuery.Create(dmMain);
  2406.     lqryGetObjList.Database := SelDatabaseNode;
  2407.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  2408.  
  2409.     // NOT USED
  2410.     lqryGetObjDetails := TIBQuery.Create(dmMain);
  2411.     lqryGetObjDetails.Database := SelDatabaseNode;
  2412.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  2413.  
  2414.     with lqryGetObjList do
  2415.     begin
  2416.       // get trigger list and trigger source
  2417.       lSQLStr := 'SELECT RDB$TRIGGER_NAME,RDB$RELATION_NAME,RDB$TRIGGER_SEQUENCE,RDB$TRIGGER_TYPE,';
  2418.       lSQLStr := Format('%s RDB$TRIGGER_SOURCE FROM RDB$TRIGGERS WHERE', [lSQLStr]);
  2419.       lSQLStr := Format('%s RDB$RELATION_NAME = ''' + TableName + ''' ORDER BY RDB$TRIGGER_NAME', [lSQLStr]);
  2420.       SQL.Clear;
  2421.       SQL.Add(lSQLStr);
  2422.       try
  2423.         Open;
  2424.         if not EOF then
  2425.         begin
  2426.           // set script terminator to terminator defined in TERMINATOR constant
  2427.           SQLScript.Add(Format('SET TERM %s ;', [TERMINATOR]));
  2428.           SQLScript.Add('');
  2429.  
  2430.           // loop through list
  2431.           repeat
  2432.           begin
  2433.             // show header
  2434.             SQLScript.Add(Format('/*  Trigger: %s  */',[Trim(FieldbyName('RDB$TRIGGER_NAME').AsString)]));
  2435.             SQLScript.Add(Format('CREATE TRIGGER %s FOR %s',
  2436.                 [Trim(FieldbyName('RDB$TRIGGER_NAME').AsString),
  2437.                 Trim(FieldByName('RDB$RELATION_NAME').AsString)]));
  2438.  
  2439.             // determine when trigger is fired
  2440.             case FieldbyName('RDB$TRIGGER_TYPE').AsInteger of
  2441.               1: lTriggerType := ' BEFORE INSERT';
  2442.               2: lTriggerType := ' AFTER INSERT';
  2443.               3: lTriggerType := ' BEFORE UPDATE';
  2444.               4: lTriggerType := ' AFTER UPDATE';
  2445.               5: lTriggerType := ' BEFORE DELETE';
  2446.               6: lTriggerType := ' AFTER DELETE';
  2447.             else
  2448.               lTriggerType := '';
  2449.             end;
  2450.  
  2451.             // add position
  2452.             SQLScript.Strings[SQLScript.Count - 1] :=
  2453.               SQLScript.Strings[SQLScript.Count - 1] + lTriggerType +
  2454.               ' POSITION ' + FieldByName('RDB$TRIGGER_SEQUENCE').AsString + ' ';
  2455.  
  2456.             // add trigger source
  2457.             SQLScript.Add(Trim(FieldByName('RDB$TRIGGER_SOURCE').AsString));
  2458.  
  2459.             // add new terminator at the end
  2460.             SQLScript.Strings[SQLScript.Count - 1] :=
  2461.               SQLScript.Strings[SQLScript.Count - 1] + TERMINATOR;
  2462.  
  2463.             SQLScript.Add(' ');
  2464.             Next;
  2465.           end;
  2466.           until EOF;
  2467.           // reset script terminator
  2468.           SQLScript.Add(Format('COMMIT WORK%s', [TERMINATOR]));
  2469.           SQLScript.Add(Format('SET TERM ; %s', [TERMINATOR]));
  2470.           // return result as true
  2471.           result := true;
  2472.         end
  2473.         else
  2474.         begin
  2475.           // if there are no triggers
  2476.           // return result as false
  2477.           result := false;
  2478.         end;
  2479.         Close;
  2480.         except
  2481.           on E:EIBError do
  2482.           begin
  2483.             // if an exception occurs then catch it and show error message
  2484.             // return result as false
  2485.             DisplayMsg(ERR_GET_DDL, E.Message);
  2486.             result := false;
  2487.           end;
  2488.       end;
  2489.     end;
  2490.   finally
  2491.     // close all datasets and deallocate memory
  2492.     lqryGetObjList.Close;
  2493.     lqryGetObjDetails.Close;
  2494.     lqryGetObjList.Free;
  2495.     lqryGetObjDetails.Free;
  2496.   end;
  2497. end;
  2498.  
  2499. {****************************************************************
  2500. *
  2501. *  G e t D D L U n i q u e C o n s t ( )
  2502. *
  2503. ****************************************************************
  2504. *  Author: The Client Server Factory Inc.
  2505. *  Date:   March 1, 1999
  2506. *
  2507. *  Input:  TStringList (variable)   - Gets populated with metadata for unique constraints.
  2508. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  2509. *          String (value)           - Specifies a table name.
  2510. *
  2511. *  Return: Boolean - Indicates the success/failure of the operation
  2512. *
  2513. *  Description:  Retrieves metadata for all unique constraints in a specified table.
  2514. *
  2515. *****************************************************************
  2516. * Revisions:
  2517. *
  2518. *****************************************************************}
  2519. function GetDDLUniqueConst(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): boolean;
  2520. var
  2521.   lSQLStr: string;
  2522.   lStr     : string;
  2523.   lqryGetObjList : TIBQuery;
  2524.   lqryGetObjDetails: TIBQuery;
  2525. begin
  2526.   // initialize
  2527.   lqryGetObjList := nil;
  2528.   lqryGetObjDetails := nil;
  2529.   try
  2530.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  2531.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  2532.  
  2533.     // query to get list of unique constraints
  2534.     lqryGetObjList := TIBQuery.Create(dmMain);
  2535.     lqryGetObjList.Database := SelDatabaseNode;
  2536.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  2537.  
  2538.     // query to get columns participating in unique constraints
  2539.     lqryGetObjDetails := TIBQuery.Create(dmMain);
  2540.     lqryGetObjDetails.Database := SelDatabaseNode;
  2541.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  2542.  
  2543.     with lqryGetObjList do
  2544.     begin
  2545.       // get list of unique constraints
  2546.       lSQLStr := 'SELECT RDB$CONSTRAINT_NAME, RDB$RELATION_NAME, RDB$INDEX_NAME FROM';
  2547.       lSQLStr := Format('%s RDB$RELATION_CONSTRAINTS WHERE RDB$CONSTRAINT_TYPE = ''UNIQUE''', [lSQLStr]);
  2548.       lSQLStr := Format('%s AND RDB$RELATION_NAME = ''' + TableName + '''', [lSQLStr]);
  2549.       lSQLStr := Format('%s ORDER BY RDB$CONSTRAINT_NAME ASC', [lSQLStr]);
  2550.  
  2551.       SQL.Clear;
  2552.       SQL.Add(lSQLStr);
  2553.       try
  2554.         Open;
  2555.         if not EOF then
  2556.         begin
  2557.           // loop through list of unique constraints
  2558.           // this is the main compare loop
  2559.           repeat
  2560.           begin
  2561.             lStr:='';
  2562.             // show header
  2563.             SQLScript.Add(Format('/*  Unique Constraint: %s  */',[Trim(FieldbyName('RDB$CONSTRAINT_NAME').AsString)]));
  2564.             SQLScript.Add(Format('ALTER TABLE %s',[Trim(FieldbyName('RDB$RELATION_NAME').AsString)]));
  2565.             SQLScript.Add(FORMAT('  ADD CONSTRAINT %s', [Trim(FIeldByName('RDB$CONSTRAINT_NAME').AsString)]));
  2566.             SQLScript.Add('  UNIQUE');
  2567.  
  2568.             // get columns participating in unique constraint
  2569.             lqryGetObjDetails.Close;
  2570.             lqryGetObjDetails.SQL.Clear;
  2571.             lqryGetObjDetails.SQL.Add('SELECT * FROM RDB$INDEX_SEGMENTS WHERE ');
  2572.             lqryGetObjDetails.SQL.Add(Format('RDB$INDEX_NAME = ''%s''', [Trim(lqryGetObjList.FieldByName('RDB$INDEX_NAME').AsString)]));
  2573.             lqryGetObjDetails.SQL.Add('ORDER BY RDB$FIELD_POSITION ASC');
  2574.             try
  2575.               lqryGetObjDetails.Open;
  2576.               if not lqryGetObjDetails.EOF then
  2577.               begin
  2578.                 SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ' (';
  2579.                 // loop through details
  2580.                 repeat
  2581.                 begin
  2582.                   // add column to script
  2583.                   lStr:=Trim(lqryGetObjDetails.FieldByName('RDB$FIELD_NAME').AsString);
  2584.                   SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + lStr;
  2585.  
  2586.                   lqryGetObjDetails.Next;        // increment lqryGetObjDetails pointer
  2587.  
  2588.                   // if there are more columns in list then add a comma
  2589.                   if Not lqryGetObjDetails.EOF then
  2590.                     SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ', ';
  2591.  
  2592.                 end;
  2593.                 until lqryGetObjDetails.EOF;
  2594.                 SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + '); ';
  2595.               end;
  2596.             except
  2597.               on E:EIBError do
  2598.               begin
  2599.                 // if an exception occurs then
  2600.                 // resturn result as false
  2601.                 result := false;
  2602.               end;
  2603.             end;
  2604.  
  2605.             SQLScript.Add(' ');
  2606.             Next;                                // increment lqryGetObjList pointer
  2607.           end;
  2608.           until EOF;
  2609.           // return result as true
  2610.           result := true;
  2611.         end
  2612.         else
  2613.         begin
  2614.           // if there are no unique constraints
  2615.           // return result as false
  2616.           result := false;
  2617.         end;
  2618.         Close;
  2619.       except
  2620.         on E:EIBError do
  2621.         begin
  2622.           // if an exception occurs then catch it and show error message
  2623.           // return result as false
  2624.           DisplayMsg(ERR_GET_DDL, E.Message);
  2625.           result := false;
  2626.         end;
  2627.       end;
  2628.     end;
  2629.   finally
  2630.     // close datasets and deallocate memory
  2631.     lqryGetObjList.Close;
  2632.     lqryGetObjDetails.Close;
  2633.     lqryGetObjList.Free;
  2634.     lqryGetObjDetails.Free;
  2635.   end;
  2636. end;
  2637.  
  2638. {****************************************************************
  2639. *
  2640. *  G e t D D L V i e w s ( )
  2641. *
  2642. ****************************************************************
  2643. *  Author: The Client Server Factory Inc.
  2644. *  Date:   March 1, 1999
  2645. *
  2646. *  Input:  TStringList (variable)   - Gets populated with metadata for views.
  2647. *          TibcDatabaseNode (value) - Specifies the target database/transaction.
  2648. *          Boolean (value)          - Specifies whether or not to include system data.
  2649. *
  2650. *  Return: Boolean - Indicates the success/failure of the operation
  2651. *
  2652. *  Description:  Retrieves metadata for all views in the database.
  2653. *
  2654. *****************************************************************
  2655. * Revisions:
  2656. *
  2657. *****************************************************************}
  2658. function GetDDLViews(var SQLScript: TStringList; const SelDatabaseNode: TIBDatabase;
  2659.                      const SystemData: boolean; const ObjName: String): boolean;
  2660. var
  2661.   lSQLStr: string;
  2662.   lqryGetObjList : TIBQuery;
  2663.   lqryGetObjDetails : TIBQuery;
  2664. begin
  2665.   // initialize
  2666.   lqryGetObjList := nil;
  2667.   lqryGetObjDetails := nil;
  2668.   try
  2669.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  2670.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  2671.  
  2672.     // query to get list of views
  2673.     lqryGetObjList := TIBQuery.Create(dmMain);
  2674.     lqryGetObjList.Database := SelDatabaseNode;
  2675.     lqryGetObjList.Transaction := SelDatabaseNode.DefaultTransaction;
  2676.  
  2677.     // query to get details for a specific view
  2678.     lqryGetObjDetails := TIBQuery.Create(dmMain);
  2679.     lqryGetObjDetails.Database := SelDatabaseNode;
  2680.     lqryGetObjDetails.Transaction := SelDatabaseNode.DefaultTransaction;
  2681.  
  2682.     with lqryGetObjList do
  2683.     begin
  2684.       // get list of views
  2685.       // this is the main compare loop
  2686.       lSQLStr := 'SELECT DISTINCT A.RDB$RELATION_NAME,A.RDB$OWNER_NAME,A.RDB$VIEW_SOURCE';
  2687.       lSQLStr := Format('%s FROM RDB$RELATIONS A, RDB$VIEW_RELATIONS B', [lSQLStr]);
  2688.       lSQLStr := Format('%s WHERE A.RDB$RELATION_NAME = B.RDB$VIEW_NAME', [lSQLStr]);
  2689.  
  2690.       if ObjName <> '' then
  2691.       begin
  2692.         lSQLStr := Format('%s AND B.RDB$VIEW_NAME = ''%s''', [lSQLStr, ObjName])
  2693.       end;
  2694.  
  2695.       SQL.Clear;
  2696.       SQL.Add(lSQLStr);
  2697.       try
  2698.         Open;
  2699.         if not EOF then
  2700.         begin
  2701.           repeat
  2702.           begin
  2703.             // show header
  2704.             SQLScript.Add(Format('/*  View: %s, Owner: %s */',[Trim(FieldbyName('RDB$RELATION_NAME').AsString),Trim(FieldbyName('RDB$OWNER_NAME').AsString)]));
  2705.             SQLScript.Add(Format('CREATE VIEW %s (',[Trim(FieldbyName('RDB$RELATION_NAME').AsString)]));
  2706.  
  2707.             // set up query to retrieve view information
  2708.             lqryGetObjDetails.Close;
  2709.             lqryGetObjDetails.SQL.Clear;
  2710.             lqryGetObjDetails.SQL.Add('SELECT RDB$FIELD_NAME,RDB$FIELD_POSITION FROM RDB$RELATION_FIELDS');
  2711.             lqryGetObjDetails.SQL.Add(Format('WHERE RDB$RELATION_NAME = ''%s'' ORDER BY RDB$FIELD_POSITION',[Trim(FieldbyName('RDB$RELATION_NAME').AsString)]));
  2712.             try
  2713.               lqryGetObjDetails.Open;
  2714.               if not lqryGetObjDetails.EOF then
  2715.               begin
  2716.                 // loop through query details
  2717.                 repeat
  2718.                 begin
  2719.                   SQLScript.Strings[SQLScript.Count - 1] := Format('%s %s,',[SQLScript.Strings[SQLScript.Count - 1],Trim(lqryGetObjDetails.FieldByName('RDB$FIELD_NAME').AsString)]);
  2720.                   lqryGetObjDetails.Next;        // increment lqryGetObjDetails pointer
  2721.                 end;
  2722.                 until lqryGetObjDetails.EOF;
  2723.                 SQLScript.Strings[SQLScript.Count - 1] := Copy(SQLScript.Strings[SQLScript.Count - 1],1,Length(SQLScript.Strings[SQLScript.Count - 1]) - 1);
  2724.               end;
  2725.             except
  2726.               on E:EIBError do
  2727.               begin
  2728.                 // if an exception occurs then catch it
  2729.                 // return result as false
  2730.                 result := false;
  2731.               end;
  2732.             end;
  2733.             // add to script
  2734.             SQLScript.Add(Format(') AS %s',[Trim(FieldbyName('RDB$VIEW_SOURCE').AsString)]));
  2735.             SQLScript.Strings[SQLScript.Count - 1] := SQLScript.Strings[SQLScript.Count - 1] + ';';
  2736.             SQLScript.Add(' ');
  2737.             Next;
  2738.           end;
  2739.           until EOF;
  2740.           // return result as true
  2741.           result := true;
  2742.         end
  2743.         else
  2744.         begin
  2745.           // if no detail information then return result as false
  2746.           result := false;
  2747.         end;
  2748.         Close;
  2749.       except
  2750.         on E:EIBError do
  2751.         begin
  2752.           // if an exception occurs then catch it and show error message
  2753.           // return result as false
  2754.           DisplayMsg(ERR_GET_DDL, E.Message);
  2755.           result := false;
  2756.         end;
  2757.       end;
  2758.     end;
  2759.   finally
  2760.     // close datasets and deallocate memory
  2761.     lqryGetObjList.Close;
  2762.     lqryGetObjDetails.Close;
  2763.     lqryGetObjList.Free;
  2764.     lqryGetObjDetails.Free;
  2765.   end;
  2766. end;
  2767.  
  2768. {****************************************************************
  2769. *
  2770. *  G e t D e p e n d e n c i e s ( )
  2771. *
  2772. ****************************************************************
  2773. *  Author: The Client Server Factory Inc.
  2774. *  Date:   March 1, 1999
  2775. *
  2776. *  Input:  Dependencies - A list containing object details
  2777. *          SelDatabaseNode - The database to be queried
  2778. *          ObjectName - The object to be queried
  2779. *          TypeId - The type of the object
  2780. *
  2781. *  Return: integer - Success/Failure indicator
  2782. *
  2783. *  Description:  Retrieves a list of dependencies for the specified object
  2784. *
  2785. *****************************************************************
  2786. * Revisions:
  2787. *
  2788. *****************************************************************}
  2789. function GetDependencies(var Dependencies: TStringList; const SelDatabaseNode: TIBDatabase;
  2790.   const ObjectName: string; const ObjectType: Integer): integer;
  2791. var
  2792.   lDependenciesType: string;
  2793.   lqryDependencies: TIBQuery;
  2794. begin
  2795.   // initialize
  2796.   lqryDependencies := nil;
  2797. //  Dependencies.Add(Format('Name%sType',[DEL]));
  2798.  
  2799.   try
  2800.     if not SelDatabaseNode.DefaultTransaction.InTransaction then
  2801.       SelDatabaseNode.DefaultTransaction.StartTransaction;
  2802.  
  2803.     // query for object dependencies
  2804.     lqryDependencies := TIBQuery.Create(dmMain);
  2805.     lqryDependencies.Database := SelDatabaseNode;
  2806.     lqryDependencies.Transaction := SelDatabaseNode.DefaultTransaction;
  2807.  
  2808.      with lqryDependencies do
  2809.      begin
  2810.        if ObjectType = DEP_COMPUTED_FIELD then // if Computed field
  2811.        begin
  2812.          SQL.Add('SELECT RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE FROM RDB$DEPENDENCIES');
  2813.          SQL.Add('WHERE RDB$FIELD_NAME = :ObjectName');
  2814.          SQL.Add('GROUP BY RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE');
  2815.          SQL.Add('ORDER BY RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE');
  2816.          Params[0].AsString := ObjectName;
  2817.        end
  2818.        else
  2819.        begin
  2820.          SQL.Add('SELECT RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE FROM RDB$DEPENDENCIES');
  2821.          SQL.Add('WHERE RDB$DEPENDED_ON_NAME = :ObjectName');
  2822.          SQL.Add('AND RDB$DEPENDED_ON_TYPE = :TypeID');
  2823.          SQL.Add('GROUP BY RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE');
  2824.          SQL.Add('ORDER BY RDB$DEPENDENT_NAME,RDB$DEPENDENT_TYPE');
  2825.          Params[0].AsString := ObjectName;
  2826.          Params[1].AsInteger := ObjectType;
  2827.        end;
  2828.        try
  2829.          Open;
  2830.          if not EOF then
  2831.          begin
  2832.            repeat
  2833.            begin
  2834.              case FieldbyName('RDB$DEPENDENT_TYPE').AsInteger of
  2835.                DEP_TABLE: lDependenciesType := 'Table';
  2836.                DEP_VIEW: lDependenciesType := 'View';
  2837.                DEP_TRIGGER: lDependenciesType := 'Trigger';
  2838.                DEP_COMPUTED_FIELD: lDependenciesType := 'Computed field';
  2839.                DEP_VALIDATION: lDependenciesType := 'Validation';
  2840.                DEP_PROCEDURE: lDependenciesType := 'Stored Procedure';
  2841.                DEP_EXPRESSION_INDEX: lDependenciesType := 'Expression index';
  2842.                DEP_EXCEPTION: lDependenciesType := 'Exception';
  2843.                DEP_USER: lDependenciesType := 'User';
  2844.                DEP_FIELD: lDependenciesType := 'Field';
  2845.                DEP_INDEX: lDependenciesType := 'Index';
  2846.              else
  2847.                lDependenciesType := '';
  2848.              end;
  2849.              Dependencies.Add(Format('%s%s%s',[Trim(Fields[0].AsString),DEL,lDependenciesType]));
  2850.              Next;
  2851.            end;
  2852.            until EOF;
  2853.            result := SUCCESS;
  2854.          end
  2855.          else
  2856.           begin
  2857.            result := EMPTY;
  2858.           end;
  2859.          Close;
  2860.        except
  2861.          on E:EIBError do
  2862.          begin
  2863.             DisplayMsg(ERR_GET_DEPENDENCIES, E.Message);
  2864.             result := FAILURE;
  2865.          end;
  2866.        end;
  2867.      end;
  2868.   finally
  2869.     lqryDependencies.Close;
  2870.     lqryDependencies.Free;
  2871.   end;
  2872. end;
  2873.  
  2874. end.
  2875.  
  2876.  
  2877.