home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / dmuMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  74.2 KB  |  2,266 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. *  d m u M a i n
  22. *
  23. ****************************************************************
  24. *  Author: The Client Server Factory Inc.
  25. *  Date:   March 1, 1999
  26. *
  27. *  Description:  This unit contains non GUI, database related
  28. *                functions
  29. *
  30. *****************************************************************
  31. * Revisions:
  32. *
  33. *****************************************************************}
  34.  
  35. unit dmuMain;
  36.  
  37. interface
  38.  
  39. uses
  40.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  41.   Dialogs, IBCustomDataSet, IBQuery, IBDatabase, Db, IB, zluibcClasses,
  42.   DBTables, IBTable, StdCtrls, IBHEADER, IBServices, Grids, DBGrids, IBSql,
  43.   IBDatabaseInfo;
  44.  
  45. type
  46.   TdmMain = class(TDataModule)
  47.   private
  48.     { Private declarations }
  49.     function GetNextGenValue (const Database: TIBDatabase; const GenName: String): String;
  50.   public
  51.     { Public declarations }
  52.     function GetBlobFilterList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  53.     function GetCheckConstList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  54.     function GetColumnList(var ObjectList: TStringList; const Database: TIBDatabase; const TableName: string): integer;
  55.     function GetDBFiles(var ObjectList: TStringList; const SelServerNode: TibcServerNode; const SelDatabaseNode: TibcDatabaseNode): integer;
  56.     function GetDomainList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  57.     function GetExceptionList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  58.     function GetFunctionList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  59.     function GetGeneratorList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  60.     function GetIndexList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  61.     function GetProcedureList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  62.     function GetProcedureInfo(var ObjectList: TStringList; var Source: TStringList; const SelDatabaseNode: TIBDatabase; const ProcName: String): integer;
  63.     function GetReferentialConstList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  64.     function GetRoleList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase): integer;
  65.     function GetTableData(var SelDatabaseNode: TIBDatabase; var DataSet: TIBDataset; const SelTableName: string): boolean;
  66.     function GetOwnerInfo(var OwnerName, Description: string; const SelDatabaseNode: TIBDatabase; const Node: TibcTreeNode): integer;
  67.     function GetTableList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  68.     function GetTriggerList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  69.     function GetUniqueConstList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  70.     function GetViewList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  71.     function GetFunctiondata(var ObjectList: TStringList; out ModuleName, EntryPoint, Returnval: String;const SelDatabaseNode: TIBDatabase; const FuncName: String): integer;
  72.     function GetFilterData (var ObjectList: TStringList;const SelDatabaseNode: TIBDatabase; const FuncName: String): integer;
  73.     function GetRoleData (var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const RoleName: String): integer;
  74.     function GetExceptionData (var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const ExceptionName: String): integer;
  75.     function GetGeneratorData (var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const ShowSystem: boolean): integer;
  76.     function GetViewData (var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const ViewName: String): integer;
  77.     function GetDomainData (var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const ShowSystem: boolean): integer;
  78.     function GetProcedureSource(var ObjectList: TStringList; const InDatabase: TIBDatabase; const ProcName: String): integer;
  79.   end;
  80.  
  81. var
  82.   dmMain: TdmMain;
  83.  
  84. implementation
  85.  
  86. uses
  87.   zluGlobal, frmuMessage, zluUtility, frmuDBConnect, IBExtract;
  88.  
  89. {$R *.DFM}
  90.  
  91. {****************************************************************
  92. *
  93. *  G e t B l o b F i l t e r L i s t ()
  94. *
  95. ****************************************************************
  96. *  Author: The Client Server Factory Inc.
  97. *  Date:   March 1, 1999
  98. *
  99. *  Input:  ObjectList - A list containing object details
  100. *          SelDatabaseNode - The database to be queried
  101. *          SystemData - A flag indicating whether or not to
  102. *                       display system data
  103. *  Return: integer - Success/Failure indicator
  104. *
  105. *  Description:  Retrieves a list of blob filters for the specified database
  106. *
  107. *****************************************************************
  108. * Revisions:
  109. *
  110. *****************************************************************}
  111. function TdmMain.GetBlobFilterList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  112. var
  113.  lQry: TIBSql;
  114.  
  115.  lSQLStr: string;
  116. begin
  117.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  118.     SelDatabaseNode.DefaultTransaction.Commit;
  119.  
  120.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  121.  
  122.   ObjectList.Add(Format('Name%sModule%sEntry%sInput%sOutput%sDescription',[DEL,DEL,DEL,DEL,DEL]));
  123.  
  124.   lQry := nil;
  125.   try
  126.     lQry := TIBSQL.Create (self);
  127.  
  128.     with lQry do
  129.     begin
  130.       Database := SelDatabaseNode;
  131.       Transaction := SelDatabaseNode.DefaultTransaction;
  132.       lSQLStr := 'SELECT RDB$FUNCTION_NAME,RDB$MODULE_NAME,RDB$ENTRYPOINT,';
  133.       lSQLStr := Format('%s RDB$INPUT_SUB_TYPE,RDB$OUTPUT_SUB_TYPE, RDB$DESCRIPTION FROM RDB$FILTERS',[lSQLStr]);
  134.  
  135.       if not SystemData then
  136.       begin
  137.         lSQLStr := Format('%s WHERE RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  138.       end;
  139.  
  140.       lSQLStr := Format('%s ORDER BY RDB$FUNCTION_NAME',[lSQLStr]);
  141.       SQL.Clear;
  142.       SQL.Add(lSQLStr);
  143.       try
  144.         ExecQuery;
  145.         if not EOF then
  146.         begin
  147.           repeat
  148.           begin
  149.             ObjectList.Add(Format('%s%s%s%s%s%s%s%s%s%s%s',[Fields[0].AsString,
  150.               DEL,Fields[1].AsString,DEL,Fields[2].AsString,DEL,Fields[3].AsString,
  151.               DEL,Fields[4].AsString, DEL, Fields[5].AsString]));
  152.             Next;
  153.           end;
  154.           until EOF;
  155.           result := SUCCESS;
  156.         end
  157.         else
  158.         begin
  159.           result := EMPTY;
  160.         end;
  161.       Close;
  162.       except
  163.         on E:EIBError do
  164.         begin
  165.           DisplayMsg(ERR_GET_BLOB_FILTERS, E.Message);
  166.           result := FAILURE;
  167.         end;
  168.       end;
  169.     end;
  170.   finally
  171.     SelDatabaseNode.DefaultTransaction.Commit;
  172.     lQry.Free;
  173.   end;
  174. end;
  175.  
  176. {****************************************************************
  177. *
  178. *  G e t C h e c k C o n s t L i s t ()
  179. *
  180. ****************************************************************
  181. *  Author: The Client Server Factory Inc.
  182. *  Date:   March 1, 1999
  183. *
  184. *  Input:  ObjectList - A list containing object details
  185. *          SelDatabaseNode - The database to be queried
  186. *          TableName - The table to be queried
  187. *
  188. *  Return: integer - Success/Failure indicator
  189. *
  190. *  Description:  Retrieves a list of check constraints for
  191. *  the specified database/table
  192. *
  193. *****************************************************************
  194. * Revisions:
  195. *
  196. *****************************************************************}
  197. function TdmMain.GetCheckConstList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  198. var
  199.   lLastConstraint,lSQLStr: string;
  200.   lStrIdx: integer;
  201.   lQry: TIBSql;
  202.  
  203. begin
  204.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  205.     SelDatabaseNode.DefaultTransaction.Commit;
  206.  
  207.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  208.   ObjectList.Add(Format('Name%sCan Defer%sInitially Deferred',
  209.                   [DEL,DEL]));
  210.  
  211.   lQry := nil;
  212.   try
  213.     lQry := TIBSql.Create (self);
  214.     with lQry do
  215.     begin
  216.       Database := SelDatabaseNode;
  217.       Transaction := SelDatabaseNode.DefaultTransaction;
  218.       lSQLStr := 'SELECT A.RDB$CONSTRAINT_NAME,A.RDB$DEFERRABLE,A.RDB$INITIALLY_DEFERRED,C.RDB$TRIGGER_SOURCE';
  219.       lSQLStr := Format('%s FROM RDB$RELATION_CONSTRAINTS A,RDB$CHECK_CONSTRAINTS B,RDB$TRIGGERS C',[lSQLStr]);
  220.       lSQLStr := Format('%s WHERE A.RDB$CONSTRAINT_NAME = B.RDB$CONSTRAINT_NAME',[lSQLStr]);
  221.       lSQLStr := Format('%s AND B.RDB$TRIGGER_NAME = C.RDB$TRIGGER_NAME',[lSQLStr]);
  222.       lSQLStr := Format('%s AND A.RDB$RELATION_NAME = ''%s''',[lSQLStr,TableName]);
  223.       lSQLStr := Format('%s ORDER BY A.RDB$CONSTRAINT_NAME',[lSQLStr]);
  224.       SQL.Clear;
  225.       SQL.Add(lSQLStr);
  226.       try
  227.         ExecQuery;
  228.         if not EOF then
  229.         begin
  230.           lLastConstraint := '';
  231.           repeat
  232.           begin
  233.             if lLastConstraint <> Fields[0].AsString then
  234.             begin
  235.               lStrIdx := ObjectList.Add(Format('%s%s%s%s%s%s%s',[Trim(Fields[0].AsString),DEL,Trim(Fields[1].AsString),DEL,
  236.                 Trim(Fields[2].AsString),DEL,Trim(Fields[3].AsString)]));
  237.               ObjectList.Strings[lStrIdx] := ObjectList.Strings[lStrIdx];
  238.             end;
  239.             lLastConstraint := Fields[0].AsString;
  240.             Next;
  241.           end;
  242.           until EOF;
  243.           result := SUCCESS;
  244.         end
  245.         else
  246.         begin
  247.           result := EMPTY;
  248.         end;
  249.         Close;
  250.       except
  251.         on E:EIBError do
  252.         begin
  253.           DisplayMsg(ERR_GET_CHECK_CONST, E.Message);
  254.           result := FAILURE;
  255.         end;
  256.       end;
  257.     end;
  258.   finally
  259.     SelDatabaseNode.DefaultTransaction.Commit;
  260.     lQry.Free;
  261.   end;
  262. end;
  263.  
  264. {****************************************************************
  265. *
  266. *  G e t C o l u m n L i s t ()
  267. *
  268. ****************************************************************
  269. *  Author: The Client Server Factory Inc.
  270. *  Date:   March 1, 1999
  271. *
  272. *  Input:  ObjectList - A list containing object details
  273. *          SelDatabaseNode - The database to be queried
  274. *          TableName - The table to be queried
  275. *
  276. *  Return: integer - Success/Failure indicator
  277. *
  278. *  Description:  Retrieves a list of columns for the specified database/table
  279. *
  280. *****************************************************************
  281. * Revisions:
  282. *
  283. *****************************************************************}
  284. function TdmMain.GetColumnList(var ObjectList: TStringList; const Database: TIBDatabase;
  285.                                const TableName: string): integer;
  286. var
  287.   Charset, Collation,
  288.   lFieldType,lAllowNulls,lSQLStr,lDefault : string;
  289.   lqry: TIBSql;
  290.   len: integer;
  291.   IBExtract: TIBExtract;
  292. begin
  293.   if Database.DefaultTransaction.InTransaction then
  294.     Database.DefaultTransaction.Commit;
  295.  
  296.   Database.DefaultTransaction.StartTransaction;
  297.  
  298.   ObjectList.Add(Format('Name%sType%sCharacter Set%sCollation%sDefault Value%sAllow Nulls', [DEL,DEL,DEL,DEL,DEL]));
  299.  
  300.   lQry := nil;
  301.   IBExtract := nil;
  302.   try
  303.     lQry := TIBSQl.Create (self);
  304.     IBExtract := TIBExtract.Create (self);
  305.     IBExtract.Database := Database;
  306.     lQry.Database := Database;
  307.     with lQry do
  308.     begin
  309.       Transaction := Database.DefaultTransaction;
  310.  
  311.       lSQLStr := 'SELECT A.RDB$FIELD_NAME, A.RDB$FIELD_SOURCE,B.RDB$FIELD_TYPE, B.RDB$SEGMENT_LENGTH,';
  312.       lSQLStr := Format('%s B.RDB$FIELD_SUB_TYPE,B.RDB$FIELD_LENGTH,B.RDB$FIELD_SCALE,', [lSQLStr]);
  313.       lSQLStr := Format('%s B.RDB$DEFAULT_SOURCE DEF_DOM,A.RDB$DEFAULT_SOURCE DEF_NATIVE,', [lSQLStr]);
  314.       lSQLStr := Format('%s A.RDB$NULL_FLAG NULLS1, B.RDB$NULL_FLAG NULLS2, B.RDB$SYSTEM_FLAG,', [lSQLStr]);
  315.       lSQLStr := Format('%s B.RDB$DIMENSIONS, B.RDB$CHARACTER_LENGTH, B.RDB$FIELD_PRECISION,', [lSQLStr]);
  316.       lSQLStr := Format('%s B.RDB$CHARACTER_SET_ID, B.RDB$COLLATION_ID 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 A.RDB$RELATION_NAME, RDB$FIELD_POSITION', [lSQLStr]);
  320.  
  321.       SQL.Clear;
  322.       SQL.Add(lSQLStr);
  323.       try
  324.         ExecQuery;
  325.         if not EOF then
  326.         begin
  327.           repeat
  328.           begin
  329.             lFieldType := '';
  330.             if FieldByName('RDB$DIMENSIONS').AsInteger > 0 then
  331.                lFieldType := IBExtract.GetArrayField(Trim(FieldByName('RDB$FIELD_SOURCE').AsString));
  332.  
  333.             if Pos('RDB$', TableName) = 1 then
  334.               len := FieldByName('RDB$FIELD_LENGTH').AsInteger
  335.             else
  336.               len := FieldByName('RDB$CHARACTER_LENGTH').AsInteger;
  337.  
  338.             lFieldType := Format('%s %s',[lFieldType , IBExtract.GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  339.                                                          FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  340.                                                          FieldByName('RDB$FIELD_SCALE').AsInteger,
  341.                                                          Len,
  342.                                                          FieldByName('RDB$FIELD_PRECISION').AsInteger,
  343.                                                          FieldByName('RDB$SEGMENT_LENGTH').AsInteger)]);
  344.  
  345.             Charset := '';
  346.             if not (FieldByName('RDB$CHARACTER_SET_ID').IsNull) and
  347.                (FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) then
  348.               Charset := IBExtract.GetCharacterSet (FieldByName('RDB$CHARACTER_SET_ID').AsInteger, 0, false);
  349.  
  350.             Collation := '';
  351.             if (not FieldByName('RDB$COLLATION_ID').IsNull) and
  352.                (FieldByName('RDB$COLLATION_ID').AsInteger <> 0) then
  353.               Collation := IBExtract.GetCharacterSet (FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
  354.                                                       FieldByName('RDB$COLLATION_ID').AsInteger, false);
  355.  
  356.  
  357.             lAllowNulls := 'Yes';
  358.             if FieldByName('NULLS1').AsInteger = 1 then lAllowNulls := 'No';
  359.             if FieldByName('NULLS2').AsInteger = 1 then lAllowNulls := 'No';
  360.  
  361.             lDefault := '';
  362.             if not FieldByName('DEF_DOM').IsNull then
  363.               lDefault := Trim(FieldByName('DEF_DOM').AsString);
  364.  
  365.             if not FieldByName('DEF_NATIVE').IsNull then
  366.               lDefault := Trim(FieldByName('DEF_NATIVE').AsString);
  367.  
  368.             if (Pos('RDB$', FieldByName('RDB$FIELD_SOURCE').AsString) = 0) or
  369.                (FieldByName('RDB$SYSTEM_FLAG').AsInteger = 1) then
  370.               lFieldType := Format('(%s) %s', [Trim(FieldByName('RDB$FIELD_SOURCE').AsString), lFieldType]);
  371.  
  372.             ObjectList.Add(Format('%s%s%s%s%s%s%s%s%s%s%s',[FieldByName('RDB$FIELD_NAME').AsString,DEL,
  373.                                                     lFieldType,DEL,
  374.                                                     Charset,DEL,
  375.                                                     Collation,DEL,
  376.                                                     lDefault, DEL,
  377.                                                     lAllowNulls]));
  378.             Next;
  379.           end;
  380.           until EOF;
  381.           result := SUCCESS;
  382.         end
  383.         else
  384.         begin
  385.           result := EMPTY;
  386.         end;
  387.       Close;
  388.       except
  389.         on E:EIBError do
  390.         begin
  391.           DisplayMsg(ERR_GET_COLUMNS, E.Message);
  392.           result := FAILURE;
  393.         end;
  394.       end;
  395.     end;
  396.   finally
  397.     lQry.Free;
  398.     IBExtract.Free;
  399.     Database.DefaultTransaction.Commit;    
  400.   end;
  401. end;
  402.  
  403. {****************************************************************
  404. *
  405. *  G e t D o m a i n L i s t ()
  406. *
  407. ****************************************************************
  408. *  Author: The Client Server Factory Inc.
  409. *  Date:   March 1, 1999
  410. *
  411. *  Input:  ObjectList - A list containing object details
  412. *          SelDatabaseNode - The database to be queried
  413. *          SystemData - A flag indicating whether or not to
  414. *                       display system data
  415. *  Return: integer - Success/Failure indicator
  416. *
  417. *  Description:  Retrieves a list of domains for the specified database
  418. *
  419. *****************************************************************
  420. * Revisions:
  421. *
  422. *****************************************************************}
  423. function TdmMain.GetDomainList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  424. var
  425.   lSQLStr: string;
  426.   lQry: TIBSql;
  427.  
  428. begin
  429.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  430.     SelDatabaseNode.DefaultTransaction.Commit;
  431.  
  432.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  433.  
  434.   ObjectList.Clear;
  435.   ObjectList.Append (Format('Name%sDescription', [DEL]));
  436.  
  437.   lQry := nil;
  438.   try
  439.     lQry := TIBSql.Create (self);
  440.     with lQry do
  441.     begin
  442.       result := EMPTY;
  443.       Database := SelDatabaseNode;
  444.       Transaction := SelDatabaseNode.DefaultTransaction;
  445.       lSQLStr := 'SELECT RDB$FIELD_NAME,RDB$DESCRIPTION FROM RDB$FIELDS';
  446.       if not SystemData then
  447.       begin
  448.         lSQLStr := Format('%s WHERE RDB$FIELD_NAME NOT STARTING WITH ''RDB$''',[lSQLStr]);
  449.         lSQLStr := Format('%s AND RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  450.       end
  451.       else
  452.       begin
  453.         lSQLStr := Format('%s WHERE (RDB$FIELD_NAME NOT STARTING WITH ''RDB$''',[lSQLStr]);
  454.         lSQLStr := Format('%s AND RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  455.         lSQLStr := Format('%s or rdb$system_flag = 1', [lSqlStr]);        
  456.       end;
  457.  
  458.       lSQLStr := Format('%s ORDER BY RDB$FIELD_NAME',[lSQLStr]);
  459.       SQL.Clear;
  460.       SQL.Add(lSQLStr);
  461.       try
  462.         ExecQuery;
  463.         while not EOF do
  464.         begin
  465.           ObjectList.Append (Fields[0].AsString+DEL+Fields[1].AsString);
  466.           result := Success;
  467.           Next;
  468.         end;
  469.       except
  470.         on E:EIBError do
  471.         begin
  472.           DisplayMsg(ERR_GET_DOMAINS, E.Message);
  473.           result := FAILURE;
  474.         end;
  475.       end;
  476.       Close;
  477.     end;
  478.   finally
  479.     SelDatabaseNode.DefaultTransaction.Commit;
  480.     lQry.Free;
  481.   end;
  482. end;
  483.  
  484. {****************************************************************
  485. *
  486. *  G e t E x c e p t i o n L i s t ()
  487. *
  488. ****************************************************************
  489. *  Author: The Client Server Factory Inc.
  490. *  Date:   March 1, 1999
  491. *
  492. *  Input:  ObjectList - A list containing object details
  493. *          SelDatabaseNode - The database to be queried
  494. *          SystemData - A flag indicating whether or not to
  495. *                       display system data
  496. *  Return: integer - Success/Failure indicator
  497. *
  498. *  Description:  Retrieves a list of exceptions for the specified database
  499. *
  500. *****************************************************************
  501. * Revisions:
  502. *
  503. *****************************************************************}
  504. function TdmMain.GetExceptionList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  505. var
  506.   lSQLStr: string;
  507.   lQry: TIBSql;
  508.  
  509. begin
  510.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  511.     SelDatabaseNode.DefaultTransaction.Commit;
  512.  
  513.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  514.   ObjectList.Add(Format('Name%sMessage%sDescription',[DEL,DEL]));
  515.  
  516.   lQry := nil;
  517.   try
  518.     lQry := TIBSQL.create(self);
  519.  
  520.     with lQry do
  521.     begin
  522.       Database := SelDatabaseNode;
  523.       Transaction := SelDatabaseNode.DefaultTransaction;
  524.       lSQLStr := 'SELECT RDB$EXCEPTION_NAME,RDB$MESSAGE,RDB$DESCRIPTION FROM RDB$EXCEPTIONS';
  525.  
  526.       if not SystemData then
  527.       begin
  528.         lSQLStr := Format('%s WHERE RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  529.       end;
  530.  
  531.       lSQLStr := Format('%s ORDER BY RDB$EXCEPTION_NUMBER',[lSQLStr]);
  532.       SQL.Clear;
  533.       SQL.Add(lSQLStr);
  534.       try
  535.         ExecQuery;
  536.         if not EOF then
  537.         begin
  538.           repeat
  539.           begin
  540.             ObjectList.Add(Format('%s%s%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString,
  541.               DEL, Fields[2].AsString]));
  542.             Next;
  543.           end;
  544.           until EOF;
  545.           result := SUCCESS;
  546.         end
  547.         else
  548.         begin
  549.           result := EMPTY;
  550.         end;
  551.         Close;
  552.       except
  553.         on E:EIBError do
  554.         begin
  555.           DisplayMsg(ERR_GET_EXCEPTIONS, E.Message);
  556.           result := FAILURE;
  557.         end;
  558.       end;
  559.     end;
  560.   finally
  561.     SelDatabaseNode.DefaultTransaction.Commit;
  562.     lQry.Free;
  563.   end;
  564. end;
  565.  
  566. {****************************************************************
  567. *
  568. *  G e t F u n c t i o n L i s t ()
  569. *
  570. ****************************************************************
  571. *  Author: The Client Server Factory Inc.
  572. *  Date:   March 1, 1999
  573. *
  574. *  Input:  ObjectList - A list containing object details
  575. *          SelDatabaseNode - The database to be queried
  576. *          SystemData - A flag indicating whether or not to
  577. *                       display system data
  578. *  Return: integer - Success/Failure indicator
  579. *
  580. *  Description:  Retrieves a list of functions for the specified database
  581. *
  582. *****************************************************************
  583. * Revisions:
  584. *
  585. *****************************************************************}
  586. function TdmMain.GetFunctionList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  587. var
  588.   lSQLStr: string;
  589.   lQry: TIBSql;
  590.  
  591. begin
  592.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  593.     SelDatabaseNode.DefaultTransaction.Commit;
  594.  
  595.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  596.   ObjectList.Add(Format('Name%sModule%sEntry%sDescription',[DEL,DEL,DEL]));
  597.  
  598.   lQry := nil;
  599.   try
  600.     lQry := TIBSQL.Create(self);
  601.     with lQry do
  602.     begin
  603.       Database := SelDatabaseNode;
  604.       Transaction := SelDatabaseNode.DefaultTransaction;
  605.       lSQLStr := 'SELECT RDB$FUNCTION_NAME,RDB$MODULE_NAME,RDB$ENTRYPOINT,RDB$DESCRIPTION FROM RDB$FUNCTIONS';
  606.  
  607.       lSQLStr := Format('%s ORDER BY RDB$FUNCTION_NAME',[lSQLStr]);
  608.       SQL.Clear;
  609.       SQL.Add(lSQLStr);
  610.       try
  611.         ExecQuery;
  612.         if not EOF then
  613.         begin
  614.           repeat
  615.           begin
  616.             ObjectList.Add(Format('%s%s%s%s%s%s%s',[Fields[0].AsString,DEL,
  617.               Fields[1].AsString,DEL,Fields[2].AsString, DEL, Fields[3].AsString]));
  618.             Next;
  619.           end;
  620.           until EOF;
  621.           result := SUCCESS;
  622.         end
  623.         else
  624.         begin
  625.           result := EMPTY;
  626.         end;
  627.         Close;
  628.       except
  629.         on E:EIBError do
  630.         begin
  631.           DisplayMsg(ERR_GET_FUNCTIONS, E.Message);
  632.           result := FAILURE;
  633.         end;
  634.       end;
  635.     end;
  636.   finally
  637.     SelDatabaseNode.DefaultTransaction.Commit;
  638.     lQry.Free;
  639.   end;
  640. end;
  641.  
  642. {****************************************************************
  643. *
  644. *  G e t G e n e r a t o r L i s t ()
  645. *
  646. ****************************************************************
  647. *  Author: The Client Server Factory Inc.
  648. *  Date:   March 1, 1999
  649. *
  650. *  Input:  ObjectList - A list containing object details
  651. *          SelDatabaseNode - The database to be queried
  652. *          SystemData - A flag indicating whether or not to
  653. *                       display system data
  654. *  Return: integer - Success/Failure indicator
  655. *
  656. *  Description:  Retrieves a list of generators for the specified database
  657. *
  658. *****************************************************************
  659. * Revisions:
  660. *
  661. *****************************************************************}
  662. function TdmMain.GetGeneratorList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  663. var
  664.   lSQLStr: string;
  665.   lQry, lqryGetGenNextVal: TIBSql;
  666.   lCurrGenVal: string;
  667. begin
  668.   lqryGetGenNextVal := nil;
  669.   lQry := nil;
  670.  
  671.   try
  672.     lQry := TIBSql.Create(self);
  673.  
  674.     if SelDatabaseNode.DefaultTransaction.InTransaction then
  675.       SelDatabaseNode.DefaultTransaction.Commit;
  676.  
  677.     SelDatabaseNode.DefaultTransaction.StartTransaction;
  678.     ObjectList.Add(Format('Name%sCurrent Value',[DEL]));
  679.  
  680.     lqryGetGenNextVal := TIBSQL.Create(self);
  681.     lqryGetGenNextVal.Database := SelDatabaseNode;
  682.     lqryGetGenNextVal.Transaction := SelDatabaseNode.DefaultTransaction;
  683.     with lQry do
  684.     begin
  685.       Database := SelDatabaseNode;
  686.       Transaction := SelDatabaseNode.DefaultTransaction;
  687.       lSQLStr := 'SELECT RDB$GENERATOR_NAME FROM RDB$GENERATORS';
  688.  
  689.       if not SystemData then
  690.       begin
  691.       lSQLStr := Format('%s WHERE RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  692.       end;
  693.  
  694.       lSQLStr := Format('%s ORDER BY RDB$GENERATOR_ID',[lSQLStr]);
  695.       SQL.Clear;
  696.       SQL.Add(lSQLStr);
  697.       try
  698.         ExecQuery;
  699.         if not EOF then
  700.         begin
  701.           repeat
  702.           begin
  703.             lCurrGenVal := '0';
  704.             lqryGetGenNextVal.Close;
  705.             lqryGetGenNextVal.SQL.Clear;
  706.             lqryGetGenNextVal.SQL.Add(Format('SELECT GEN_ID(%s, 0) FROM RDB$DATABASE',[Trim(Fields[0].AsString)]));
  707.             try
  708.               lqryGetGenNextVal.ExecQuery;
  709.               if not lqryGetGenNextVal.EOF then
  710.                 lCurrGenVal := lqryGetGenNextVal.Fields[0].AsString;
  711.             except
  712.               on E:EIBError do
  713.               begin
  714.                 result := FAILURE;
  715.               end;
  716.             end;
  717.  
  718.             ObjectList.Add(Format('%s%s%s',[Fields[0].AsString,DEL,lCurrGenVal]));
  719.             Next;
  720.           end;
  721.           until EOF;
  722.           result := SUCCESS;
  723.         end
  724.         else
  725.         begin
  726.           result := EMPTY;
  727.         end;
  728.         Close;
  729.       except
  730.         on E:EIBError do
  731.         begin
  732.           DisplayMsg(ERR_GET_GENERATORS, E.Message);
  733.           result := FAILURE;
  734.         end;
  735.       end;
  736.     end;
  737.   finally
  738.     lqryGetGenNextVal.Close;
  739.     lqryGetGenNextVal.Free;
  740.     SelDatabaseNode.DefaultTransaction.Commit;
  741.     lQry.Free;
  742.   end;
  743. end;
  744.  
  745. {****************************************************************
  746. *
  747. *  G e t I n d e x L i s t ()
  748. *
  749. ****************************************************************
  750. *  Author: The Client Server Factory Inc.
  751. *  Date:   March 1, 1999
  752. *
  753. *  Input:  ObjectList - A list containing object details
  754. *          SelDatabaseNode - The database to be queried
  755. *          TableName - The table to be queried
  756. *
  757. *  Return: integer - Success/Failure indicator
  758. *
  759. *  Description:  Retrieves a list of indexes for the specified database/table
  760. *
  761. *****************************************************************
  762. * Revisions:
  763. *
  764. *****************************************************************}
  765. function TdmMain.GetIndexList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  766. var
  767.   lUnique,lDescending,lActive,lSQLStr: string;
  768.   lQry: TIBSql;
  769.  
  770. begin
  771.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  772.     SelDatabaseNode.DefaultTransaction.Commit;
  773.  
  774.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  775.   ObjectList.Add(Format('Name%sUnique%sDescending%sActive',[DEL,DEL,DEL]));
  776.  
  777.   lQry := nil;
  778.   try
  779.     lQry := TIBSQL.Create (self);
  780.     with lQry do
  781.     begin
  782.       Database := SelDatabaseNode;
  783.       Transaction := SelDatabaseNode.DefaultTransaction;
  784.       lSQLStr := 'SELECT RDB$INDEX_NAME,RDB$UNIQUE_FLAG,RDB$INDEX_TYPE,RDB$INDEX_INACTIVE';
  785.       lSQLStr := Format('%s  FROM RDB$INDICES WHERE RDB$RELATION_NAME = ''%s''',[lSQLStr,TableName]);
  786.       lSQLStr := Format('%s ORDER BY RDB$INDEX_NAME',[lSQLStr]);
  787.       SQL.Clear;
  788.       SQL.Add(lSQLStr);
  789.       try
  790.         ExecQuery;
  791.         if not EOF then
  792.         begin
  793.           repeat
  794.           begin
  795.             case FieldbyName('RDB$UNIQUE_FLAG').AsInteger of
  796.               1: lUnique := 'Yes';
  797.             else
  798.               lUnique := 'No';
  799.             end;
  800.  
  801.             case FieldbyName('RDB$INDEX_TYPE').AsInteger of
  802.               1: lDescending := 'Yes';
  803.             else
  804.               lDescending := 'No';
  805.             end;
  806.  
  807.             case FieldByName('RDB$INDEX_INACTIVE').AsInteger of
  808.               1 : lActive := 'No';
  809.             else
  810.               lActive := 'Yes';
  811.             end;
  812.  
  813.             ObjectList.Add(Format('%s%s%s%s%s%s%s',[Fields[0].AsString,DEL,lUnique,DEL,lDescending,DEL,lActive]));
  814.             Next;
  815.           end;
  816.           until EOF;
  817.           result := SUCCESS;
  818.         end
  819.         else
  820.         begin
  821.           result := EMPTY;
  822.         end;
  823.         Close;
  824.       except
  825.         on E:EIBError do
  826.         begin
  827.           DisplayMsg(ERR_GET_INDICES, E.Message);
  828.           result := FAILURE;
  829.         end;
  830.       end;
  831.     end;
  832.   finally
  833.     lQry.Free;
  834.     SelDatabaseNode.DefaultTransaction.Commit;
  835.   end;
  836. end;
  837.  
  838. {****************************************************************
  839. *
  840. *  G e t P r o c e d u r e L i s t ()
  841. *
  842. ****************************************************************
  843. *  Author: The Client Server Factory Inc.
  844. *  Date:   March 1, 1999
  845. *
  846. *  Input:  ObjectList - A list containing object details
  847. *          SelDatabaseNode - The database to be queried
  848. *          SystemData - A flag indicating whether or not to
  849. *                       display system data
  850. *  Return: integer - Success/Failure indicator
  851. *
  852. *  Description:  Retrieves a list of procedures for the specified database
  853. *
  854. *****************************************************************
  855. * Revisions:
  856. *
  857. *****************************************************************}
  858. function TdmMain.GetProcedureList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  859. var
  860.   lSQLStr: string;
  861.   lQry: TIBSql;
  862.  
  863. begin
  864.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  865.     SelDatabaseNode.DefaultTransaction.Commit;
  866.  
  867.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  868.   ObjectList.Add(Format('Name%sOwner%sDescription',[DEL,DEL]));
  869.  
  870.   lQry := nil;
  871.   try
  872.     lQry := TIBSQL.Create(self);
  873.     with lQry do
  874.     begin
  875.       Database := SelDatabaseNode;
  876.       Transaction := SelDatabaseNode.DefaultTransaction;
  877.       lSQLStr := 'SELECT RDB$PROCEDURE_NAME,RDB$OWNER_NAME, RDB$DESCRIPTION FROM RDB$PROCEDURES';
  878.  
  879.       if not SystemData then
  880.       begin
  881.         lSQLStr := Format('%s WHERE RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  882.       end;
  883.  
  884.       lSQLStr := Format('%s ORDER BY RDB$PROCEDURE_NAME',[lSQLStr]);
  885.       SQL.Clear;
  886.       SQL.Add(lSQLStr);
  887.       try
  888.         ExecQuery;
  889.         if not EOF then
  890.         begin
  891.           repeat
  892.           begin
  893.             ObjectList.Add(Format('%s%s%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString, DEL, Fields[2].AsString]));
  894.             Next;
  895.           end;
  896.           until EOF;
  897.           result := SUCCESS;
  898.         end
  899.         else
  900.         begin
  901.           result := EMPTY;
  902.         end;
  903.         Close;
  904.       except
  905.         on E:EIBError do
  906.         begin
  907.           DisplayMsg(ERR_GET_PROCEDURES, E.Message);
  908.           result := FAILURE;
  909.         end;
  910.       end;
  911.     end;
  912.   finally
  913.     lQry.Free;
  914.     SelDatabaseNode.DefaultTransaction.Commit;
  915.   end;
  916. end;
  917.  
  918. {****************************************************************
  919. *
  920. *  G e t R e f e r e n t i a l C o n s t L i s t ()
  921. *
  922. ****************************************************************
  923. *  Author: The Client Server Factory Inc.
  924. *  Date:   March 1, 1999
  925. *
  926. *  Input:  ObjectList - A list containing object details
  927. *          SelDatabaseNode - The database to be queried
  928. *          TableName - The table to be queried
  929. *
  930. *  Return: integer - Success/Failure indicator
  931. *
  932. *  Description:  Retrieves a list of referential integrity contraints
  933. *  for the specified database/table
  934. *
  935. *****************************************************************
  936. * Revisions:
  937. *
  938. *****************************************************************}
  939. function TdmMain.GetReferentialConstList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  940. var
  941.   lSQLStr: string;
  942.   lQry: TIBSql;
  943.  
  944. begin
  945.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  946.     SelDatabaseNode.DefaultTransaction.Commit;
  947.  
  948.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  949.   ObjectList.Add(Format('Name%sCan Defer%sInitially Deferred%sMatch Option%sUpdate Rule%sDelete Rule%sIndex%sReference Table',
  950.                   [DEL,DEL,DEL,DEL,DEL,DEL,DEL]));
  951.  
  952.   lQry := nil;
  953.   try
  954.     lQry := TIBSQL.Create(self);
  955.     with lQry do
  956.     begin
  957.       Database := SelDatabaseNode;
  958.       Transaction := SelDatabaseNode.DefaultTransaction;
  959.       lSQLStr := 'SELECT A.RDB$CONSTRAINT_NAME,A.RDB$DEFERRABLE,A.RDB$INITIALLY_DEFERRED,';
  960.       lSQLStr := Format('%s B.RDB$MATCH_OPTION,B.RDB$UPDATE_RULE,B.RDB$DELETE_RULE,A.RDB$INDEX_NAME,C.RDB$RELATION_NAME',[lSQLStr]);
  961.       lSQLStr := Format('%s FROM RDB$RELATION_CONSTRAINTS A, RDB$REF_CONSTRAINTS B, RDB$RELATION_CONSTRAINTS C',[lSQLStr]);
  962.       lSQLStr := Format('%s WHERE A.RDB$CONSTRAINT_NAME = B.RDB$CONSTRAINT_NAME',[lSQLStr]);
  963.       lSQLStr := Format('%s AND C.RDB$CONSTRAINT_NAME = B.RDB$CONST_NAME_UQ',[lSQLStr]);
  964.       lSQLStr := Format('%s AND A.RDB$RELATION_NAME = ''%s''',[lSQLStr,TableName]);
  965.       lSQLStr := Format('%s AND (A.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' OR A.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'')',[lSQLStr]);
  966.       lSQLStr := Format('%s ORDER BY A.RDB$CONSTRAINT_NAME',[lSQLStr]);
  967.       SQL.Clear;
  968.       SQL.Add(lSQLStr);
  969.       try
  970.         ExecQuery;
  971.         if not EOF then
  972.         begin
  973.           repeat
  974.           begin
  975.             ObjectList.Add(Format('%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString,DEL,
  976.               Fields[2].AsString,DEL,Fields[3].AsString,DEL,Fields[4].AsString,DEL,Fields[5].AsString,DEL,Fields[6].AsString,DEL,
  977.               Fields[7].AsString]));
  978.             Next;
  979.           end;
  980.           until EOF;
  981.           result := SUCCESS;
  982.         end
  983.         else
  984.         begin
  985.           result := EMPTY;
  986.         end;
  987.         Close;
  988.       except
  989.         on E:EIBError do
  990.         begin
  991.           DisplayMsg(ERR_GET_REFERENTIAL_CONST, E.Message);
  992.           result := FAILURE;
  993.         end;
  994.       end;
  995.     end;
  996.   finally
  997.     lQry.Free;
  998.     SelDatabaseNode.DefaultTransaction.Commit;    
  999.   end;
  1000. end;
  1001.  
  1002. {****************************************************************
  1003. *
  1004. *  G e t R o l e L i s t ()
  1005. *
  1006. ****************************************************************
  1007. *  Author: The Client Server Factory Inc.
  1008. *  Date:   March 1, 1999
  1009. *
  1010. *  Input:  ObjectList - A list containing object details
  1011. *          SelDatabaseNode - The database to be queried
  1012. *
  1013. *  Return: integer - Success/Failure indicator
  1014. *
  1015. *  Description:  Retrieves a list of roles for the specified database
  1016. *
  1017. *****************************************************************
  1018. * Revisions:
  1019. *
  1020. *****************************************************************}
  1021. function TdmMain.GetRoleList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase): integer;
  1022. var
  1023.   lSQLStr: string;
  1024.   lQry: TIBSql;
  1025.  
  1026. begin
  1027.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1028.     SelDatabaseNode.DefaultTransaction.Commit;
  1029.  
  1030.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1031.   ObjectList.Add(Format('Name%sOwner',[DEL]));
  1032.  
  1033.   lQry := nil;
  1034.   try
  1035.     lQry := TIBSQL.Create(self);
  1036.     with lQry do
  1037.     begin
  1038.       Database := SelDatabaseNode;
  1039.       Transaction := SelDatabaseNode.DefaultTransaction;
  1040.       lSQLStr := 'SELECT RDB$ROLE_NAME,RDB$OWNER_NAME';
  1041.       lSQLStr := Format('%s FROM RDB$ROLES',[lSQLStr]);
  1042.       lSQLStr := Format('%s ORDER BY RDB$OWNER_NAME, RDB$ROLE_NAME',[lSQLStr]);
  1043.       SQL.Clear;
  1044.       SQL.Add(lSQLStr);
  1045.       try
  1046.         ExecQuery;
  1047.         if not EOF then
  1048.         begin
  1049.           repeat
  1050.           begin
  1051.             ObjectList.Add(Format('%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString]));
  1052.             Next;
  1053.           end;
  1054.           until EOF;
  1055.           result := SUCCESS;
  1056.         end
  1057.         else
  1058.         begin
  1059.           result := EMPTY;
  1060.         end;
  1061.       Close;
  1062.       except
  1063.         on E:EIBError do
  1064.         begin
  1065.           DisplayMsg(ERR_GET_ROLES, E.Message);
  1066.           result := FAILURE;
  1067.         end;
  1068.       end;
  1069.     end;
  1070.   finally
  1071.     lQry.Free;
  1072.     SelDatabaseNode.DefaultTransaction.Commit;
  1073.   end;
  1074. end;
  1075.  
  1076. {****************************************************************
  1077. *
  1078. *  G e t T a b l e D a t a ()
  1079. *
  1080. ****************************************************************
  1081. *  Author: The Client Server Factory Inc.
  1082. *  Date:   March 1, 1999
  1083. *
  1084. *  Input:  SelDatabaseNode - The database to be queried
  1085. *          SelTableName - The table to be queried
  1086. *
  1087. *
  1088. *  Return: boolean - Success/Failure indicator
  1089. *
  1090. *  Description:  Retrieves the data for the specified table
  1091. *
  1092. *****************************************************************
  1093. * Revisions:
  1094. *
  1095. *****************************************************************}
  1096. function TdmMain.GetTableData(var SelDatabaseNode: TIBDatabase;
  1097.                               var DataSet: TIBDataSet;
  1098.                               const SelTableName: string): boolean;
  1099. var
  1100.   tableName: string;
  1101.  
  1102. begin
  1103.   result := true;
  1104.   try
  1105.     with Dataset do
  1106.     begin
  1107.       if Active then
  1108.       begin
  1109.         ApplyUpdates;
  1110.         if Transaction.InTransaction then
  1111.           Transaction.Commit;
  1112.         Active := false;
  1113.       end;
  1114.       Transaction.StartTransaction;
  1115.     end;
  1116.     if SelDatabaseNode.SQLDialect > 1 then
  1117.       tableName := Format('"%s"', [SelTableName])
  1118.     else
  1119.       tableName := SelTableName;
  1120.  
  1121.     Dataset.SelectSQL.Text :=  Format('SELECT * FROM %s',[TableName]);
  1122. //    Dataset.RefreshSQL.Text := Format('SELECT * FROM %s',[TableName]);
  1123.     Dataset.Prepare;
  1124. //    Dataset.Open;
  1125. //    CreateDynSQL(Dataset, TableName);
  1126. //    Dataset.Close;
  1127.     Dataset.Open;
  1128.     Dataset.FetchAll;
  1129.   except
  1130.     on E:EIBError do
  1131.     begin
  1132.       DisplayMsg(ERR_GET_TABLE_DATA, E.Message);
  1133.       Screen.Cursor := crDefault;
  1134.       result := false;
  1135.     end;
  1136.   end;
  1137. end;
  1138.  
  1139. {****************************************************************
  1140. *
  1141. *  G e t O w n e r I n f o ()
  1142. *
  1143. ****************************************************************
  1144. *  Author: The Client Server Factory Inc.
  1145. *  Date:   March 1, 1999
  1146. *
  1147. *  Input:
  1148. *
  1149. *  Return: integer - Success/Failure indicator
  1150. *
  1151. *  Description:  Retrieves detail info for a specified table
  1152. *
  1153. *****************************************************************
  1154. * Revisions:
  1155. *
  1156. *****************************************************************}
  1157. function TdmMain.GetOwnerInfo(var OwnerName, Description: string; const SelDatabaseNode: TIBDatabase; const Node: TibcTreeNode): integer;
  1158. var
  1159.   lSQLStr,
  1160.   FldName,
  1161.   RelName,
  1162.   Flds,
  1163.   ObjName:  string;
  1164.  
  1165.   lQry: TIBSql;
  1166.  
  1167. begin
  1168.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1169.     SelDatabaseNode.DefaultTransaction.Commit;
  1170.  
  1171.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1172.  
  1173.   ObjName := Node.NodeName;
  1174.   case Node.NodeType of
  1175.     NODE_PROCEDURE:
  1176.     begin
  1177.       Flds := 'RDB$OWNER_NAME, RDB$DESCRIPTION';
  1178.       FldName := 'RDB$PROCEDURE_NAME';
  1179.       RelName := 'RDB$PROCEDURES';
  1180.     end;
  1181.  
  1182.     NODE_TABLE,
  1183.     NODE_VIEW:
  1184.     begin
  1185.       Flds := 'RDB$OWNER_NAME, RDB$DESCRIPTION';
  1186.       FldName := 'RDB$RELATION_NAME';
  1187.       RelName := 'RDB$RELATIONS';
  1188.     end;
  1189.     NODE_ROLE:
  1190.     begin
  1191.       Flds := 'RDB$OWNER_NAME';
  1192.       FldName := 'RDB$ROLE_NAME';
  1193.       RelName := 'RDB$ROLES';
  1194.     end;
  1195.     else
  1196.     begin
  1197.       result := Failure;
  1198.       exit;
  1199.     end;
  1200.   end;
  1201.  
  1202.   lQry := nil;
  1203.   try
  1204.     lQry := TIBSQL.Create(self);
  1205.     with lQry do
  1206.     begin
  1207.       Database := SelDatabaseNode;
  1208.       Transaction := SelDatabaseNode.DefaultTransaction;
  1209.       lSQLStr := Format('SELECT %s FROM %s', [Flds, RelName]);
  1210.       lSQLStr := Format('%s WHERE %s = ''%s''',[lSQLStr, FldName, ObjName]);
  1211.       SQL.Clear;
  1212.       SQL.Add(lSQLStr);
  1213.       try
  1214.         ExecQuery;
  1215.         if not EOF then
  1216.         begin
  1217.           OwnerName := Fields[0].AsString;
  1218.  
  1219.           if Node.NodeType <> NODE_ROLE then
  1220.             Description := Fields[1].AsString;
  1221.           result := SUCCESS;
  1222.         end
  1223.         else
  1224.         begin
  1225.           result := EMPTY;
  1226.         end;
  1227.         Close;
  1228.       except
  1229.         on E:EIBError do
  1230.         begin
  1231.           DisplayMsg(ERR_GET_TABLES, E.Message);
  1232.           result := FAILURE;
  1233.         end;
  1234.       end;
  1235.     end;
  1236.   finally
  1237.     lQry.Free;
  1238.     SelDatabaseNode.DefaultTransaction.Commit;
  1239.   end;
  1240. end;
  1241.  
  1242. {****************************************************************
  1243. *
  1244. *  G e t T a b l e L i s t ()
  1245. *
  1246. ****************************************************************
  1247. *  Author: The Client Server Factory Inc.
  1248. *  Date:   March 1, 1999
  1249. *
  1250. *  Input:  ObjectList - A list containing object details
  1251. *          SelDatabaseNode - The database to be queried
  1252. *          SystemData - A flag indicating whether or not to
  1253. *                       display system data
  1254. *  Return: integer - Success/Failure indicator
  1255. *
  1256. *  Description:  Retrieves a list of tables for the specified database
  1257. *
  1258. *****************************************************************
  1259. * Revisions:
  1260. *
  1261. *****************************************************************}
  1262. function TdmMain.GetTableList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  1263. var
  1264.   lSQLStr: string;
  1265.   lQry: TIBSql;
  1266. begin
  1267.  
  1268.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1269.     SelDatabaseNode.DefaultTransaction.Commit;
  1270.  
  1271.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1272.   ObjectList.Add(Format('Name%sOwner%sDescription',[DEL,DEL]));
  1273.   lQry := nil;
  1274.   try
  1275.     lQry := TIBSQL.Create (self);
  1276.     with lQry do
  1277.     begin
  1278.       Database := SelDatabaseNode;
  1279.       Transaction := SelDatabaseNode.DefaultTransaction;
  1280.       lSQLStr := 'SELECT RDB$RELATION_NAME,RDB$OWNER_NAME,RDB$DESCRIPTION FROM RDB$RELATIONS';
  1281.       lSQLStr := Format('%s WHERE RDB$RELATION_NAME NOT IN (',[lSQLStr]);
  1282.       lSQLStr := Format('%s SELECT RDB$VIEW_NAME FROM RDB$VIEW_RELATIONS)',[lSQLStr]);
  1283.  
  1284.       if not SystemData then
  1285.       begin
  1286.         lSQLStr := Format('%s AND RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  1287.       end;
  1288.  
  1289.       lSQLStr := Format('%s ORDER BY RDB$RELATION_NAME',[lSQLStr]);
  1290.       SQL.Clear;
  1291.       SQL.Add(lSQLStr);
  1292.       try
  1293.         ExecQuery;
  1294.         if not EOF then
  1295.         begin
  1296.           repeat
  1297.           begin
  1298.             ObjectList.Add(Format('%s%s%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString,DEL,Fields[2].AsString]));
  1299.             Next;
  1300.           end;
  1301.           until EOF;
  1302.           result := SUCCESS;
  1303.         end
  1304.         else
  1305.         begin
  1306.           result := EMPTY;
  1307.         end;
  1308.         Close;
  1309.       except
  1310.         on E:EIBError do
  1311.         begin
  1312.           DisplayMsg(ERR_GET_TABLES, E.Message);
  1313.           result := FAILURE;
  1314.         end;
  1315.       end;
  1316.     end;
  1317.   finally
  1318.     lQry.Free;
  1319.     SelDatabaseNode.DefaultTransaction.Commit;    
  1320.   end;
  1321. end;
  1322.  
  1323. {****************************************************************
  1324. *
  1325. *  G e t T r i g g e r L i s t ()
  1326. *
  1327. ****************************************************************
  1328. *  Author: The Client Server Factory Inc.
  1329. *  Date:   March 1, 1999
  1330. *
  1331. *  Input:  ObjectList - A list containing object details
  1332. *          SelDatabaseNode - The database to be queried
  1333. *          TableName - The table to be queried
  1334. *
  1335. *  Return: integer - Success/Failure indicator
  1336. *
  1337. *  Description:  Retrieves a list of triggers for the specified database/table
  1338. *
  1339. *****************************************************************
  1340. * Revisions:
  1341. *
  1342. *****************************************************************}
  1343. function TdmMain.GetTriggerList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  1344. var
  1345.   lQry: TIBSql;
  1346.   lActive, lSource,
  1347.   lTriggerType, lSQLStr: string;
  1348. begin
  1349.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1350.     SelDatabaseNode.DefaultTransaction.Commit;
  1351.  
  1352.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1353.   ObjectList.Add(Format('Name%sType%sActive',[DEL,DEL]));
  1354.   lQry := nil;
  1355.  
  1356.   try
  1357.     lQry := TIBSQl.Create (self);
  1358.  
  1359.     with lQry do
  1360.     begin
  1361.       Database := SelDatabaseNode;
  1362.       Transaction := SelDatabaseNode.DefaultTransaction;
  1363.       lSQLStr := 'SELECT RDB$TRIGGER_NAME,RDB$TRIGGER_TYPE, RDB$TRIGGER_INACTIVE,';
  1364.       lSQLStr := Format('%s RDB$TRIGGER_SOURCE FROM RDB$TRIGGERS', [lSqlStr]);
  1365.       lSQLStr := Format('%s WHERE RDB$RELATION_NAME = ''%s''',[lSQLStr,TableName]);
  1366.       lSQLStr := Format('%s AND RDB$TRIGGER_NAME NOT IN ', [lSQLStr]);
  1367.       lSQLStr := Format('%s (SELECT RDB$TRIGGER_NAME FROM RDB$CHECK_CONSTRAINTS)',[lSQLStr]);
  1368.       lSQLStr := Format('%s ORDER BY RDB$TRIGGER_NAME',[lSQLStr]);
  1369.       SQL.Clear;
  1370.       SQL.Add(lSQLStr);
  1371.       try
  1372.         ExecQuery;
  1373.         if not EOF then
  1374.         begin
  1375.           repeat
  1376.           begin
  1377.             case FieldbyName('RDB$TRIGGER_TYPE').AsInteger of
  1378.               1: lTriggerType := 'BEFORE INSERT';
  1379.               2: lTriggerType := 'AFTER INSERT';
  1380.               3: lTriggerType := 'BEFORE UPDATE';
  1381.               4: lTriggerType := 'AFTER UPDATE';
  1382.               5: lTriggerType := 'BEFORE DELETE';
  1383.               6: lTriggerType := 'AFTER DELETE';
  1384.             else
  1385.               lTriggerType := '';
  1386.             end;
  1387.  
  1388.             if FieldByName('RDB$TRIGGER_TYPE').AsInteger = 1 then
  1389.               lActive := 'InActive'
  1390.             else
  1391.               lActive := 'Active';
  1392.  
  1393.             if FieldByName('RDB$TRIGGER_SOURCE').IsNull then
  1394.               lSource := 'Not Available'
  1395.             else
  1396.               lSource := FieldByName('RDB$TRIGGER_SOURCE').AsString;
  1397.  
  1398.             ObjectList.Add(Format('%s%s%s%s%s%s%s',[Fields[0].AsString,DEL,
  1399.               lTriggerType, DEL, lActive, DEL, lSource]));
  1400.             Next;
  1401.           end;
  1402.           until EOF;
  1403.           result := SUCCESS;
  1404.         end
  1405.         else
  1406.         begin
  1407.           result := EMPTY;
  1408.         end;
  1409.         Close;
  1410.       except
  1411.         on E:EIBError do
  1412.         begin
  1413.           DisplayMsg(ERR_GET_TRIGGERS, E.Message);
  1414.           result := FAILURE;
  1415.         end;
  1416.       end;
  1417.     end;
  1418.   finally
  1419.     SelDatabaseNode.DefaultTransaction.Commit;
  1420.     lQry.Free;
  1421.   end;
  1422. end;
  1423.  
  1424. {****************************************************************
  1425. *
  1426. *  G e t U n i q u e C o n s t L i s t ()
  1427. *
  1428. ****************************************************************
  1429. *  Author: The Client Server Factory Inc.
  1430. *  Date:   March 1, 1999
  1431. *
  1432. *  Input:  ObjectList - A list containing object details
  1433. *          SelDatabaseNode - The database to be queried
  1434. *          TableName - The table to be queried
  1435. *
  1436. *  Return: integer - Success/Failure indicator
  1437. *
  1438. *  Description:  Retrieves a list of unique constraints for
  1439. *  the specified database/table
  1440. *
  1441. *****************************************************************
  1442. * Revisions:
  1443. *
  1444. *****************************************************************}
  1445. function TdmMain.GetUniqueConstList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const TableName: string): integer;
  1446. var
  1447.   lSQLStr: string;
  1448.   lQry: TIBSql;
  1449. begin
  1450.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1451.     SelDatabaseNode.DefaultTransaction.Commit;
  1452.  
  1453.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1454.   ObjectList.Add(Format('Name%sCan Defer%sInitially Deferred%sIndex',[DEL,DEL,DEL]));
  1455.  
  1456.   lQry := nil;
  1457.   try
  1458.     lQry := TIBSQL.Create(self);
  1459.     with lQry do
  1460.     begin
  1461.       Database := SelDatabaseNode;
  1462.       Transaction := SelDatabaseNode.DefaultTransaction;
  1463.       lSQLStr := 'SELECT RDB$CONSTRAINT_NAME,RDB$DEFERRABLE,RDB$INITIALLY_DEFERRED,RDB$INDEX_NAME FROM RDB$RELATION_CONSTRAINTS';
  1464.       lSQLStr := Format('%s WHERE RDB$RELATION_NAME = ''%s''',[lSQLStr,TableName]);
  1465.       lSQLStr := Format('%s AND RDB$CONSTRAINT_TYPE = ''UNIQUE''',[lSQLStr]);
  1466.       lSQLStr := Format('%s ORDER BY RDB$CONSTRAINT_NAME',[lSQLStr]);
  1467.       SQL.Clear;
  1468.       SQL.Add(lSQLStr);
  1469.       try
  1470.         ExecQuery;
  1471.         if not EOF then
  1472.         begin
  1473.           repeat
  1474.           begin
  1475.             ObjectList.Add(Format('%s%s%s%s%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString,DEL,Fields[2].AsString,DEL,Fields[3].AsString]));
  1476.             Next;
  1477.           end;
  1478.           until EOF;
  1479.           result := SUCCESS;
  1480.         end
  1481.         else
  1482.         begin
  1483.           result := EMPTY;
  1484.         end;
  1485.         Close;
  1486.       except
  1487.         on E:EIBError do
  1488.         begin
  1489.           DisplayMsg(ERR_GET_UNIQUE_CONST, E.Message);
  1490.           result := FAILURE;
  1491.         end;
  1492.       end;
  1493.     end;
  1494.   finally
  1495.     lQry.Free;
  1496.     SelDatabaseNode.DefaultTransaction.Commit;    
  1497.   end;
  1498. end;
  1499.  
  1500. {****************************************************************
  1501. *
  1502. *  G e t V i e w L i s t ()
  1503. *
  1504. ****************************************************************
  1505. *  Author: The Client Server Factory Inc.
  1506. *  Date:   March 1, 1999
  1507. *
  1508. *  Input:  ObjectList - A list containing object details
  1509. *          SelDatabaseNode - The database to be queried
  1510. *          SystemData - A flag indicating whether or not to
  1511. *                       display system data
  1512. *  Return: integer - Success/Failure indicator
  1513. *
  1514. *  Description:  Retrieves a list of views for the specified database
  1515. *
  1516. *****************************************************************
  1517. * Revisions:
  1518. *
  1519. *****************************************************************}
  1520. function TdmMain.GetViewList(var ObjectList: TStringList; const SelDatabaseNode: TIBDatabase; const SystemData: boolean): integer;
  1521. var
  1522.   lSQLStr   : String;
  1523.   lQry: TIBSQl;
  1524.  
  1525. begin
  1526.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1527.     SelDatabaseNode.DefaultTransaction.Commit;
  1528.  
  1529.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1530.   ObjectList.Add(Format('Name%sOwner%sDescription',[DEL,DEL]));
  1531.  
  1532.   lQry := nil;
  1533.   try
  1534.     lQry := TIBSQL.Create(self);
  1535.     with lQry do
  1536.     begin
  1537.       Database := SelDatabaseNode;
  1538.       Transaction := SelDatabaseNode.DefaultTransaction;
  1539.  
  1540.       lSQLStr := 'SELECT DISTINCT A.RDB$RELATION_NAME,A.RDB$OWNER_NAME,A.RDB$DESCRIPTION';
  1541.       lSQLStr := Format('%s FROM RDB$RELATIONS A, RDB$VIEW_RELATIONS B', [lSQLStr]);
  1542.       lSQLStr := Format('%s WHERE A.RDB$RELATION_NAME = B.RDB$VIEW_NAME', [lSQLStr]);
  1543.       lSQLStr := Format('%s ORDER BY A.RDB$RELATION_ID', [lSQLStr]);
  1544.       SQL.Clear;
  1545.       SQL.Add(lSQLStr);
  1546.       try
  1547.         ExecQuery;
  1548.         if not EOF then
  1549.         begin
  1550.           repeat
  1551.           begin
  1552.             ObjectList.Add(Format('%s%s%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString,DEL,Fields[2].AsString]));
  1553.             Next;
  1554.           end;
  1555.           until EOF;
  1556.           result := SUCCESS;
  1557.         end
  1558.         else
  1559.         begin
  1560.           result := EMPTY;
  1561.         end;
  1562.         Close;
  1563.       except
  1564.         on E:EIBError do
  1565.         begin
  1566.           DisplayMsg(ERR_GET_VIEWS, E.Message);
  1567.           result := FAILURE;
  1568.         end;
  1569.       end;
  1570.     end;
  1571.   finally
  1572.     lQry.Free;
  1573.     SelDatabaseNode.DefaultTransaction.Commit;
  1574.   end;
  1575. end;
  1576.  
  1577. {****************************************************************
  1578. *
  1579. *  G e t D B F i l e s ( )
  1580. *
  1581. ****************************************************************
  1582. *  Author: The Client Server Factory Inc.
  1583. *  Date:   March 1, 1999
  1584. *
  1585. *  Input:
  1586. *
  1587. *  Return: integer - Success/Failure indicator
  1588. *
  1589. *  Description:
  1590. *
  1591. *****************************************************************
  1592. * Revisions:
  1593. *
  1594. *****************************************************************}
  1595. function TdmMain.GetDBFiles(var ObjectList: TStringList; const SelServerNode: TibcServerNode; const SelDatabaseNode: TibcDatabaseNode): integer;
  1596. var
  1597.   lqryDBFiles: TIBSql;
  1598.   IsDBConnected: boolean;
  1599. begin
  1600.   lqryDBFiles := TIBSQL.Create(Self);
  1601.   IsDBConnected := False;
  1602.   Result := SUCCESS;
  1603.   try
  1604.     IsDBConnected := SelDatabaseNode.Database.Connected;
  1605.     if not SelDatabaseNode.Database.Connected then
  1606.     begin
  1607.       if SelDatabaseNode.DatabaseFiles.Count > 0 then
  1608.       begin
  1609.         case SelServerNode.Server.Protocol of
  1610.           TCP: SelDatabaseNode.Database.DatabaseName := Format('%s:%s',[SelServerNode.ServerName,SelDatabaseNode.DatabaseFiles.Strings[0]]);
  1611.           NamedPipe: SelDatabaseNode.Database.DatabaseName := Format('\\%s\%s',[SelServerNode.ServerName,SelDatabaseNode.DatabaseFiles.Strings[0]]);
  1612.           SPX: SelDatabaseNode.Database.DatabaseName := Format('%s@%s',[SelServerNode.ServerName,SelDatabaseNode.DatabaseFiles.Strings[0]]);
  1613.           Local: SelDatabaseNode.Database.DatabaseName := SelDatabaseNode.DatabaseFiles.Strings[0];
  1614.         end;
  1615.       end;
  1616.       SelDatabaseNode.Database.Params.Clear;
  1617.       SelDatabaseNode.Database.Params.Add(Format('isc_dpb_user_name=%s',[SelServerNode.UserName]));
  1618.       SelDatabaseNode.Database.Params.Add(Format('isc_dpb_password=%s',[SelServerNode.Password]));
  1619.       SelDatabaseNode.Database.Connected := true;
  1620.       Application.ProcessMessages;
  1621.     end;
  1622.  
  1623.     if SelDatabaseNode.Database.DefaultTransaction.InTransaction then
  1624.       SelDatabaseNode.Database.DefaultTransaction.Commit;
  1625.  
  1626.     SelDatabaseNode.Database.DefaultTransaction.StartTransaction;
  1627.  
  1628.     lqryDBFiles.Database := SelDatabaseNode.Database;
  1629.     lqryDBFiles.Transaction := SelDatabaseNode.Database.DefaultTransaction;
  1630.  
  1631.      with lqryDBFiles do
  1632.      begin
  1633.        SQL.Clear;
  1634.        SQL.Add('SELECT RDB$FILE_NAME, RDB$FILE_LENGTH FROM RDB$FILES ' +
  1635.                'WHERE RDB$SHADOW_NUMBER < 1 OR RDB$SHADOW_NUMBER IS NULL ' +
  1636.                'ORDER BY RDB$FILE_SEQUENCE ASC');
  1637.        try
  1638.          ExecQuery;
  1639.          while not EOF do
  1640.          begin
  1641.            ObjectList.Add(Format('%s%s%s',[Fields[0].AsString,DEL,Fields[1].AsString]));
  1642.            Next;
  1643.          end;
  1644.        except
  1645.          on E:EIBError do
  1646.          begin
  1647.            DisplayMsg(ERR_GET_DB_PROPERTIES,E.Message + ' Secondary files unavailable.');
  1648.            Result := FAILURE;
  1649.          end;
  1650.        end;
  1651.      end;
  1652.   finally
  1653.     lqryDBFiles.Close;
  1654.     lqryDBFiles.Free;
  1655.     if not SelDatabaseNode.Database.Connected = IsDBConnected then
  1656.       SelDatabaseNode.Database.Connected := IsDBConnected;
  1657.   end;
  1658. end;
  1659.  
  1660. /////////////////////////////////////////////////////////////////////////////////////////
  1661. function TdmMain.GetProcedureInfo(var ObjectList: TStringList;
  1662.                                   var Source: TStringList;
  1663.   const SelDatabaseNode: TIBDatabase; const ProcName: String): integer;
  1664. var
  1665.   lSQLStr,
  1666.   lParamType,
  1667.   lFieldType: String;
  1668.   lQry: TIBSql;
  1669.   IBExtract: TIBExtract;
  1670.  
  1671. begin
  1672.   result := FAILURE;
  1673.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1674.     SelDatabaseNode.DefaultTransaction.Commit;
  1675.  
  1676.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1677.   ObjectList.Add(Format('Parameter%sType%sInput/Output',[DEL,DEL]));
  1678.  
  1679.   lQry := nil;
  1680.   IBExtract := nil;
  1681.   try
  1682.     lQry := TIBSQL.Create(self);
  1683.     IBExtract := TIBExtract.create(self);
  1684.     IBExtract.Database := SelDatabaseNode;
  1685.     with lQry do
  1686.     begin
  1687.       Database := SelDatabaseNode;
  1688.       Transaction := SelDatabaseNode.DefaultTransaction;
  1689.       lSQLStr := 'select p.rdb$procedure_source, p.rdb$description, pp.rdb$parameter_name,';
  1690.       lSQLStr := Format('%s pp.rdb$parameter_type, f.rdb$field_type, f.rdb$field_sub_type,',[lSQLStr]);
  1691.       lSQLStr := Format('%s f.rdb$FIELD_length, f.rdb$field_scale, f.rdb$character_length,',[lSQLStr]);
  1692.       lSQLStr := Format('%s f.rdb$field_precision from rdb$procedures p,', [lSQLStr]);
  1693.       lSQLStr := Format('%s rdb$procedure_parameters pp,rdb$fields f where', [lSQLStr]);
  1694.       lSQLStr := Format('%s p.rdb$procedure_name = ''%s'' and', [lSQLStr, ProcName]);
  1695.       lSQLStr := Format('%s pp.rdb$procedure_name = p.rdb$procedure_name and', [lSQLStr]);
  1696.       lSQLStr := Format('%s f.rdb$field_name = pp.rdb$field_source', [lSQLStr]);
  1697.       SQL.Clear;
  1698.       SQL.Add(lSQLStr);
  1699.       try
  1700.         ExecQuery;
  1701.         if not EOF then
  1702.           Source.Add (FieldByName('RDB$PROCEDURE_SOURCE').AsString);
  1703.         while not EOF do
  1704.         begin
  1705.           lFieldType := IBExtract.GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  1706.                           FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  1707.                           FieldByName('RDB$FIELD_SCALE').AsInteger,
  1708.                           FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  1709.                           FieldByName('RDB$FIELD_PRECISION').AsInteger,
  1710.                           0);
  1711.           lParamType := 'Output';
  1712.           if FieldByName('RDB$PARAMETER_TYPE').AsInteger = 0 then
  1713.             lParamType := 'Input';
  1714.  
  1715.           ObjectList.Add(Format('%s%s%s%s%s',[FieldByName('RDB$PARAMETER_NAME').AsString,
  1716.                                                   DEL,
  1717.                                                   lFieldType,
  1718.                                                   DEL,
  1719.                                                   lParamType]));
  1720.  
  1721.           Next;
  1722.           result := SUCCESS;
  1723.         end;
  1724.         Close;
  1725.       except
  1726.         on E:EIBError do
  1727.         begin
  1728.           DisplayMsg(ERR_GET_PROCEDURES, E.Message);
  1729.           result := FAILURE;
  1730.         end;
  1731.       end;
  1732.     end;
  1733.   finally
  1734.     lQry.Free;
  1735.     IBExtract.Free;
  1736.     SelDatabaseNode.DefaultTransaction.Commit;
  1737.   end;
  1738. end;
  1739.  
  1740. function TdmMain.GetFunctiondata(var ObjectList: TStringList;
  1741.                                  out ModuleName,
  1742.                                      EntryPoint,
  1743.                                      Returnval: String;
  1744.                                  const SelDatabaseNode: TIBDatabase;
  1745.                                  const FuncName: String): integer;
  1746. var
  1747.   lSQLStr,
  1748.   lParamType,
  1749.   lFieldType: String;
  1750.   lQry: TIBSQL;
  1751.   IBExtract: TIBExtract;
  1752. begin
  1753.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1754.     SelDatabaseNode.DefaultTransaction.Commit;
  1755.  
  1756.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1757.   ObjectList.Add(Format('Parameter%sType',[DEL]));
  1758.  
  1759.   lQry := nil;
  1760.   IBExtract := nil;
  1761.   try
  1762.     lQry := TIBSQL.Create(self);
  1763.     IBExtract := TIBExtract.Create(self);
  1764.     with lQry do
  1765.     begin
  1766.       Database := SelDatabaseNode;
  1767.       Transaction := SelDatabaseNode.DefaultTransaction;
  1768.       lSQLStr := 'select rdb$return_argument, rdb$argument_position, rdb$mechanism,';
  1769.       lSQLStr := Format('%s rdb$module_name, rdb$entrypoint, rdb$field_type,', [lSQLStr]);
  1770.       lSQLStr := Format('%s rdb$field_scale, rdb$field_length, rdb$field_sub_type,',[lSQLStr]);
  1771.       lSQLStr := Format('%s rdb$field_precision, rdb$character_length from rdb$functions f,',[lSQLStr]);
  1772.       lSQLStr := Format('%s rdb$function_arguments fa where rdb$function_name = ''%s''',[lSQLStr, FuncName]);
  1773.       lSQLStr := Format('%s and fa.rdb$function_name = f.rdb$function_name',[lSQLStr, FuncName]);
  1774.  
  1775.       SQL.Clear;
  1776.       SQL.Add(lSQLStr);
  1777.       try
  1778.         ExecQuery;
  1779.         while not EOF do
  1780.         begin
  1781.           ModuleName := Trim(FieldByName('RDB$MODULE_NAME').AsString);
  1782.           EntryPoint := Trim(FieldByName('RDB$ENTRYPOINT').AsString);
  1783.  
  1784.           lFieldType := IBExtract.GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  1785.                           FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  1786.                           FieldByName('RDB$FIELD_SCALE').AsInteger,
  1787.                           FieldByName('RDB$CHARACTER_LENGTH').AsInteger,
  1788.                           FieldByName('RDB$FIELD_PRECISION').AsInteger,
  1789.                           0);
  1790.  
  1791.           lParamType := '';
  1792.           if Abs(FieldByName('RDB$MECHANISM').AsInteger) = 1 then
  1793.             lParamType := 'BY REFERENCE';
  1794.  
  1795.           if FieldByName('RDB$MECHANISM').AsInteger < 0 then
  1796.             lParamType := Format ('%s FREE IT', [lParamType]);
  1797.  
  1798.           if (FieldByName('RDB$RETURN_ARGUMENT').AsInteger <>
  1799.               FieldByName('RDB$ARGUMENT_POSITION').AsInteger) then
  1800.               ObjectList.Add(Format('Parameter %d%s%s',
  1801.                              [FieldByName('RDB$ARGUMENT_POSITION').AsInteger,
  1802.                              DEL,
  1803.                              lFieldType]))
  1804.           else
  1805.             ReturnVal := Format ('RETURNS %s %s', [lFieldType, lParamType]);
  1806.  
  1807.           Next;
  1808.         end;
  1809.         result := SUCCESS;
  1810.         Close;
  1811.       except
  1812.         on E:EIBError do
  1813.         begin
  1814.           DisplayMsg(ERR_GET_FUNCTIONS, E.Message);
  1815.           result := FAILURE;
  1816.         end;
  1817.       end;
  1818.     end;
  1819.   finally
  1820.     IBExtract.Free;
  1821.     lQry.Free;
  1822.     SelDatabaseNode.DefaultTransaction.Commit;
  1823.   end;
  1824. end;
  1825.  
  1826. function TdmMain.GetFilterData(var ObjectList: TStringList;
  1827.   const SelDatabaseNode: TIBDatabase; const FuncName: String): integer;
  1828. var
  1829.   lQry: TIBSQL;
  1830.  
  1831. begin
  1832.   result := FAILURE;
  1833.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1834.     SelDatabaseNode.DefaultTransaction.Commit;
  1835.  
  1836.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1837.  
  1838.   lQry := nil;
  1839.   try
  1840.     lQry := TIBSQL.Create(self);
  1841.     with lQry do
  1842.     begin
  1843.       Database := SelDatabaseNode;
  1844.       Transaction := SelDatabaseNode.DefaultTransaction;
  1845.       SQL.Clear;
  1846.       SQL.Add('select * from rdb$filters order by rdb$function_name');
  1847.       try
  1848.         ExecQuery;
  1849.         while not EOF do
  1850.         begin
  1851.           ObjectList.Add(Format('%s%s%s%s%s%s%s%s',[FieldByName('RDB$MODULE_NAME').AsString,
  1852.                          DEL,
  1853.                          FieldByName('RDB$ENTRYPOINT').AsString,
  1854.                          DEL,
  1855.                          FieldByName('RDB$INPUT_SUB_TYPE').AsString,
  1856.                          DEL,
  1857.                          FieldByName('RDB$OUTPUT_SUB_TYPE').AsString,
  1858.                          DEL,
  1859.                          FieldByName('RDB$DESCRIPTION').AsString]));
  1860.           Next;
  1861.           result := SUCCESS;
  1862.         end;
  1863.         Close;
  1864.       except
  1865.         on E:EIBError do
  1866.         begin
  1867.           DisplayMsg(ERR_GET_BLOB_FILTERS, E.Message);
  1868.           result := FAILURE;
  1869.         end;
  1870.       end;
  1871.     end;
  1872.   finally
  1873.     lQry.Free;
  1874.     SelDatabaseNode.DefaultTransaction.Commit;    
  1875.   end;
  1876. end;
  1877.  
  1878. function TdmMain.GetRoleData(var ObjectList: TStringList;
  1879.   const SelDatabaseNode: TIBDatabase; const RoleName: String): integer;
  1880. var
  1881.   lSQLStr: String;
  1882.   lQry: TIBSql;
  1883.  
  1884. begin
  1885.   result := FAILURE;
  1886.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1887.     SelDatabaseNode.DefaultTransaction.Commit;
  1888.  
  1889.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1890.   lSQLStr := 'select rdb$role_name, rdb$owner_name, rdb$user from rdb$roles, rdb$user_privileges';
  1891.   lSQLStr := Format('%s where rdb$relation_name=rdb$role_name', [lSQLStr]);
  1892.   lSQLStr := Format('%s order by rdb$role_name', [lSQLStr]);  
  1893.   ObjectList.Add(Format('Owner%sMember',[DEL]));
  1894.  
  1895.   lQry := nil;
  1896.   try
  1897.     lQry := TIBSQL.Create(self);
  1898.     with lQry do
  1899.     begin
  1900.       Database := SelDatabaseNode;
  1901.       Transaction := SelDatabaseNode.DefaultTransaction;
  1902.       SQL.Clear;
  1903.       SQL.Add(lSQLStr);
  1904.       try
  1905.         ExecQuery;
  1906.         while not EOF do
  1907.         begin
  1908.           ObjectList.Add(Format('%s%s%s',[FieldByName('RDB$OWNER_NAME').AsString,
  1909.                          DEL,
  1910.                          FieldByName('RDB$USER').AsString]));
  1911.           Next;
  1912.           result := SUCCESS;
  1913.         end;
  1914.         Close;
  1915.       except
  1916.         on E:EIBError do
  1917.         begin
  1918.           DisplayMsg(ERR_GET_ROLES, E.Message);
  1919.           result := FAILURE;
  1920.         end;
  1921.       end;
  1922.     end;
  1923.   finally
  1924.     lQry.Free;
  1925.     SelDatabaseNode.DefaultTransaction.Commit;
  1926.   end;
  1927. end;
  1928.  
  1929. function TdmMain.GetExceptionData(var ObjectList: TStringList;
  1930.   const SelDatabaseNode: TIBDatabase; const ExceptionName: String): integer;
  1931. var
  1932.   lQry: TIBSQl;
  1933.   
  1934. begin
  1935.   result := FAILURE;
  1936.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1937.     SelDatabaseNode.DefaultTransaction.Commit;
  1938.  
  1939.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1940.  
  1941.   lQry := nil;
  1942.   try
  1943.     lQry := TIBSQl.Create(self);
  1944.     with lQry do
  1945.     begin
  1946.       Database := SelDatabaseNode;
  1947.       Transaction := SelDatabaseNode.DefaultTransaction;
  1948.       SQL.Clear;
  1949.       SQL.Add('select * from rdb$exceptions order by rdb$exception_number');
  1950.       try
  1951.         ExecQuery;
  1952.         while not EOF do
  1953.         begin
  1954.           ObjectList.Add(Format('%s%s%s%s%s',[FieldByName('RDB$EXCEPTION_NUMBER').AsString,
  1955.                          DEL,
  1956.                          FieldByName('RDB$MESSAGE').AsString,
  1957.                          DEL,
  1958.                          FieldByName('RDB$DESCRIPTION').AsString]));
  1959.           Next;
  1960.           result := SUCCESS;
  1961.         end;
  1962.         Close;
  1963.       except
  1964.         on E:EIBError do
  1965.         begin
  1966.           DisplayMsg(ERR_GET_EXCEPTIONS, E.Message);
  1967.           result := FAILURE;
  1968.         end;
  1969.       end;
  1970.     end;
  1971.   finally
  1972.     lQry.Free;
  1973.     SelDatabaseNode.DefaultTransaction.Commit;    
  1974.   end;
  1975. end;
  1976.  
  1977. function TdmMain.GetGeneratorData(var ObjectList: TStringList;
  1978.   const SelDatabaseNode: TIBDatabase; const Showsystem: boolean): integer;
  1979. var
  1980.   lSqlStr: String;
  1981.   lQry: TIBSql;
  1982.  
  1983. begin
  1984.   result := FAILURE;
  1985.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  1986.     SelDatabaseNode.DefaultTransaction.Commit;
  1987.  
  1988.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  1989.  
  1990.  
  1991.   lSqlStr := 'select * from rdb$Generators';
  1992.  
  1993.   if not ShowSystem then
  1994.     lSQLStr := Format('%s Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  1995.     
  1996.   lSqlStr := Format('%s order by rdb$generator_id', [lSqlStr]);
  1997.  
  1998.   lQry := nil;
  1999.   try
  2000.     lQry := TIBSQL.Create(self);
  2001.     with lQry do
  2002.     begin
  2003.       Database := SelDatabaseNode;
  2004.       Transaction := SelDatabaseNode.DefaultTransaction;
  2005.       SQL.Clear;
  2006.       SQL.Add(lSqlStr);
  2007.       try
  2008.         ExecQuery;
  2009.         while not EOF do
  2010.         begin
  2011.           ObjectList.Add(Format('%s%s%s',[FieldByName('RDB$GENERATOR_ID').AsString,
  2012.                          DEL,
  2013.                          GetNextGenValue (SelDatabaseNode, Trim(FieldByName('RDB$GENERATOR_NAME').AsString))]));
  2014.           Next;
  2015.           result := SUCCESS;
  2016.         end;
  2017.         Close;
  2018.       except
  2019.         on E:EIBError do
  2020.         begin
  2021.           DisplayMsg(ERR_GET_EXCEPTIONS, E.Message);
  2022.           result := FAILURE;
  2023.         end;
  2024.       end;
  2025.     end;
  2026.   finally
  2027.     lQry.Free;
  2028.     SelDatabaseNode.DefaultTransaction.Commit;    
  2029.   end;
  2030. end;
  2031.  
  2032. function TdmMain.GetNextGenValue(const Database: TIBDatabase;
  2033.   const GenName: String): String;
  2034. var
  2035.   trans: TIBTransaction;
  2036.   qry: TIBSql;
  2037. begin
  2038.   trans := TIBTransaction.Create (self);
  2039.   trans.DefaultDatabase := Database;
  2040.  
  2041.   qry := TIBSql.Create (self);
  2042.   Trans.StartTransaction;
  2043.   with qry do
  2044.   begin
  2045.     Database := Database;
  2046.     Transaction := trans;
  2047.     SQL.Add (Format('select GEN_ID(%s,0) from RDB$DATABASE', [GenName]));
  2048.     Prepare;
  2049.     ExecQuery;
  2050.     result := FieldByName('GEN_ID').AsString;
  2051.     trans.Commit;
  2052.     close;
  2053.     Free;
  2054.   end;
  2055.   trans.free;
  2056. end;
  2057.  
  2058. function TdmMain.GetViewData(var ObjectList: TStringList;
  2059.   const SelDatabaseNode: TIBDatabase; const ViewName: String): integer;
  2060. var
  2061.   lSQLStr: String;
  2062.   lQry: TIBSql;
  2063.  
  2064. begin
  2065.   result := FAILURE;
  2066.   if SelDatabaseNode.DefaultTransaction.InTransaction then
  2067.     SelDatabaseNode.DefaultTransaction.Commit;
  2068.  
  2069.   SelDatabaseNode.DefaultTransaction.StartTransaction;
  2070.   lSqlStr := 'select rdb$description, rdb$view_source from rdb$relations';
  2071.   lSQLStr := Format('%s where rdb$relation_name in (select rdb$view_name', [lSQLStr]);
  2072.   lSQLStr := Format('%s from rdb$view_relations)', [lSQLStr]);
  2073.   lSQLStr := Format('%s ORDER BY RDB$RELATION_ID', [lSQLStr]);
  2074.  
  2075.   lQry := nil;
  2076.   try
  2077.     lQry := TIBSQL.Create(self);
  2078.     with lQry do
  2079.     begin
  2080.       Database := SelDatabaseNode;
  2081.       Transaction := SelDatabaseNode.DefaultTransaction;
  2082.       SQL.Clear;
  2083.       SQL.Add(lSqlStr);
  2084.       try
  2085.         ExecQuery;
  2086.         while not EOF do
  2087.         begin
  2088.           ObjectList.Add(Format('%s%s%s',[FieldByName('RDB$DESCRIPTION').AsString,
  2089.                          DEL,
  2090.                          FieldByName('RDB$VIEW_SOURCE').AsString]));
  2091.           Next;
  2092.         end;
  2093.         Close;
  2094.       except
  2095.         on E:EIBError do
  2096.         begin
  2097.           DisplayMsg(ERR_GET_EXCEPTIONS, E.Message);
  2098.           result := FAILURE;
  2099.         end;
  2100.       end;
  2101.     end;
  2102.   finally
  2103.     lQry.Free;
  2104.     SelDatabaseNode.DefaultTransaction.Commit;
  2105.   end;
  2106. end;
  2107.  
  2108. function TdmMain.GetDomainData(var ObjectList: TStringList;
  2109.   const SelDatabaseNode: TIBDatabase; const ShowSystem: boolean): integer;
  2110. var
  2111.   Qry: TIBSQL;
  2112.   Trans: TIBTransaction;
  2113.   lSQLStr,
  2114.   NullFlg,
  2115.   Charset,
  2116.   Collation,
  2117.   FieldType: String;
  2118.   len: integer;
  2119.   IBExtract: TIBExtract;
  2120.  
  2121. begin
  2122.   Qry := nil;
  2123.   Trans := nil;
  2124.   IBExtract := nil;
  2125.   result := FAILURE;
  2126.   try
  2127.     Screen.Cursor := crHourGlass;
  2128.     try
  2129.       IBExtract := TIBExtract.Create(self);
  2130.       IBExtract.Database := SelDatabaseNode;
  2131.       Qry := TIBSQL.Create (self);
  2132.       Trans := TIBTransaction.Create(Self);
  2133.       Trans.DefaultDatabase := SelDatabaseNode;
  2134.       with Qry do
  2135.       begin
  2136.         Transaction := Trans;
  2137.         lSQLStr := 'SELECT * FROM RDB$FIELDS';
  2138.  
  2139.         if not Showsystem then
  2140.         begin
  2141.           lSQLStr := Format('%s WHERE RDB$FIELD_NAME NOT STARTING WITH ''RDB$''',[lSQLStr]);
  2142.           lSQLStr := Format('%s AND RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL',[lSQLStr]);
  2143.         end
  2144.         else
  2145.         begin
  2146.           lSQLStr := Format('%s WHERE (RDB$FIELD_NAME NOT STARTING WITH ''RDB$''',[lSQLStr]);
  2147.           lSQLStr := Format('%s AND RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG is NULL)',[lSQLStr]);
  2148.           lSQLStr := Format('%s or rdb$system_flag = 1', [lSqlStr]);
  2149.         end;
  2150.  
  2151.         lSQLStr := Format('%s ORDER BY RDB$FIELD_NAME',[lSQLStr]);
  2152.  
  2153.         SQL.Add(lSqlStr);
  2154.         Trans.StartTransaction;
  2155.         Prepare;
  2156.         ExecQuery;
  2157.  
  2158.         while not EOF do
  2159.         begin
  2160.           FieldType := '';
  2161.           if FieldByName('RDB$DIMENSIONS').AsInteger > 0 then
  2162.             FieldType := IBExtract.GetArrayField(Trim(FieldByName('RDB$FIELD_NAME').AsString));
  2163.  
  2164.           if Showsystem then
  2165.             len := FieldByName('RDB$FIELD_LENGTH').AsInteger
  2166.           else
  2167.             len := FieldByName('RDB$CHARACTER_LENGTH').AsInteger;
  2168.  
  2169.           FieldType := Format('%s %s',[FieldType , IBExtract.GetFieldType (FieldByName('RDB$FIELD_TYPE').AsInteger,
  2170.                                                     FieldByName('RDB$FIELD_SUB_TYPE').AsInteger,
  2171.                                                     FieldByName('RDB$FIELD_SCALE').AsInteger,
  2172.                                                     Len,
  2173.                                                     FieldByName('RDB$FIELD_PRECISION').AsInteger,
  2174.                                                     FieldByName('RDB$SEGMENT_LENGTH').AsInteger)]);
  2175.  
  2176.           Charset := '';
  2177.           if not (FieldByName('RDB$CHARACTER_SET_ID').IsNull) and
  2178.              (FieldByName('RDB$CHARACTER_SET_ID').AsInteger <> 0) then
  2179.             Charset := IBExtract.GetCharacterSet (FieldByName('RDB$CHARACTER_SET_ID').AsInteger, 0, false);
  2180.  
  2181.           Collation := '';
  2182.           if (not FieldByName('RDB$COLLATION_ID').IsNull) and
  2183.              (FieldByName('RDB$COLLATION_ID').AsInteger <> 0) then
  2184.             Collation := IBExtract.GetCharacterSet (FieldByName('RDB$CHARACTER_SET_ID').AsInteger,
  2185.                            FieldByName('RDB$COLLATION_ID').AsInteger, false);
  2186.  
  2187.  
  2188.           NullFlg := 'No';
  2189.           if FieldByName('RDB$NULL_FLAG').IsNull then
  2190.             NullFlg := 'Yes';
  2191.  
  2192.           ObjectList.Add (Format('%s%s%s%s%s%s%s%s%s%s%s%s', [FieldType, DEL,
  2193.                                                       Charset, DEL,
  2194.                                                       Collation, DEL,
  2195.                                                       FieldByName('RDB$DEFAULT_SOURCE').AsString,
  2196.                                                       DEL,
  2197.                                                       NullFlg,
  2198.                                                       DEL,
  2199.                                                       FieldByName('RDB$VALIDATION_SOURCE').AsString,
  2200.                                                       DEL,
  2201.                                                       FieldByName('RDB$DESCRIPTION').AsString]));
  2202.           Next;
  2203.         end;
  2204.       end;
  2205.     except
  2206.       on E: Exception do
  2207.         DisplayMsg (ERR_PROPERTIES, E.Message);
  2208.  
  2209.     end;
  2210.   finally
  2211.     Screen.Cursor := crDefault;
  2212.     if Assigned(Qry) then
  2213.       Qry.Free;
  2214.     if Assigned(Trans) then
  2215.       Trans.Free;
  2216.     if Assigned (IBExtract) then
  2217.       IBExtract.Free;
  2218.   end;
  2219. end;
  2220. function TdmMain.GetProcedureSource(var ObjectList: TStringList;
  2221.   const InDatabase: TIBDatabase; const ProcName: String): integer;
  2222. var
  2223.   lSQLStr: string;
  2224.   lQry: TIBSql;
  2225.  
  2226. begin
  2227.   result := FAILURE;
  2228.   if InDatabase.DefaultTransaction.InTransaction then
  2229.     InDatabase.DefaultTransaction.Commit;
  2230.  
  2231.   InDatabase.DefaultTransaction.StartTransaction;
  2232.  
  2233.   lQry := nil;
  2234.   try
  2235.     lQry := TIBSQL.Create(self);
  2236.     with lQry do
  2237.     begin
  2238.       Database := InDatabase;
  2239.       Transaction := InDatabase.DefaultTransaction;
  2240.       lSQLStr := 'select rdb$procedure_source';
  2241.       lSQLStr := Format('%s from rdb$procedures', [lSQLStr]);
  2242.       lSQLStr := Format('%s where rdb$procedure_name = ''%s''', [lSQLStr, ProcName]);
  2243.       SQL.Clear;
  2244.       SQL.Add(lSQLStr);
  2245.       try
  2246.         ExecQuery;
  2247.         if not EOF then
  2248.           ObjectList.Add (FieldByName('RDB$PROCEDURE_SOURCE').AsString);
  2249.         Close;
  2250.       except
  2251.         on E:EIBError do
  2252.         begin
  2253.           DisplayMsg(ERR_GET_PROCEDURES, E.Message);
  2254.           result := FAILURE;
  2255.         end;
  2256.       end;
  2257.     end;
  2258.   finally
  2259.     lQry.Free;
  2260.     InDatabase.DefaultTransaction.Commit;
  2261.   end;
  2262. end;
  2263.  
  2264. end.
  2265.  
  2266.