home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuMain.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-24  |  145KB  |  4,409 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. *  f r m u M a i n
  21. *
  22. ****************************************************************
  23. *  Author: The Client Server Factory Inc.
  24. *  Date:   March 1, 1999
  25. *
  26. *  Description:  This unit provides an interface which acts as the
  27. *                main switchboard for the application
  28. *
  29. *****************************************************************
  30. * Revisions:
  31. *
  32. *****************************************************************}
  33.  
  34. unit frmuMain;
  35. interface
  36.  
  37. uses Windows, Classes, Graphics, Forms, Controls, Menus, Dialogs, StdCtrls,
  38.   Buttons, ExtCtrls, ComCtrls, ImgList, ToolWin, Grids, DBGrids, DBCtrls,
  39.   Registry, zluibcClasses, IBServices, IB, Messages, SysUtils,
  40.   RichEdit, DB, IBCustomDataSet, IBSQL, IBQuery, IBHeader, IBDatabase,
  41.   IBDatabaseInfo, RichEditX, frmuDlgClass, ActnList, StdActns, wisql, frmuObjectWindow,
  42.   IBExtract;
  43.  
  44. type
  45.   TWinState = record
  46.     _Top,
  47.     _Left,
  48.     _Height,
  49.     _Width: integer;
  50.     _State: TWindowState;
  51.     _Read: boolean;
  52.   end;
  53.  
  54.   TfrmMain = class(TForm)
  55.     stbMain: TStatusBar;
  56.     clbMain: TCoolBar;
  57.     ToolBar2: TToolBar;
  58.     ToolButton1: TToolButton;
  59.     ToolButton5: TToolButton;
  60.     ToolButton8: TToolButton;
  61.     ToolButton9: TToolButton;
  62.     ToolButton41: TToolButton;
  63.     ToolButton6: TToolButton;
  64.     ToolButton10: TToolButton;
  65.     MainMenu1: TMainMenu;
  66.     Console1: TMenuItem;
  67.     View1: TMenuItem;
  68.     Server1: TMenuItem;
  69.     Database1: TMenuItem;
  70.     ToolMenu: TMenuItem;
  71.     Help1: TMenuItem;
  72.     Exit2: TMenuItem;
  73.     SystemData2: TMenuItem;
  74.     Large2: TMenuItem;
  75.     Small2: TMenuItem;
  76.     List2: TMenuItem;
  77.     Details1: TMenuItem;
  78.     Register3: TMenuItem;
  79.     UnRegister2: TMenuItem;
  80.     Login2: TMenuItem;
  81.     ServerProperties2: TMenuItem;
  82.     AddCertificate2: TMenuItem;
  83.     RemoveCertificate2: TMenuItem;
  84.     DiagnoseConnection2: TMenuItem;
  85.     UserSecurity2: TMenuItem;
  86.     ServerProperties3: TMenuItem;
  87.     Register4: TMenuItem;
  88.     Unregister3: TMenuItem;
  89.     Connect2: TMenuItem;
  90.     ConnectAs2: TMenuItem;
  91.     Disconnect2: TMenuItem;
  92.     CreateDatabase1: TMenuItem;
  93.     DropDatabase1: TMenuItem;
  94.     ViewMetadata2: TMenuItem;
  95.     Properties4: TMenuItem;
  96.     BackupRestore1: TMenuItem;
  97.     Backup2: TMenuItem;
  98.     Restore2: TMenuItem;
  99.     EditBackupAlias1: TMenuItem;
  100.     TransactionRecovery2: TMenuItem;
  101.     Shutdown2: TMenuItem;
  102.     DatabaseRestart2: TMenuItem;
  103.     DatabaseStatistics2: TMenuItem;
  104.     Sweep2: TMenuItem;
  105.     Validation2: TMenuItem;
  106.     InteractiveSQL2: TMenuItem;
  107.     Configure1: TMenuItem;
  108.     Contents2: TMenuItem;
  109.     TopicSearch1: TMenuItem;
  110.     RemoveAlias2: TMenuItem;
  111.     InterBaseHelp2: TMenuItem;
  112.     About2: TMenuItem;
  113.     N18: TMenuItem;
  114.     N19: TMenuItem;
  115.     N20: TMenuItem;
  116.     N21: TMenuItem;
  117.     N22: TMenuItem;
  118.     N23: TMenuItem;
  119.     N24: TMenuItem;
  120.     N25: TMenuItem;
  121.     tvMain: TTreeView;
  122.     ServerConnectedActions: TActionList;
  123.     ServerLogout: TAction;
  124.     ServerSecurity: TAction;
  125.     ServerAddCertificate: TAction;
  126.     ServerRemoveCertificate: TAction;
  127.     DatabaseConnectedActions: TActionList;
  128.     DatabaseDisconnect: TAction;
  129.     DatabaseProperties: TAction;
  130.     DatabaseSweep: TAction;
  131.     DatabaseRecoverTrans: TAction;
  132.     DatabaseStatistics: TAction;
  133.     DatabaseMetadata: TAction;
  134.     DatabaseShutdown: TAction;
  135.     DatabaseRestart: TAction;
  136.     DatabaseDrop: TAction;
  137.     ServerActions: TActionList;
  138.     ServerLogin: TAction;
  139.     DatabaseActions: TActionList;
  140.     DatabaseRegister: TAction;
  141.     DatabaseUnregister: TAction;
  142.     DatabaseConnect: TAction;
  143.     DatabaseConnectAs: TAction;
  144.     DatabaseCreate: TAction;
  145.     ToolActions: TActionList;
  146.     ExtToolsLaunchISQL: TAction;
  147.     ExtToolsConfigure: TAction;
  148.     BackupActions: TActionList;
  149.     DatabaseBackup: TAction;
  150.     DatabaseRestore: TAction;
  151.     BackupRestoreModifyAlias: TAction;
  152.     imgTreeview: TImageList;
  153.     imgToolBarsEnabled: TImageList;
  154.     imgLargeView: TImageList;
  155.     imgToolBarsDisabled: TImageList;
  156.     ExtToolDropDown: TAction;
  157.     pmDatabaseActions: TPopupMenu;
  158.     Connect1: TMenuItem;
  159.     ConnectAs1: TMenuItem;
  160.     CreateDatabase2: TMenuItem;
  161.     Register1: TMenuItem;
  162.     N1: TMenuItem;
  163.     pmDatabaseConnectedActions: TPopupMenu;
  164.     Disconnect1: TMenuItem;
  165.     Properties1: TMenuItem;
  166.     Sweep1: TMenuItem;
  167.     TransactionRecovery1: TMenuItem;
  168.     DatabaseStatistics3: TMenuItem;
  169.     ViewMetadata1: TMenuItem;
  170.     Maintenance1: TMenuItem;
  171.     BackupRestore2: TMenuItem;
  172.     EditBackupAlias3: TMenuItem;
  173.     RemoveAlias3: TMenuItem;
  174.     Backup1: TMenuItem;
  175.     Restore1: TMenuItem;
  176.     pmServer: TPopupMenu;
  177.     Logout1: TMenuItem;
  178.     Login1: TMenuItem;
  179.     DiagnoseConnection1: TMenuItem;
  180.     AddCertificate1: TMenuItem;
  181.     AddCertificate3: TMenuItem;
  182.     Register2: TMenuItem;
  183.     UserSecurity1: TMenuItem;
  184.     UnRegister1: TMenuItem;
  185.     ViewLogfile1: TMenuItem;
  186.     N2: TMenuItem;
  187.     N3: TMenuItem;
  188.     N4: TMenuItem;
  189.     N5: TMenuItem;
  190.     pmBackupRestore: TPopupMenu;
  191.     EditBackupAlias4: TMenuItem;
  192.     Backup3: TMenuItem;
  193.     Restore3: TMenuItem;
  194.     N6: TMenuItem;
  195.     pmCertificates: TPopupMenu;
  196.     AddCertificate4: TMenuItem;
  197.     RemoveCertificate3: TMenuItem;
  198.     ServerProperties: TAction;
  199.     pmDatabases: TPopupMenu;
  200.     Register5: TMenuItem;
  201.     CreateDatabase3: TMenuItem;
  202.     N7: TMenuItem;
  203.     LogActions: TActionList;
  204.     ViewServerLog: TAction;
  205.     UserActions: TActionList;
  206.     UserAdd: TAction;
  207.     UserModify: TAction;
  208.     UserDelete: TAction;
  209.     pmUsers: TPopupMenu;
  210.     UIActions: TActionList;
  211.     ConsoleExit: TAction;
  212.     ViewList: TAction;
  213.     ViewReport: TAction;
  214.     ViewIcon: TAction;
  215.     ViewSmallIcon: TAction;
  216.     ViewProperties: TAction;
  217.     ViewSystem: TAction;
  218.     HelpContents: THelpContents;
  219.     HelpOnHelp: THelpOnHelp;
  220.     HelpTopicSearch: THelpTopicSearch;
  221.     HelpAbout: TAction;
  222.     HelpInterBase: TAction;
  223.     EditCopy: TEditCopy;
  224.     EditCut: TEditCut;
  225.     EditPaste: TEditPaste;
  226.     EditSelectAll: TEditSelectAll;
  227.     EditUndo: TEditUndo;
  228.     ServerRegister: TAction;
  229.     ServerUnregister: TAction;
  230.     ServerConnection: TAction;
  231.     N8: TMenuItem;
  232.     BackupRestoreRemoveAlias: TAction;
  233.     DeleteAlias1: TMenuItem;
  234.     N9: TMenuItem;
  235.     N01: TMenuItem;
  236.     Shutdown3: TMenuItem;
  237.     DatabaseRestart1: TMenuItem;
  238.     N11: TMenuItem;
  239.     N12: TMenuItem;
  240.     N13: TMenuItem;
  241.     DeleteAlias2: TMenuItem;
  242.     N14: TMenuItem;
  243.     EditPopup: TPopupMenu;
  244.     Cut1: TMenuItem;
  245.     Copy1: TMenuItem;
  246.     Paste1: TMenuItem;
  247.     N15: TMenuItem;
  248.     SelectAll1: TMenuItem;
  249.     DatabaseValidate: TAction;
  250.     N17: TMenuItem;
  251.     Validation1: TMenuItem;
  252.     Unregister4: TMenuItem;
  253.     splVertical: TSplitter;
  254.     N27: TMenuItem;
  255.     Properties2: TMenuItem;
  256.     ServerActionProps: TAction;
  257.     DatabaseActionsProperties: TAction;
  258.     pmDBObjects: TPopupMenu;
  259.     DBObjectProperties: TActionList;
  260.     ObjectDescription: TAction;
  261.     ObjectCreate: TAction;
  262.     ObjectModify: TAction;
  263.     ObjectDelete: TAction;
  264.     ObjectExtract: TAction;
  265.     Backup4: TMenuItem;
  266.     EditDescription1: TMenuItem;
  267.     EditFont: TAction;
  268.     WindowList: TAction;
  269.     ObjectProperties: TAction;
  270.     Properties5: TMenuItem;
  271.     Window2: TMenuItem;
  272.     Maintenance2: TMenuItem;
  273.     N16: TMenuItem;
  274.     N10: TMenuItem;
  275.     ViewLogfile2: TMenuItem;
  276.     DBCBackup: TAction;
  277.     DBCRestore: TAction;
  278.     lvObjects: TListView;
  279.     AddUser1: TMenuItem;
  280.     ModifyUser1: TMenuItem;
  281.     DeleteUser1: TMenuItem;
  282.     DatabaseUsers: TAction;
  283.     DiagnoseConnection3: TMenuItem;
  284.     ConnectedUsers1: TMenuItem;
  285.     N26: TMenuItem;
  286.     N28: TMenuItem;
  287.     ObjectRefresh: TAction;
  288.     Refresh1: TMenuItem;
  289.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  290.     procedure FormCreate(Sender: TObject);
  291.     procedure FormDestroy(Sender: TObject);
  292.     procedure lvObjectsChange(Sender: TObject; Item: TListItem; Change: TItemChange);
  293.     procedure lvObjectsDblClick(Sender: TObject);
  294.     procedure tvMainChange(Sender: TObject; Node: TTreeNode);
  295.     procedure tvMainDblClick(Sender: TObject);
  296.     procedure tvMainDeletion(Sender: TObject; Node: TTreeNode);
  297.     procedure tvMainExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
  298.     procedure mmiHeContentsClick(Sender: TObject);
  299.     procedure mmiHeOverviewClick(Sender: TObject);
  300.     procedure mmiHeUsingHelpClick(Sender: TObject);
  301.     procedure mmiHeInterBaseHelpClick(Sender: TObject);
  302.     function FormHelp(Command: Word; Data: Integer;
  303.       var CallHelp: Boolean): Boolean;
  304.     procedure tvMainKeyPress(Sender: TObject; var Key: Char);
  305.     procedure tvMainMouseDown(Sender: TObject; Button: TMouseButton;
  306.       Shift: TShiftState; X, Y: Integer);
  307.     procedure FormResize(Sender: TObject);
  308.     procedure lvObjectsSelectItem(Sender: TObject; Item: TListItem;
  309.       Selected: Boolean);
  310.     procedure lvActionsDblClick(Sender: TObject);
  311.     procedure lvObjectsKeyDown(Sender: TObject; var Key: Word;
  312.       Shift: TShiftState);
  313.     procedure ConsoleExitExecute(Sender: TObject);
  314.     procedure DatabaseShutdownExecute(Sender: TObject);
  315.     procedure DatabaseRegisterExecute(Sender: TObject);
  316.     procedure DatabaseUnregisterExecute(Sender: TObject);
  317.     procedure DatabaseConnectExecute(Sender: TObject);
  318.     procedure DatabaseConnectAsExecute(Sender: TObject);
  319.     procedure DatabaseDisconnectExecute(Sender: TObject);
  320.     procedure ToolsStatisticsExecute(Sender: TObject);
  321.     procedure ToolsSweepExecute(Sender: TObject);
  322.     procedure ToolsSQLExecute(Sender: TObject);
  323.     procedure ServerViewLogExecute(Sender: TObject);
  324.     procedure ServerAddCertificateExecute(Sender: TObject);
  325.     procedure ServerRemoveCertificateExecute(Sender: TObject);
  326.     procedure DatabaseRestartExecute(Sender: TObject);
  327.     procedure ToolsTransRecoverExecute(Sender: TObject);
  328.     procedure DatabaseCreateExecute(Sender: TObject);
  329.     procedure DatabaseDropExecute(Sender: TObject);
  330.     procedure ToolsValidationExecute(Sender: TObject);
  331.     procedure DatabasePropertiesExecute(Sender: TObject);
  332.     procedure DatabaseRestoreExecute(Sender: TObject);
  333.     procedure HelpAboutExecute(Sender: TObject);
  334.     procedure BackupRestoreModifyAliasExecute(Sender: TObject);
  335.     procedure ServerDiagConnectionExecute(Sender: TObject);
  336.     procedure ServerLoginExecute(Sender: TObject);
  337.     procedure ServerLogoutExecute(Sender: TObject);
  338.     procedure ServerPropertiesExecute(Sender: TObject);
  339.     procedure ServerRegisterExecute(Sender: TObject);
  340.     procedure ServerUnregisterExecute(Sender: TObject);
  341.     procedure ServerSecurityExecute(Sender: TObject);
  342.     procedure ViewSystemDataExecute(Sender: TObject);
  343.     procedure EditFontExecute(Sender: TObject);
  344.     procedure DatabaseBackupExecute(Sender: TObject);
  345.     procedure DatabaseMetadataExecute(Sender: TObject);
  346.     procedure ViewListExecute(Sender: TObject);
  347.     procedure ViewListUpdate(Sender: TObject);
  348.     procedure ViewReportExecute(Sender: TObject);
  349.     procedure ViewReportUpdate(Sender: TObject);
  350.     procedure ViewIconExecute(Sender: TObject);
  351.     procedure ViewIconUpdate(Sender: TObject);
  352.     procedure ViewSmallIconExecute(Sender: TObject);
  353.     procedure ViewSmallIconUpdate(Sender: TObject);
  354.     procedure DatabaseConnectedActionsUpdate(Sender: TObject);
  355.     procedure ServerActionsUpdate(Sender: TObject);
  356.     procedure ServerConnectedUpdate(Sender: TObject);
  357.     procedure DatabaseRegisterUpdate(Sender: TObject);
  358.     procedure DatabaseActionsUpdate(Sender: TObject);
  359.     procedure ExtToolsConfigureExecute(Sender: TObject);
  360.     procedure ExtToolDropDownExecute(Sender: TObject);
  361.     procedure ExtToolLaunchExecute(Sender: TObject);
  362.     procedure BackupRestoreUpdate(Sender: TObject);
  363.     procedure DatabaseCreateUpdate(Sender: TObject);
  364.     procedure EditFontUpdate(Sender: TObject);
  365.     procedure listViewEnter(Sender: TObject);
  366.     procedure frmMainDestroy(Sender: TObject);
  367.     procedure BackupRestoreRemoveAliasExecute(Sender: TObject);
  368.     procedure BackupRestoreAliasUpdate(Sender: TObject);
  369.     procedure DatabasePropertiesUpdate(Sender: TObject);
  370.     procedure DatabaseValidateUpdate(Sender: TObject);
  371.     procedure ObjectDescriptionExecute(Sender: TObject);
  372.     procedure ObjectDescriptionUpdate(Sender: TObject);
  373.     procedure ObjectExtractExecute(Sender: TObject);
  374.     procedure ObjectDeleteUpdate(Sender: TObject);
  375.     procedure ObjectDeleteExecute(Sender: TObject);
  376.     procedure ViewSystemUpdate(Sender: TObject);
  377.     procedure Window2Click(Sender: TObject);
  378.     procedure FormShow(Sender: TObject);
  379.     procedure lvObjectsContextPopup(Sender: TObject; MousePos: TPoint;
  380.       var Handled: Boolean);
  381.     procedure tvMainCollapsing(Sender: TObject; Node: TTreeNode;
  382.       var AllowCollapse: Boolean);
  383.     procedure ServerPropertiesUpdate(Sender: TObject);
  384.     procedure ServerRemoveCertificateUpdate(Sender: TObject);
  385.     procedure UserDeleteUpdate(Sender: TObject);
  386.     procedure UserAddExecute(Sender: TObject);
  387.     procedure UserModifyExecute(Sender: TObject);
  388.     procedure UserModifyUpdate(Sender: TObject);
  389.     procedure UserDeleteExecute(Sender: TObject);
  390.     procedure ServerUsersExecute(Sender: TObject);
  391.     procedure ObjectModifyUpdate(Sender: TObject);
  392.     procedure ServerAddCertificateUpdate(Sender: TObject);
  393.     procedure DatabaseShutdownUpdate(Sender: TObject);
  394.     procedure ObjectRefreshExecute(Sender: TObject);
  395.  
  396.   private
  397.     { Private declarations }
  398.     FErrorState: boolean;
  399.     FCurrSelDatabase: TibcDatabaseNode;
  400.     FCurrSelServer: TibcServerNode;
  401.     FCurrSelTreeNode: TibcTreeNode;
  402.     FCurrSelCertificateID : String;
  403.     FCurrSelCertificateKey : String;
  404.     FPrevSelTreeNode: TibcTreeNode;
  405.     FRegistry: TRegistry;
  406.     FTableData : TIBQuery;
  407.     FRefetch,
  408.     FViewSystemData: Boolean;
  409.     FQryDataSet: TIBDataSet;
  410.     FDefaultTransaction: TIBTransaction;
  411.     FWisql: TdlgWisql;
  412.     FToolMenuIdx: integer;
  413.     FLastActions: TActionList;
  414.     FWindowList: TStringList;
  415.     FObjectWindowState,
  416.     FISQLWindowState,
  417.     FMainWindowState: TWinState;
  418.     FNILLDATABASE: TIBDatabase;
  419.  
  420.     function DoDBConnect(const SelServerNode: TibcServerNode;
  421.       var SelDatabaseNode: TibcDatabaseNode;
  422.       const SilentLogin: boolean): boolean;
  423.     function DoDBDisconnect(var SelDatabaseNode: TibcDatabaseNode): boolean;
  424.     function GetBackupFiles(const SelServerNode: TibcServerNode): integer;
  425.     function GetCertificates(const SelServerNode: TibcServerNode; const SelTreeNode: TibcTreeNode): integer;
  426.     function GetDDLScript: integer;
  427.     function GetDatabases(const SelServerNode: TibcServerNode): integer;
  428.     function GetDBObjects(const SelDatabaseNode: TibcDatabaseNode; const SelTreeNode: TibcTreeNode; const ObjType: integer): integer;
  429.     function GetServers: integer;
  430.     function GetUsers(const SelServerNode: TibcServerNode; const SelTreeNode: TibcTreeNode): integer;
  431.     function RegisterBackupFile(const SelServerNode: TibcServerNode;
  432.       const SourceDBAlias,BackupAlias: string;
  433.       BackupFiles: TStringList): boolean;
  434.     function RegisterDatabase(const SelServerNode: TibcServerNode; const DBAlias,
  435.       UserName,Password,Role: string; DatabaseFiles: TStringList;
  436.       SaveAlias, CaseSensitive: boolean; var NewDatabase: TIBDatabase): boolean;
  437.     function RegisterServer(const ServerName,ServerAlias,UserName,Password,Description: string; Protocol: TProtocol; SaveAlias: boolean; LastAccess: TDateTime): boolean;
  438.     function UnRegisterServer(const Node: String): boolean;
  439.     function IsDBRegistered(const DBFile : String; var ExistingDBAlias : String) : Boolean;
  440.     procedure DeleteNode(const Node: TTreeNode; const ChildNodesOnly: boolean);
  441.     function DoServerLogin(const SilentLogin: boolean): boolean;
  442.     procedure FillObjectList(const CurrSelNode: TibcTreeNode);
  443.     procedure InitRegistry;
  444.     procedure InitTreeView;
  445.     procedure ReadRegistry;
  446.     procedure AddTreeRootNode (const ObjType: Integer; const Parent: TTreeNode);
  447.     procedure FillActionList (const ActionList: TActionList);
  448.  
  449.     { WISQL Event Methods }
  450.     procedure EventDatabaseCreate (var Database: TIBDatabase);
  451.     procedure EventObjectRefresh (const Database: TIBDatabase; const ObjType: integer);
  452.     procedure EventDatabaseConnect (const ServerName: string; const Database: TIBDatabase);
  453. //    procedure EventServerConnect (const ServerName: string);
  454.     procedure EventDatabaseDrop;
  455.  
  456.   public
  457.     { Public declarations }
  458.     procedure RenameTreeNode(SelTreeNode: TibcTreeNode; NewNodeName: string);
  459.     procedure DisplayWindow(Sender: TObject);
  460.     function AliasExists(const AliasName: String): boolean;
  461.     { WISQL hooks for main form objects }
  462.     function CreateDatabase(Sender: TObject): boolean;
  463.     function ConnectAsDatabase(Sender: TObject): boolean;
  464.     procedure UpdateWindowList(const Caption: String; const Window: TObject;
  465.       const Remove: boolean = false);
  466.     procedure ShowWindows;      
  467.     procedure SetErrorState;      
  468.   end;
  469.  
  470. var
  471.   frmMain: TfrmMain;
  472.  
  473. implementation
  474.  
  475. {$R *.DFM}
  476.  
  477. uses frmuAbout,zluGlobal,frmuUser,frmuDBRegister,frmuServerRegister,dmuMain,
  478.   frmuDBConnect,frmuServerLogin,zluUtility,frmuMessage,
  479.   frmuDBRestore,frmuDBBackup,
  480.   frmuServerProperties,frmuDBProperties,frmuBackupAliasProperties,
  481.   frmuDBCreate,frmuDBConnections,frmuDBValidation,frmuDBShutdown,
  482.   frmuCommDiag,frmuAddCertificate, zluContextHelp, frmuDBTransactions,
  483.   frmuDBStatistics, frmuDispMemo, frmuModifyServerAlias, zluSQL, frmuDisplayBlob,
  484.   dbTables, frmuTools, frmuDescription, frmuWindowList, CommCtrl, IBErrorCodes;
  485.  
  486. const
  487.   ACTIONS = 0;
  488.   OBJECTS = 1;
  489.   STATIC = 2;
  490.   SYSDBA_ONLY = 999;
  491. var
  492.   { To detect multiple instances, we will replace the window proc with our
  493.     own and create our own message }
  494.   OldWindowProc: Pointer;
  495.   IBConsole_msg: DWORD;
  496.  
  497. function IBConsoleWindowProc(WindowHandle : hWnd;
  498.                              TheMessage   : LongInt;
  499.                              ParamW       : LongInt;
  500.                              ParamL       : LongInt) : LongInt stdcall;
  501. begin
  502.   if TheMessage = LongInt(IBConsole_msg)  then
  503.   begin
  504.     SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0);
  505.     SetForegroundWindow(Application.Handle);
  506.     Result := 0;
  507.     exit;
  508.   end;
  509.   {Call the original winproc}
  510.   Result := CallWindowProc(OldWindowProc,
  511.                            WindowHandle,
  512.                            TheMessage,
  513.                            ParamW,
  514.                            ParamL);
  515. end;
  516.  
  517. {****************************************************************
  518. *
  519. *  F o r m C l o s e ( )
  520. *
  521. ****************************************************************
  522. *  Author: The Client Server Factory Inc.
  523. *  Date:   March 1, 1999
  524. *
  525. *  Input:  Sender - The object that initiated the event
  526. *          Action - Determines if the form actually closes
  527. *
  528. *  Return: None
  529. *
  530. *  Description: This procedure performs a number of cleanup tasks
  531. *               when the Main form is closed
  532. *
  533. *****************************************************************
  534. * Revisions:
  535. *
  536. *****************************************************************}
  537. procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
  538. var
  539.   lCnt: Integer;
  540.   state: TWinState;
  541. begin
  542.   gApplShutdown := true;
  543.   with FRegistry do begin
  544.     OpenKey(gRegSettingsKey,false);
  545.     with State do
  546.     begin
  547.       _Top := Top;
  548.       _Left := Left;
  549.       _Height := Height;
  550.       _Width := Width;
  551.       _State := WindowState;
  552.       _Read := true;
  553.     end;
  554.     
  555.     WriteBinaryData('MainState', State, sizeof(State));
  556.     for lCnt := 0 to NUM_SETTINGS - 1 do begin
  557.       {If something happened reading the registry, make sure that the settings
  558.        are valid before trying to write them.  Otherwise, the app will not
  559.        close}
  560.       case TVarData(gAppSettings[lCnt].Setting).VType of
  561.         varBoolean:
  562.           WriteBool(gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  563.         varString:
  564.           WriteString(gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  565.         varInteger:
  566.           WriteInteger(gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  567.       end;
  568.     end;
  569.     CloseKey;
  570.   end;
  571.   FTableData.Free;
  572.   FWisql.Free;
  573.   FWindowList.Free;
  574. end;
  575.  
  576. {****************************************************************
  577. *
  578. *  F o r m C r e a t e ( )
  579. *
  580. ****************************************************************
  581. *  Author: The Client Server Factory Inc.
  582. *  Date:   March 1, 1999
  583. *
  584. *  Input:  Sender - The object that initiated the event
  585. *
  586. *  Return: None
  587. *
  588. *  Description: This procedure performs initialization tasks
  589. *               when the Main form is created.
  590. *
  591. *****************************************************************
  592. * Revisions:
  593. *
  594. *****************************************************************}
  595. procedure TfrmMain.FormCreate(Sender: TObject);
  596. var
  597.   lCnt: integer;
  598. begin
  599.   {First, setup a handler for detecting multiple instances }
  600.   IBConsole_msg := RegisterWindowMessage('ib_console_mtx');
  601.   {Set window proc to IBConsoleWindowProc. Save the old one}
  602.   OldWindowProc := Pointer(SetWindowLong(frmMain.Handle,
  603.                                          GWL_WNDPROC,
  604.                                          LongInt(@IBConsoleWindowProc)));
  605.  
  606.   inherited;
  607.   FErrorState := false;
  608.   FNILLDATABASE := nil;
  609.   stbMain.Height := 19;
  610.   tvMain.Width := Width div 3;
  611.  
  612.   gApplShutdown := false;
  613.   SetLength (gWinTempPath, MAX_PATH);
  614.   GetTempPath(MAX_PATH,PChar(gWinTempPath));
  615.   FCurrSelServer := nil;
  616.   FCurrSelDatabase := nil;
  617.   FCurrSelTreeNode := nil;
  618.   FPrevSelTreeNode := nil;
  619.   FTableData := TIBQuery.Create(Self);
  620.   FQryDataSet := nil;
  621.   FDefaultTransaction := nil;
  622.   FLastActions := nil;
  623.   FRefetch := false;
  624.   FWindowList := TStringList.Create;
  625.  
  626.   { Initialize the application setting defaults }
  627.   for lCnt := 0 to NUM_SETTINGS-1 do begin
  628.     gAppSettings[lCnt].Name := SETTINGS[lCnt];
  629.       case lCnt of
  630.         {Boolean Settings}
  631.           SYSTEM_DATA:
  632.             gAppSettings[lCnt].Setting := false;
  633.           DEPENDENCIES:
  634.             gAppSettings[lCnt].Setting := true;
  635.           USE_DEFAULT_EDITOR:
  636.             gAppSettings[lCnt].Setting := true;
  637.           SHOW_QUERY_PLAN:
  638.             gAppSettings[lCnt].Setting := true;
  639.           AUTO_COMMIT_DDL:
  640.             gAppSettings[lCnt].Setting := true;
  641.           SHOW_STATS:
  642.             gAppSettings[lCnt].Setting := true;
  643.           SHOW_LIST:
  644.             gAppSettings[lCnt].Setting := false;
  645.           SAVE_ISQL_OUTPUT:
  646.             gAppSettings[lCnt].Setting := false;
  647.           UPDATE_ON_CONNECT:
  648.             gAppSettings[lCnt].Setting := false;
  649.           UPDATE_ON_CREATE:
  650.             gAppSettings[lCnt].Setting := false;
  651.           CLEAR_INPUT:
  652.             gAppSettings[lCnt].Setting := true;
  653.  
  654.         {String Settings}
  655.           CHARACTER_SET:
  656.             gAppSettings[lCnt].Setting := 'None';
  657.           BLOB_DISPLAY:
  658.             gAppSettings[lCnt].Setting := 'Restrict';
  659.           BLOB_SUBTYPE:
  660.             gAppSettings[lCnt].Setting := 'Text';
  661.           ISQL_TERMINATOR:
  662.             gAppSettings[lCnt].Setting := ';';
  663.  
  664.         {Integer Settings}
  665.           COMMIT_ON_EXIT:
  666.             gAppSettings[lCnt].Setting := 0;
  667.           VIEW_STYLE:
  668.             gAppSettings[lCnt].Setting := 3;
  669.           DEFAULT_DIALECT:
  670.             gAppSettings[lCnt].Setting := 3;
  671.         end;
  672.     end;
  673.  
  674.   FRegistry := TRegistry.Create;
  675.   FRegistry.RootKey := HKEY_CURRENT_USER;
  676.   InitRegistry;
  677.   FMainWindowState._Read := false;
  678.   FObjectWindowState._Read := false;
  679.   FISQLWindowState._Read := false;
  680.   ReadRegistry;
  681.   if FMainWindowState._Read then
  682.     with FMainWindowState do
  683.     begin
  684.       if not (_State in [wsMaximized, wsMinimized]) then
  685.       begin
  686.         Top := _Top;
  687.         Left := _Left;
  688.         Width := _Width;
  689.         Height := _Height;
  690.       end;
  691.       WindowState := _State;
  692.     end;
  693.  
  694.   tvMain.Selected := tvMain.Items[0];
  695.   tvMainChange(nil,nil);
  696.  
  697.   FWISQL := TdlgWisql.Create (nil);
  698.   if FISQLWindowState._Read then
  699.     with FISQLWindowState do
  700.     begin
  701.       if not (_State in [wsMaximized, wsMinimized]) then
  702.       begin
  703.         FWISQL.Top := _Top;
  704.         FWISQL.Left := _Left;
  705.         FWISQL.Width := _Width;
  706.         FWISQL.Height := _Height;
  707.       end;
  708.       FWISQL.WindowState := _State;
  709.     end;
  710.  
  711.   { Get the number of items in the tool Menu }
  712.   FToolMenuIdx := ToolMenu.Count;
  713. end;
  714.  
  715. procedure TfrmMain.FormDestroy(Sender: TObject);
  716. begin
  717.   FRegistry.Free;
  718. end;
  719.  
  720. {****************************************************************
  721. *
  722. *  l v O b j e c t L i s t C h a n g e ( )
  723. *
  724. ****************************************************************
  725. *  Author: The Client Server Factory Inc.
  726. *  Date:   March 1, 1999
  727. *
  728. *  Input:  Sender - The object that initiated the event
  729. *          Item - The list item that just changed
  730. *          Change - The type of change that just occurred
  731. *
  732. *  Return: None
  733. *
  734. *  Description: This procedure enables/disables controls based on the
  735. *               the selected treenode
  736. *
  737. *****************************************************************
  738. * Revisions:
  739. *
  740. *****************************************************************}
  741. procedure TfrmMain.lvObjectsChange(Sender: TObject; Item: TListItem; Change: TItemChange);
  742. var
  743.   lTreeNode: TTreeNode;
  744. begin
  745.   if Assigned(lvObjects.Selected) then
  746.   begin
  747.     case FCurrSelTreeNode.NodeType of
  748.       NODE_SERVERS:
  749.       begin
  750.         if Assigned(lvObjects.Selected.Data) then
  751.         begin
  752.           lTreeNode := tvMain.Items.GetNode(TTreeNode(lvObjects.Selected.Data).ItemID);
  753.           FCurrSelServer := TibcServerNode(lTreeNode.Data);
  754.         end;
  755.       end;
  756.  
  757.       NODE_DATABASES:
  758.       begin
  759.         if Assigned(lvObjects.Selected.Data) then
  760.         begin
  761.           lTreeNode := tvMain.Items.GetNode(TTreeNode(lvObjects.Selected.Data).ItemID);
  762.           FCurrSelServer := TibcServerNode(lTreeNode.Parent.Parent.Data);
  763.           FCurrSelDatabase := TibcDatabaseNode(lTreeNode.Data);
  764.         end;
  765.       end;
  766.  
  767.       NODE_BACKUP_ALIASES:
  768.       begin
  769.         if Assigned(lvObjects.Selected.Data) then
  770.         begin
  771.           lTreeNode := tvMain.Items.GetNode(TTreeNode(lvObjects.Selected.Data).ItemID);
  772.           FCurrSelServer := TibcServerNode(lTreeNode.Parent.Parent.Data);
  773.           FCurrSelTreeNode := TibcTreeNode(lTreeNode.Data);
  774.         end
  775.       end;
  776.  
  777.     end;
  778.   end;
  779. end;
  780.  
  781. {****************************************************************
  782. *
  783. *  l v O b j e c t L i s t D b l C l i c k ( )
  784. *
  785. ****************************************************************
  786. *  Author: The Client Server Factory Inc.
  787. *  Date:   March 1, 1999
  788. *
  789. *  Input:  Sender - The object that initiated the event
  790. *
  791. *  Return: None
  792. *
  793. *  Description: This procedure determines what action takes place
  794. *               during a double click depending on the type of the
  795. *               selected treenode
  796. *
  797. *****************************************************************
  798. * Revisions:
  799. *
  800. *****************************************************************}
  801. procedure TfrmMain.lvObjectsDblClick(Sender: TObject);
  802. var
  803.   Icon: TIcon;
  804.  
  805. begin
  806.   if (Sender is TListView) and ((Sender as TListView).Tag = ACTIONS) then
  807.     lvActionsDblClick (Sender)
  808.   else
  809.   begin
  810.     case FCurrSelTreeNode.NodeType of
  811.       NODE_USERS:
  812.       begin
  813.         if Assigned(FCurrSelServer) then
  814.         begin
  815.           if lvObjects.SelCount > 0 then
  816.             frmuUser.UserInfo(FCurrSelServer,lvObjects.Selected.Caption)
  817.           else
  818.             frmuUser.UserInfo(FCurrSelServer,'');
  819.         end;
  820.       end;
  821.  
  822.       NODE_VIEWS,
  823.       NODE_PROCEDURES,
  824.       NODE_FUNCTIONS,
  825.       NODE_GENERATORS,
  826.       NODE_EXCEPTIONS,
  827.       NODE_BLOB_FILTERS,
  828.       NODE_ROLES,
  829.       NODE_DOMAINS,
  830.       NODE_TABLES:
  831.       begin
  832.         if Assigned(lvObjects.Selected) then
  833.         begin
  834.           try
  835.             Icon := TIcon.Create;
  836.             with lvObjects do
  837.             begin
  838.               SmallImages.GetIcon(Selected.ImageIndex, Icon);
  839.               UpdateWindowList(FCurrSelDatabase.ObjectViewer.Caption, TObject(FCurrSelDatabase.ObjectViewer), true);
  840.               FCurrSelDatabase.CreateObjectViewer;
  841.  
  842.               if FObjectWindowState._Read then
  843.                 with FObjectWindowState do
  844.                 begin
  845.                   if not (_State in [wsMaximized, wsMinimized]) then
  846.                   begin
  847.                     FCurrSelDatabase.ObjectViewer.Top := _Top;
  848.                     FCurrSelDatabase.ObjectViewer.Left := _Left;
  849.                     FCurrSelDatabase.ObjectViewer.Width := _Width;
  850.                     FCurrSelDatabase.ObjectViewer.Height := _Height;
  851.                   end;
  852.                   FCurrSelDatabase.ObjectViewer.WindowState := _State;
  853.                   FObjectWindowState._Read := false;
  854.                 end;
  855.  
  856.               FCurrSelDatabase.ObjectViewer.InitDlg (FCurrSelTreeNode.NodeType,FCurrSelTreeNode.ObjectList,
  857.                                      Selected.Caption, FCurrSelDatabase.Database, Icon, FViewSystemData, FRefetch);
  858.               FRefetch := false;
  859.             end;
  860.             Icon.Free;
  861.             FCurrSelDatabase.ObjectViewer.Show;
  862.             UpdateWindowList(FCurrSelDatabase.ObjectViewer.Caption, TObject(FCurrSelDatabase.ObjectViewer));
  863.           except
  864.             on E: Exception do
  865.               DisplayMsg (ERR_SYSTEM_INIT, E.Message);
  866.           end;
  867.         end;
  868.       end;
  869.     end;
  870.   end;
  871. end;
  872.  
  873. {****************************************************************
  874. *
  875. *  t v M a i n C h a n g e ( )
  876. *
  877. ****************************************************************
  878. *  Author: The Client Server Factory Inc.
  879. *  Date:   March 1, 1999
  880. *
  881. *  Input:  Sender - The object that initiated the event
  882. *
  883. *  Return: None
  884. *
  885. *  Description: This procedure controls what actions can take place when
  886. *               the user selectes a treenode
  887. *
  888. *****************************************************************
  889. * Revisions:
  890. *
  891. *****************************************************************}
  892. procedure TfrmMain.tvMainChange(Sender: TObject; Node: TTreeNode);
  893.  
  894. begin
  895.   stbMain.Panels[0].Text := '';
  896.   stbMain.Panels[1].Text := '';
  897.   stbMain.Panels[2].Text := '';
  898.   stbMain.Panels[3].Text := '';
  899.  
  900. try
  901.   if Assigned(tvMain.Selected) then
  902.   begin
  903.     tvMain.PopupMenu := nil;
  904.     lvObjects.PopupMenu := nil;
  905.     FCurrSelTreeNode := TibcTreeNode(tvMain.Selected.Data);
  906.  
  907.     if (not Assigned(FPrevSelTreeNode)) and (Assigned(FCurrSelTreeNode)) then
  908.       FPrevSelTreeNode := FCurrSelTreeNode;
  909.  
  910.     case FCurrSelTreeNode.NodeType of
  911.       NODE_LOGS:
  912.       begin
  913.         FillActionList(LogActions);
  914.       end;
  915.  
  916.       NODE_SERVERS:
  917.       begin
  918.         GetServers;
  919.         FillObjectList(FCurrSelTreeNode);
  920.         tvMain.PopupMenu := pmServer;
  921.       end;
  922.  
  923.       NODE_SERVER:
  924.       begin
  925.         FCurrSelServer := TibcServerNode(tvMain.Selected.Data);
  926.         tvMain.PopupMenu := pmServer;
  927.         if FCurrSelServer.Server.Active then
  928.           FillActionList(ServerConnectedActions)
  929.         else
  930.           FillActionList(ServerActions);
  931.       end;
  932.  
  933.       NODE_DATABASES:
  934.       begin
  935.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Data);
  936.         if tvMain.Selected.HasChildren then
  937.           FCurrSelDatabase := TibcDatabaseNode((tvMain.Selected.GetFirstChild).Data)
  938.         else
  939.           FCurrSelDatabase := nil;
  940.         GetDatabases(FCurrSelServer);
  941.         FillObjectList(FCurrSelTreeNode);
  942.         tvMain.PopupMenu := pmDatabases;
  943.       end;
  944.  
  945.       NODE_BACKUP_ALIASES:
  946.       begin
  947.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Data);
  948.         GetBackupFiles(FCurrSelServer);
  949.         FillObjectList(FCurrSelTreeNode);
  950.         lvObjects.PopupMenu := pmBackupRestore;        
  951.       end;
  952.  
  953.       NODE_USERS:
  954.       begin
  955.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Data);
  956.         GetUsers(FCurrSelServer,FCurrSelTreeNode);
  957.         FillObjectList(FCurrSelTreeNode);
  958.         lvObjects.PopupMenu := pmUsers;
  959.       end;
  960.  
  961.       NODE_CERTIFICATES:
  962.       begin
  963.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Data);
  964.         FCurrSelCertificateID := '';
  965.         FCurrSelCertificateKey := '';
  966.         GetCertificates(FCurrSelServer,FCurrSelTreeNode);
  967.         FillObjectList(FCurrSelTreeNode);
  968.         lvObjects.PopupMenu := pmCertificates;
  969.         tvMain.PopupMenu := pmCertificates;
  970.       end;
  971.  
  972.       NODE_BACKUP_ALIAS:
  973.       begin
  974.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Parent.Data);
  975.         if FRegistry.OpenKey(Format('%s%s\Backup Files\%s',[gRegServersKey,FCurrSelServer.NodeName,FCurrSelTreeNode.NodeName]),false) then
  976.         begin
  977.           TibcBackupAliasNode(FCurrSelTreeNode).SourceDBServer := FRegistry.ReadString('SourceDBServer');
  978.           TibcBackupAliasNode(FCurrSelTreeNode).SourceDBAlias := FRegistry.ReadString('SourceDBAlias');
  979.           TibcBackupAliasNode(FCurrSelTreeNode).BackupFiles.Text := FRegistry.ReadString('BackupFiles');
  980.  
  981.           if FRegistry.KeyExists ('Created') then
  982.             TibcBackupAliasNode(FCurrSelTreeNode).Created := FRegistry.ReadDateTime('Created');
  983.           if FRegistry.KeyExists ('Accessed') then
  984.             TibcBackupAliasNode(FCurrSelTreeNode).Created := FRegistry.ReadDateTime('Accessed');
  985.         end;
  986.         FillActionList (BackupActions);
  987.         tvMain.popupMenu := pmBackupRestore;
  988.       end;
  989.  
  990.       NODE_DATABASE:
  991.       begin
  992.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Parent.Data);
  993.         FCurrSelDatabase := TibcDatabaseNode(tvMain.Selected.Data);
  994.         stbMain.Panels[1].Text := Format('Database: %s',[FCurrSelDatabase.NodeName]);
  995.  
  996.         { Force refresh for the object viewer }
  997.         FRefetch := true;
  998.         
  999.         if (Assigned(FCurrSelDatabase.Database)) and
  1000.            (FCurrSelDatabase.Database.Connected) then
  1001.         begin
  1002.           FillActionList (DatabaseConnectedActions);
  1003.           tvMain.PopupMenu := pmDatabaseConnectedActions;
  1004.         end
  1005.         else
  1006.         begin
  1007.           FillACtionList (DatabaseActions);
  1008.           tvMain.PopupMenu := pmDatabaseActions;
  1009.         end;
  1010.      end;
  1011.  
  1012.      NODE_DOMAINS,
  1013.      NODE_TABLES,
  1014.      NODE_VIEWS,
  1015.      NODE_PROCEDURES,
  1016.      NODE_FUNCTIONS,
  1017.      NODE_GENERATORS,
  1018.      NODE_EXCEPTIONS,
  1019.      NODE_BLOB_FILTERS,
  1020.      NODE_ROLES:
  1021.      begin
  1022.         FCurrSelServer := TibcServerNode(tvMain.Selected.Parent.Parent.Parent.Data);
  1023.         FCurrSelDatabase := TibcDatabaseNode(tvMain.Selected.Parent.Data);
  1024.         stbMain.Panels[1].Text := Format('Database: %s',[FCurrSelDatabase.NodeName]);
  1025.         if (FCurrSelTreeNode.ObjectList.Count = 0) or
  1026.            (FCurrSelTreeNode.ShowSystem <> FViewSystemData) then
  1027.         begin
  1028.           GetDBObjects(FCurrSelDatabase, FCurrSelTreeNode, FCurrSelTreeNode.NodeType);
  1029.           FCurrSelTreeNode.ShowSystem := FViewSystemData;
  1030.         end;
  1031.         FillObjectList (FCurrSelTreeNode);
  1032.  
  1033.         lvObjects.PopupMenu := pmDBObjects;
  1034.       end;
  1035.     end;
  1036.   end;
  1037.  
  1038. finally
  1039.   if Assigned(FCurrSelServer) and (FCurrSelTreeNode.NodeType <> NODE_SERVERS) then
  1040.   begin
  1041.     stbMain.Panels[0].Text := Format('Server: %s',[FCurrSelServer.NodeName]);
  1042.     if FCurrSelServer.Server.Active then
  1043.       stbMain.Panels[2].Text := Format('User: %s',[FCurrSelServer.Username]);
  1044.   end;
  1045.   if Assigned(FCurrSelTreeNode) then
  1046.     FPrevSelTreeNode := FCurrSelTreeNode;
  1047.   Application.ProcessMessages;
  1048. end;
  1049.  
  1050. end;
  1051.  
  1052. {****************************************************************
  1053. *
  1054. *  t v M a i n D b l C l i c k ( )
  1055. *
  1056. ****************************************************************
  1057. *  Author: The Client Server Factory Inc.
  1058. *  Date:   March 1, 1999
  1059. *
  1060. *  Input:  Sender - The object that initiated the event
  1061. *
  1062. *  Return: None
  1063. *
  1064. *  Description: This procedure performs an action depending on
  1065. *               which treenode received the double-click.
  1066. *
  1067. *****************************************************************
  1068. * Revisions:
  1069. *
  1070. *****************************************************************}
  1071. procedure TfrmMain.tvMainDblClick(Sender: TObject);
  1072. begin
  1073.   if not Assigned (FCurrSelTreeNode) then
  1074.     exit;
  1075.  
  1076.   case FCurrSelTreeNode.NodeType of
  1077.     NODE_SERVERS:
  1078.       ServerRegisterExecute(Self);
  1079.  
  1080.     NODE_SERVER:
  1081.       if (Assigned(FCurrSelServer)) and (not FCurrSelServer.Server.Active) and
  1082.         (FCurrSelServer.Version > 5) then
  1083.         DoServerLogin(false);
  1084.  
  1085.     NODE_CERTIFICATES:
  1086.       ServerAddCertificateExecute(self);
  1087.  
  1088.     NODE_DATABASE:
  1089.       if Assigned(FCurrSelServer) and
  1090.          Assigned(FCurrSelDatabase) and
  1091.          (not Assigned(FCurrSelDatabase.Database) or
  1092.           not (FCurrSelDatabase.Database.Connected)) then
  1093.         DoDBConnect(FCurrSelServer,FCurrSelDatabase,true);
  1094.  
  1095.     NODE_BACKUP_ALIAS:
  1096.       DatabaseRestoreExecute(self);
  1097.   end;
  1098. end;
  1099.  
  1100. procedure TfrmMain.tvMainDeletion(Sender: TObject; Node: TTreeNode);
  1101. var
  1102.   lTmpTreeNode: TibcTreeNode;
  1103. begin
  1104.   if Assigned(Node.Data) then
  1105.   begin
  1106.     lTmpTreeNode := TibcTreeNode(Node.Data);
  1107.     lTmpTreeNode.Free;
  1108.   end
  1109. end;
  1110.  
  1111. procedure TfrmMain.tvMainExpanding(Sender: TObject; Node: TTreeNode;
  1112.   var AllowExpansion: Boolean);
  1113. begin
  1114.   if (Assigned(Node.Data)) and (TibcTreeNode(Node.Data) is TibcServerNode) then
  1115.   begin
  1116.     if TibcServerNode(Node.Data).Server.Active or (FCurrSelServer.Version < 6) then
  1117.       AllowExpansion := true
  1118.     else
  1119.       AllowExpansion := false;
  1120.   end
  1121. end;
  1122.  
  1123. {****************************************************************
  1124. *
  1125. *  D o D B C o n n e c t ( )
  1126. *
  1127. ****************************************************************
  1128. *  Author: The Client Server Factory Inc.
  1129. *  Date:   March 1, 1999
  1130. *
  1131. *  Input: SelServerNode - The selected server
  1132. *         SelDatabaseNode - The selected database
  1133. *         SilentLogin - Indicates whether or not to perform
  1134. *                       a silent login
  1135. *
  1136. *  Return: None
  1137. *
  1138. *  Description: This procedure makes a call to the DBConnect function.
  1139. *               If a connection is established it also creates/initializes
  1140. *               the treenodes under the database node
  1141. *
  1142. *****************************************************************
  1143. * Revisions:
  1144. *
  1145. *****************************************************************}
  1146. function TfrmMain.DoDBConnect(const SelServerNode: TibcServerNode;
  1147.   var SelDatabaseNode: TibcDatabaseNode;
  1148.   const SilentLogin: boolean): boolean;
  1149. var
  1150.   lDatabaseNode: TTreeNode;
  1151. begin
  1152.   Result := True;
  1153.   if Assigned(SelServerNode) and Assigned(SelDatabaseNode) then
  1154.   begin
  1155.     if frmuDBConnect.DBConnect(SelDatabaseNode,SelServerNode,SilentLogin) then
  1156.     begin
  1157.       lDatabaseNode := tvMain.Items.GetNode(SelDatabaseNode.NodeID);
  1158.  
  1159.       if not lDatabaseNode.HasChildren then
  1160.       begin
  1161.         lDatabaseNode.ImageIndex := NODE_DATABASES_CONNECTED_IMG;
  1162.         lDatabaseNode.SelectedIndex := NODE_DATABASES_CONNECTED_IMG;
  1163.  
  1164.         AddTreeRootNode (NODE_DOMAINS, lDatabaseNode);
  1165.         AddTreeRootNode (NODE_TABLES, lDatabaseNode);
  1166.         AddTreeRootNode (NODE_VIEWS, lDatabaseNode);
  1167.         AddTreeRootNode (NODE_PROCEDURES, lDatabaseNode);
  1168.         AddTreeRootNode (NODE_FUNCTIONS, lDatabaseNode);
  1169.         AddTreeRootNode (NODE_GENERATORS, lDatabaseNode);
  1170.         AddTreeRootNode (NODE_EXCEPTIONS, lDatabaseNode);
  1171.         AddTreeRootNode (NODE_BLOB_FILTERS, lDatabaseNode);
  1172.         AddTreeRootNode (NODE_ROLES, lDatabaseNode);
  1173.       end;
  1174.  
  1175.       if FRegistry.OpenKey(Format('%s%s\Databases\%s',[gRegServersKey,SelServerNode.Nodename,SelDatabaseNode.Nodename]),false) then
  1176.       begin
  1177.         FRegistry.WriteString('Username',SelDatabaseNode.Username);
  1178.         FRegistry.WriteString('Role',SelDatabaseNode.Role);
  1179.         FRegistry.WriteBool('CaseSensitiveRole', SelDatabaseNode.CaseSensitiveRole);
  1180.         FRegistry.WriteDateTime('Last Accessed', Now);
  1181.         FRegistry.CloseKey;
  1182.       end;
  1183.       tvMainChange(nil,nil);
  1184.  
  1185.       if Assigned(lDatabaseNode) then
  1186.         lDatabaseNode.Expand (false);
  1187.     end
  1188.     else
  1189.       result := false;
  1190.   end;
  1191. end;
  1192.  
  1193. {****************************************************************
  1194. *
  1195. *  D o D B D i s c o n n e c t ( )
  1196. *
  1197. ****************************************************************
  1198. *  Author: The Client Server Factory Inc.
  1199. *  Date:   March 1, 1999
  1200. *
  1201. *  Input:  SelDatabaseNode - The selected database
  1202. *
  1203. *  Return: None
  1204. *
  1205. *  Description: This procedure disconnects the specified database
  1206. *
  1207. *****************************************************************
  1208. * Revisions:
  1209. *
  1210. *****************************************************************}
  1211. function TfrmMain.DoDBDisconnect(var SelDatabaseNode: TibcDatabaseNode): boolean;
  1212. begin
  1213.   if not Assigned(SelDatabaseNode) then
  1214.   begin
  1215.     result := false;
  1216.     exit;
  1217.   end;
  1218.  
  1219.   try
  1220.     if SelDatabaseNode.Database.Connected then
  1221.     begin
  1222.       SelDatabaseNode.Database.Connected := false;
  1223.       if Assigned(SelDatabaseNode.ObjectViewer) and
  1224.         (SelDatabaseNode.ObjectViewer.WindowState in [wsNormal, wsMinimized, wsMaximized])
  1225.       then
  1226.         SelDatabaseNode.ObjectViewer.Close;
  1227.         
  1228.       Application.ProcessMessages;
  1229.     end;
  1230.     result := true;
  1231.   except
  1232.     on E:EIBError do
  1233.     begin
  1234.       DisplayMsg(ERR_DB_DISCONNECT,E.Message);
  1235.       result := false;
  1236.     end;
  1237.   end;
  1238. end;
  1239.  
  1240. {****************************************************************
  1241. *
  1242. *  G e t B a c k u p F i l e s ( )
  1243. *
  1244. ****************************************************************
  1245. *  Author: The Client Server Factory Inc.
  1246. *  Date:   March 1, 1999
  1247. *
  1248. *  Input: SelServerNode - The selected server
  1249. *         SelTreeNode - The selected tree node
  1250. *
  1251. *  Return: integer - Indicates the success/failure of the operation
  1252. *
  1253. *  Description: This precedure retrieves a list of Backup aliases for the
  1254. *               selected server from the treeview structure
  1255. *
  1256. *****************************************************************
  1257. * Revisions:
  1258. *
  1259. *****************************************************************}
  1260. function TfrmMain.GetBackupFiles(const SelServerNode: TibcServerNode): integer;
  1261. var
  1262.   lObjectList: TStringList;
  1263.   lCurrParentNode, lCurrChildNode: TTreeNode;
  1264. begin
  1265.   lObjectList := TStringList.Create;
  1266.   try
  1267.     Screen.Cursor := crHourGlass;
  1268.     lObjectList.AddObject('Name',nil);
  1269.     lCurrParentNode := tvMain.Items.GetNode(SelServerNode.BackupFilesID);
  1270.     lCurrChildNode := lCurrParentNode.GetFirstChild;
  1271.     while lCurrChildNode <> nil do
  1272.     begin
  1273.       lObjectList.AddObject(lCurrChildNode.Text, lCurrChildNode);
  1274.       lCurrChildNode := lCurrParentNode.GetNextChild(lCurrChildNode);
  1275.     end;
  1276.     TibcTreeNode(lCurrParentNode.Data).ObjectList.Assign(lObjectList);
  1277.     result := SUCCESS;
  1278.   finally
  1279.     lObjectList.Free;
  1280.     Screen.Cursor := crDefault;
  1281.   end;
  1282. end;
  1283.  
  1284. {****************************************************************
  1285. *
  1286. *  G e t D D L S c r i p t ( )
  1287. *
  1288. ****************************************************************
  1289. *  Author: The Client Server Factory Inc.
  1290. *  Date:   March 1, 1999
  1291. *
  1292. *  Input: None
  1293. *
  1294. *  Return: integer - Indicates the success/failure of the operation
  1295. *
  1296. *  Description: This procedure determines the type of the selected
  1297. *               treenode and calls the appropriate function in order to
  1298. *               retrieve the DDL script for the object(s).
  1299. *
  1300. *****************************************************************
  1301. * Revisions:
  1302. *
  1303. *****************************************************************}
  1304. function TfrmMain.GetDDLScript: integer;
  1305. var
  1306.   lSQLScript: TStringList;
  1307.   IBExtract : TIBExtract;
  1308.  
  1309. begin
  1310.   Result := 0;
  1311.   if (not Assigned(FCurrSelDatabase)) and (not Assigned (FCurrSelTreeNode)) then
  1312.     exit;
  1313.   lSQLScript := nil;
  1314.   try
  1315.     lSQLScript := TStringList.Create;
  1316.     lSQLScript.Text := '';
  1317.     Screen.Cursor := crHourGlass;
  1318.     IBExtract := TIBExtract.Create(self);
  1319.     with IBExtract do
  1320.     begin
  1321.       Database := FCurrSelDatabase.Database;
  1322.       ShowSystem := FViewsystemData;
  1323.       ObjectType := eoDatabase;
  1324.       Items := lSqlScript;
  1325.       ExtractObject;
  1326.       Free;
  1327.     end;
  1328.   finally
  1329.     FCurrSelServer.ShowText(lSQLScript, 'Database Metadata');
  1330.     Screen.Cursor := crDefault;
  1331.     lSQLScript.Free;
  1332.   end;
  1333. end;
  1334.  
  1335. {****************************************************************
  1336. *
  1337. *  G e t D a t a b a s e s ( )
  1338. *
  1339. ****************************************************************
  1340. *  Author: The Client Server Factory Inc.
  1341. *  Date:   March 1, 1999
  1342. *
  1343. *  Input: SelServerNode - The selected server
  1344. *
  1345. *  Return: integer - Indicates the success/failure of the operation
  1346. *
  1347. *  Description: This procedure retrieves a list of databases for the
  1348. *               specified server from the treeview structure
  1349. *
  1350. *****************************************************************
  1351. * Revisions:
  1352. *
  1353. *****************************************************************}
  1354. function TfrmMain.GetDatabases(const SelServerNode: TibcServerNode): integer;
  1355. var
  1356.   lObjectList: TStringList;
  1357.   lCurrParentNode,lCurrChildNode: TTreeNode;
  1358.   lDBNode: TibcDatabaseNode;
  1359. begin
  1360.   lObjectList := TStringList.Create;
  1361.   try
  1362.     Screen.Cursor := crHourGlass;
  1363.     lObjectList.AddObject(Format('Name%sPath',[DEL,DEL,DEL]),nil);
  1364.     lCurrParentNode := tvMain.Items.GetNode(SelServerNode.DatabasesID);
  1365.     lCurrChildNode := lCurrParentNode.GetFirstChild;
  1366.     while lCurrChildNode <> nil do
  1367.     begin
  1368.       lDbNode := TibcDatabaseNode(lCurrChildNode.Data);
  1369.       lObjectList.AddObject(Format('%s%s%s',[lCurrChildNode.Text,DEL ,lDBNode.DatabaseFiles[0]]),lCurrChildNode);
  1370.       lCurrChildNode := lCurrParentNode.GetNextChild(lCurrChildNode);
  1371.     end;
  1372.     TibcTreeNode(lCurrParentNode.Data).ObjectList.Assign(lObjectList);
  1373.     result := SUCCESS;
  1374.   finally
  1375.     lObjectList.Free;
  1376.     Screen.Cursor := crDefault;
  1377.   end;
  1378. end;
  1379.  
  1380. {****************************************************************
  1381. *
  1382. *  G e t S e r v e r s ( )
  1383. *
  1384. ****************************************************************
  1385. *  Author: The Client Server Factory Inc.
  1386. *  Date:   March 1, 1999
  1387. *
  1388. *  Input: None
  1389. *
  1390. *  Return: Returns a status code indicating the success/failure of
  1391. *          the operation.
  1392. *
  1393. *  Description: Get's a list of registered servers
  1394. *
  1395. *****************************************************************
  1396. * Revisions:
  1397. *
  1398. *****************************************************************}
  1399. function TfrmMain.GetServers: integer;
  1400. var
  1401.   lObjectList: TStringList;
  1402.   lCurrChildNode: TTreeNode;
  1403.   lNode: TibcServerNode;
  1404.   Str, LastAccess: String;
  1405.   Connections: integer;
  1406.  
  1407. begin
  1408.   lObjectList := TStringList.Create;
  1409.   try
  1410.     Screen.Cursor := crHourGlass;
  1411.     lObjectList.AddObject(Format('Name%sDescription%sLast Accessed%sConnections',[DEL,DEL, DEL]),nil);
  1412.     lCurrChildNode := tvMain.Items[0].GetFirstChild;
  1413.     while lCurrChildNode <> nil do
  1414.     begin
  1415.       lNode := TibcServerNode(lCurrChildNode.Data);
  1416.       Connections := 0;
  1417.       if lNode.Server.Active then
  1418.       begin
  1419.         lNode.Server.FetchDatabaseInfo;
  1420.         Connections := lNode.Server.DatabaseInfo.NoOfAttachments;
  1421.       end;
  1422.       LastAccess := DateTimeToStr(lNode.LastAccessed);
  1423.       Str := Format('%s%s%s%s%s%s%d',[lCurrChildNode.Text,DEL,lNode.Description,DEL,LastAccess,DEL, Connections]);
  1424.       lObjectList.AddObject(Str,lCurrChildNode);
  1425.       lCurrChildNode := tvMain.Items[0].GetNextChild(lCurrChildNode);
  1426.     end;
  1427.     TibcServerNode(tvMain.Items[0].Data).ObjectList.Assign(lObjectList);
  1428.     result := SUCCESS;
  1429.   finally
  1430.     lObjectList.Free;
  1431.     Screen.Cursor := crDefault;
  1432.   end;
  1433. end;
  1434.  
  1435. {****************************************************************
  1436. *
  1437. *  G e t U s e r s ( )
  1438. *
  1439. ****************************************************************
  1440. *  Author: The Client Server Factory Inc.
  1441. *  Date:   March 1, 1999
  1442. *
  1443. *  Input:
  1444. *
  1445. *  Return: None
  1446. *
  1447. *  Description:
  1448. *
  1449. *****************************************************************
  1450. * Revisions:
  1451. *
  1452. *****************************************************************}
  1453. function TfrmMain.GetUsers(const SelServerNode: TibcServerNode; const SelTreeNode: TibcTreeNode): integer;
  1454. var
  1455.   lObjectList: TStringList;
  1456.   lSecurityService: TIBSecurityService;
  1457.   lUserCount: integer;
  1458.   lUserInfo: TUserInfo;
  1459.   lPrevUsername: string;
  1460. begin
  1461.   result := FAILURE;
  1462.   lUserCount := 0;
  1463.   lPrevUsername := '';
  1464.   lObjectList := TStringList.Create;
  1465.   lSecurityService := TIBSecurityService.Create(nil);
  1466.   try
  1467.     Application.ProcessMessages;
  1468.     Screen.Cursor := crHourGlass;
  1469.     with lSecurityService do
  1470.     begin
  1471.       try
  1472.         LoginPrompt := false;
  1473.         ServerName := FCurrSelServer.Server.ServerName;
  1474.         Protocol := FCurrSelServer.Server.Protocol;
  1475.         Params.Assign(FCurrSelServer.Server.Params);
  1476.         Attach;
  1477.         if Active then
  1478.         begin
  1479.           DisplayUsers;
  1480.           while (IsServiceRunning) and (not gApplShutdown) do
  1481.             Application.ProcessMessages;
  1482.         end;
  1483.       except
  1484.         on E:EIBError do
  1485.         begin
  1486.           DisplayMsg(ERR_GET_USERS, E.Message);
  1487.           if (E.IBErrorCode = isc_lost_db_connection) or
  1488.              (E.IBErrorCode = isc_unavailable) or
  1489.              (E.IBErrorCode = isc_network_error) then
  1490.             SetErrorState;
  1491.           exit;
  1492.         end;
  1493.       end;
  1494.  
  1495.       lUserInfo := UserInfo[lUserCount];
  1496.       lObjectList.Add(Format('User Name%sFirst Name%sMiddle Name%sLast Name',[DEL,DEL,DEL]));
  1497.       while (lUserInfo.UserName <> '') and (lUserInfo.UserName <> lPrevUsername) do
  1498.       begin
  1499.         lObjectList.Add(Format('%s%s%s%s%s%s%s',[lUserInfo.UserName,DEL,lUserInfo.FirstName,DEL,
  1500.           lUserInfo.MiddleName,DEL,lUserInfo.LastName]));
  1501.         lPrevUsername := lUserInfo.UserName;
  1502.         inc(lUserCount);
  1503.         lUserInfo := UserInfo[lUserCount];
  1504.         Application.ProcessMessages;                        
  1505.       end;
  1506.       result := SUCCESS;
  1507.       SelTreeNode.ObjectList.Assign(lObjectList);
  1508.     end;
  1509.   finally
  1510.     lObjectList.Free;
  1511.     if lSecurityService.Active then
  1512.       lSecurityService.Detach;
  1513.     lSecurityService.Free;
  1514.     Screen.Cursor := crDefault;
  1515.   end;
  1516. end;
  1517.  
  1518. {****************************************************************
  1519. *
  1520. *  R e g i s t e r B a c k u p F i l e ( )
  1521. *
  1522. ****************************************************************
  1523. *  Author: The Client Server Factory Inc.
  1524. *  Date:   March 1, 1999
  1525. *
  1526. *  Input:
  1527. *
  1528. *  Return: None
  1529. *
  1530. *  Description:
  1531. *
  1532. *****************************************************************
  1533. * Revisions:
  1534. *
  1535. *****************************************************************}
  1536. function TfrmMain.RegisterBackupFile(const SelServerNode: TibcServerNode; const SourceDBAlias,
  1537.   BackupAlias: string; BackupFiles: TStringList): boolean;
  1538. var
  1539.   lBackupAliasNode: TTreeNode;
  1540. begin
  1541.   try
  1542.     tvMain.Items.BeginUpdate;
  1543.     lBackupAliasNode := tvMain.Items.AddChild(tvMain.Items.GetNode(SelServerNode.BackupFilesID), '');
  1544.     lBackupAliasNode.Data := TibcBackupAliasNode.Create(tvMain,lBackupAliasNode.ItemId,
  1545.       BackupAlias, Now, Now, NODE_BACKUP_ALIAS);
  1546.     lBackupAliasNode.Text := BackupAlias;
  1547.     lBackupAliasNode.SelectedIndex := NODE_BACKUP_ALIAS_IMG;
  1548.     lBackupAliasNode.ImageIndex := NODE_BACKUP_ALIAS_IMG;
  1549.     TibcBackupAliasNode(lBackupAliasNode.Data).SourceDBServer := SelServerNode.NodeName;
  1550.     TibcBackupAliasNode(lBackupAliasNode.Data).SourceDBAlias := SourceDBAlias;
  1551.     TibcBackupAliasNode(lBackupAliasNode.Data).BackupFiles.Assign(BackupFiles);
  1552.     TibcBackupAliasNode(lBackupAliasNode.Data).Created := Now;
  1553.     TibcBackupAliasNode(lBackupAliasNode.Data).LastAccessed := Now;
  1554.  
  1555.     if FRegistry.OpenKey(Format('%s%s\Backup Files',[gRegServersKey,SelServerNode.Nodename]),true) then
  1556.     begin
  1557.       if FRegistry.OpenKey(Format('%s%s\Backup Files\%s',[gRegServersKey,SelServerNode.Nodename,BackupAlias]),true) then
  1558.       begin
  1559.         FRegistry.WriteString('SourceDBServer',SelServerNode.NodeName);
  1560.         FRegistry.WriteString('SourceDBAlias',SourceDBAlias);
  1561.         FRegistry.WriteString('BackupFiles',BackupFiles.Text);
  1562.  
  1563.         if not FRegistry.KeyExists ('Created') then
  1564.           FRegistry.WriteDateTime ('Created', TibcBackupAliasNode(lBackupAliasNode.Data).Created);
  1565.  
  1566.         FRegistry.WriteDateTime ('Accessed', TibcBackupAliasNode(lBackupAliasNode.Data).LastAccessed);
  1567.         FRegistry.CloseKey;
  1568.       end;
  1569.     end;
  1570.   finally
  1571.     tvMain.Items.EndUpdate;
  1572.     tvMainChange(nil,nil);
  1573.     GetBackupFiles(FCurrSelServer);
  1574.     result := true;
  1575.   end;
  1576. end;
  1577.  
  1578. {****************************************************************
  1579. *
  1580. *  R e g i s t e r D a t a b a s e ( )
  1581. *
  1582. ****************************************************************
  1583. *  Author: The Client Server Factory Inc.
  1584. *  Date:   March 1, 1999
  1585. *
  1586. *  Input:
  1587. *
  1588. *  Return: None
  1589. *
  1590. *  Description:
  1591. *
  1592. *****************************************************************
  1593. * Revisions:
  1594. *
  1595. *****************************************************************}
  1596. function TfrmMain.RegisterDatabase(const SelServerNode: TibcServerNode;
  1597.   const DBAlias,UserName,Password,Role: string; DatabaseFiles: TStringList;
  1598.   SaveAlias, CaseSensitive: boolean; var NewDatabase: TIBDatabase): boolean;
  1599. var
  1600.   lDatabaseNode,lCurrNode: TTreeNode;
  1601.   tmpDatabase: TIBDatabase;
  1602. begin
  1603.   try
  1604.     if Assigned (NewDatabase) then
  1605.       tmpDatabase := NewDatabase
  1606.     else
  1607.       tmpDatabase := FNILLDATABASE;
  1608.     tvMain.Items.BeginUpdate;
  1609.     lDatabaseNode := tvMain.Items.AddChild(tvMain.Items.GetNode(SelServerNode.DatabasesID), '');
  1610.     lDatabaseNode.Data := TibcDatabaseNode.Create(tvMain,lDatabaseNode.ItemId,DBAlias,
  1611.       NODE_DATABASE,DatabaseFiles, tmpDatabase);
  1612.     lDatabaseNode.Text := TibcDatabaseNode(lDatabaseNode.Data).NodeName;
  1613.     FCurrSelDatabase := TibcDatabaseNode(lDatabaseNode.Data);
  1614.     FCurrSelDatabase.UserName := Username;
  1615.     FCurrSelDatabase.Password := Password;
  1616.     FCurrSelDatabase.Role := Role;
  1617.     FCurrSelDatabase.CaseSensitiveRole := CaseSensitive;
  1618.     lDatabaseNode.SelectedIndex := NODE_DATABASES_DISCONNECTED_IMG;
  1619.     lDatabaseNode.ImageIndex := NODE_DATABASES_DISCONNECTED_IMG;
  1620.     lCurrNode := tvMain.Items.GetNode(SelServerNode.DatabasesID);
  1621.     lCurrNode.expand(false);
  1622.     tvMain.Selected := lDatabaseNode;
  1623.  
  1624.     if SaveAlias then
  1625.     begin
  1626.       if FRegistry.OpenKey(Format('%s%s\Databases\%s',[gRegServersKey,SelServerNode.NodeName,DBAlias]),true) then
  1627.       begin
  1628. {TODO: Write more here too! }
  1629.         FRegistry.WriteString('DatabaseFiles',DatabaseFiles.Text);
  1630.         FRegistry.WriteString('Username',Username);
  1631.         FRegistry.WriteString('Role',Role);
  1632.         FRegistry.WriteBool('CaseSensitiveRole', CaseSensitive);
  1633.         FRegistry.CloseKey;
  1634.       end;
  1635.     end;
  1636.   finally
  1637.     tvMain.Items.EndUpdate;
  1638.     tvMainChange(nil,nil);
  1639.     GetDatabases(FCurrSelServer);
  1640.     result := true;
  1641.   end;
  1642. end;
  1643.  
  1644. {****************************************************************
  1645. *
  1646. *  R e g i s t e r S e r v e r ( )
  1647. *
  1648. ****************************************************************
  1649. *  Author: The Client Server Factory Inc.
  1650. *  Date:   March 1, 1999
  1651. *
  1652. *  Input:
  1653. *
  1654. *  Return: None
  1655. *
  1656. *  Description:
  1657. *
  1658. *****************************************************************
  1659. * Revisions:
  1660. *
  1661. *****************************************************************}
  1662. function TfrmMain.RegisterServer(const ServerName,ServerAlias,UserName,
  1663.                                  Password, Description: string;
  1664.                                  Protocol: TProtocol; SaveAlias: boolean;
  1665.                                  LastAccess: TDateTime): boolean;
  1666. var
  1667.   lServerNode: TTreeNode;
  1668. begin
  1669.   try
  1670.     tvMain.Items.BeginUpdate;
  1671.     lServerNode := tvMain.Items.AddChild(tvMain.Items[0], ServerAlias);
  1672.     if Protocol = Local then
  1673.       lServerNode.MoveTo(tvMain.Items[0],naAddChildFirst);
  1674.     lServerNode.Data := TibcServerNode.Create(tvMain,lServerNode.ItemId,ServerAlias,ServerName,UserName,Password, Description,Protocol, LastAccess, NODE_SERVER);
  1675.  
  1676.     lServerNode.SelectedIndex := 1;
  1677.     lServerNode.ImageIndex := 1;
  1678.     tvMain.Items[0].expand(false);
  1679.  
  1680.     FCurrSelServer := TibcServerNode(lServerNode.Data);
  1681.     tvMain.Selected := lServerNode;
  1682.     if SaveAlias then
  1683.     begin
  1684.       if FRegistry.OpenKey(Format('%s%s',[gRegServersKey,ServerAlias]),true) then
  1685.       begin
  1686.         FRegistry.WriteString('ServerName',ServerName);
  1687.         case Protocol of
  1688.           TCP: FRegistry.WriteInteger('Protocol',0);
  1689.           NamedPipe: FRegistry.WriteInteger('Protocol',1);
  1690.           SPX: FRegistry.WriteInteger('Protocol',2);
  1691.           Local: FRegistry.WriteInteger('Protocol',3);
  1692.         end;
  1693.         FRegistry.WriteString('Username',Username);
  1694.         FRegistry.WriteString('Description', Description);
  1695.         FRegistry.WriteDateTime('Last Accessed', LastAccess);
  1696.         FRegistry.CloseKey;
  1697.       end;
  1698.     end;
  1699.   finally
  1700.     tvMain.Items.EndUpdate;
  1701.     tvMainChange(nil,nil);
  1702.     GetServers;
  1703.     result := true;
  1704.   end;
  1705. end;
  1706.  
  1707. {****************************************************************
  1708. *
  1709. *  D e l e t e N o d e ( )
  1710. *
  1711. ****************************************************************
  1712. *  Author: The Client Server Factory Inc.
  1713. *  Date:   March 1, 1999
  1714. *
  1715. *  Input:
  1716. *
  1717. *  Return: None
  1718. *
  1719. *  Description:
  1720. *
  1721. *****************************************************************
  1722. * Revisions:
  1723. *
  1724. *****************************************************************}
  1725. procedure TfrmMain.DeleteNode(const Node: TTreeNode; const ChildNodesOnly: boolean);
  1726. begin
  1727.   if Assigned (Node) then
  1728.   begin
  1729.     { Any connected nodes are deleted in the destructor for
  1730.       TIBCDatabaseNode }
  1731.     Node.DeleteChildren;
  1732.     if not ChildNodesOnly then
  1733.       Node.Delete;
  1734.     tvMain.Refresh;
  1735.     Application.ProcessMessages;
  1736.   end;
  1737. end;
  1738.  
  1739. {****************************************************************
  1740. *
  1741. *  D o S e r v e r L o g i n ( )
  1742. *
  1743. ****************************************************************
  1744. *  Author: The Client Server Factory Inc.
  1745. *  Date:   March 1, 1999
  1746. *
  1747. *  Input: SilentLogin - Indicates wheather or not to prompt the
  1748. *         user for login information.
  1749. *
  1750. *  Return: None
  1751. *
  1752. *  Description: This procedure makes a call to the server login function
  1753. *               and refreshes the treeview depending on the success/failure
  1754. *               of the login
  1755. *
  1756. *****************************************************************
  1757. * Revisions:
  1758. *
  1759. *****************************************************************}
  1760. function TfrmMain.DoServerLogin(const SilentLogin: boolean): boolean;
  1761. var
  1762.   lServerNode,lCurrNode: TTreeNode;
  1763.   lDatabases,lBackupAliases,lBackupFiles,lDatabaseFiles: TStringList;
  1764.   i: integer;
  1765.   lCaseSensitive: boolean;
  1766.   lDBUserName,lRole,lSourceDBServer,lSourceDBAlias: string;
  1767. begin
  1768.   lDatabases := nil;
  1769.   lBackupAliases := nil;
  1770.   lBackupFiles := nil;
  1771.   lDatabaseFiles := nil;
  1772.   result := false;
  1773.   lCaseSensitive := false;
  1774.  
  1775.   if Assigned(FCurrSelServer) then
  1776.   begin
  1777.     try
  1778.       if FCurrSelServer.Server.Protocol = Local then
  1779.       begin
  1780.         if not IsIBRunning then
  1781.         begin
  1782.           if MessageDlg('The server has not been started. Would you like to start it now?',
  1783.             mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  1784.           begin
  1785.             if not StartServer then
  1786.               Exit;
  1787.           end
  1788.           else
  1789.             Exit;
  1790.         end;
  1791.       end;
  1792.       if frmuServerLogin.ServerLogin(FCurrSelServer,SilentLogin) then
  1793.       begin
  1794.         result := true;
  1795.         try
  1796.           lDatabases := TStringList.Create;
  1797.           lBackupAliases := TStringList.Create;
  1798.           lBackupFiles := TStringList.Create;
  1799.           lDatabaseFiles := TStringList.Create;
  1800.  
  1801.           lServerNode := tvMain.Items.GetNode(FCurrSelServer.NodeID);
  1802.           lServerNode.SelectedIndex := NODE_SERVERS_ACTIVE_IMG;
  1803.           lServerNode.ImageIndex := NODE_SERVERS_ACTIVE_IMG;
  1804.           lServerNode.Expand(True);
  1805.  
  1806.           if FCurrSelServer.Version < 6 then
  1807.           begin
  1808.             DisplayMsg(ERR_SERVER_LOGIN,
  1809.               Format('An error occured while trying to connect to ''%s''.  This server may be an earlier version.  As a result many features will be not work properly.',
  1810.               [FCurrSelServer.NodeName]));
  1811.           end;
  1812.  
  1813.           if not lServerNode.HasChildren then
  1814.           begin
  1815.           lCurrNode := tvMain.Items.AddChild(lServerNode, NODE_ARRAY[NODE_DATABASES]);
  1816.           lCurrNode.Data := TibcTreeNode.Create(tvMain,lCurrNode.ItemID,'',NODE_DATABASES);
  1817.           TibcServerNode(lServerNode.Data).DatabasesID := lCurrNode.ItemID;
  1818.           lCurrNode.ImageIndex := NODE_DATABASES_IMG;
  1819.           lCurrNode.SelectedIndex := NODE_DATABASES_IMG;
  1820.  
  1821.           lCurrNode := tvMain.Items.AddChild(lServerNode, NODE_ARRAY[NODE_BACKUP_ALIASES]);
  1822.           lCurrNode.Data := TibcTreeNode.Create(tvMain,lCurrNode.ItemID,'',NODE_BACKUP_ALIASES);
  1823.           TibcServerNode(lServerNode.Data).BackupFilesID := lCurrNode.ItemID;
  1824.           lCurrNode.ImageIndex := NODE_BACKUP_ALIASES_IMG;
  1825.           lCurrNode.SelectedIndex := NODE_BACKUP_ALIASES_IMG;
  1826.  
  1827.           lCurrNode := tvMain.Items.AddChild(lServerNode, NODE_ARRAY[NODE_CERTIFICATES]);
  1828.           lCurrNode.Data := TibcTreeNode.Create(tvMain,lCurrNode.ItemID,'',NODE_CERTIFICATES);
  1829.           lCurrNode.ImageIndex := NODE_CERTIFICATES_IMG;
  1830.           lCurrNode.SelectedIndex := NODE_CERTIFICATES_IMG;
  1831.  
  1832.           lCurrNode := tvMain.Items.AddChild(lServerNode, NODE_ARRAY[NODE_LOGS]);
  1833.           lCurrNode.Data := TibcTreeNode.Create(tvMain,lCurrNode.ItemID,'',NODE_LOGS);
  1834.           lCurrNode.ImageIndex := NODE_LOGS_IMG;
  1835.           lCurrNode.SelectedIndex := NODE_LOGS_IMG;
  1836.  
  1837.           lCurrNode := tvMain.Items.AddChild(lServerNode, NODE_ARRAY[NODE_USERS]);
  1838.           lCurrNode.Data := TibcTreeNode.Create(tvMain,lCurrNode.ItemID,'',NODE_USERS);
  1839.           lCurrNode.ImageIndex := NODE_USERS_IMG;
  1840.           lCurrNode.SelectedIndex := NODE_USERS_IMG;
  1841.           end;
  1842.  
  1843.           tvMain.Refresh;
  1844.           FcurrSelServer.LastAccessed := Now;
  1845.           if FRegistry.OpenKey(Format('%s%s',[gRegServersKey,FCurrSelServer.NodeName]),false) then
  1846.           begin
  1847.             FRegistry.WriteString('Username',FCurrSelServer.Username);
  1848.             FRegistry.WriteDateTime('Last Accessed', Now);
  1849.  
  1850.             if FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.NodeName]),false) then
  1851.             begin
  1852.               FRegistry.GetKeyNames(lDatabases);
  1853.               for i := 0 to lDatabases.Count - 1 do
  1854.               begin
  1855.                 if FRegistry.OpenKey(Format('%s%s\Databases\%s',[gRegServersKey,FCurrSelServer.NodeName,lDatabases[i]]),false) then
  1856.                 begin
  1857.                   lDatabaseFiles.text := FRegistry.ReadString('DatabaseFiles');
  1858.                   lDBUserName := FRegistry.ReadString('Username');
  1859.                   lRole := FRegistry.ReadString('Role');
  1860.                   try
  1861.                     lCaseSensitive := FRegistry.ReadBool('CaseSensitiveRole');
  1862.                   except on E: Exception do
  1863.                     lCaseSensitive := false;
  1864.                   end;
  1865.                   RegisterDatabase(FCurrSelServer,lDatabases[i],lDBUserName,'',
  1866.                     lRole,lDatabaseFiles,true, lCaseSensitive, FNILLDATABASE);
  1867.                 end;
  1868.               end;
  1869.             end;
  1870.  
  1871.             if FRegistry.OpenKey(Format('%s%s\Backup Files',[gRegServersKey,FCurrSelServer.NodeName]),false) then
  1872.             begin
  1873.               FRegistry.GetKeyNames(lBackupAliases);
  1874.               for i := 0 to (lBackupAliases.Count - 1) do
  1875.               begin
  1876.                 if FRegistry.OpenKey(Format('%s%s\Backup Files\%s',[gRegServersKey,FCurrSelServer.NodeName,lBackupAliases[i]]),false) then
  1877.                 begin
  1878.                   lSourceDBServer := FRegistry.ReadString('SourceDBServer');
  1879.                   lSourceDBAlias := FRegistry.ReadString('SourceDBAlias');
  1880.                   lBackupFiles.Text := FRegistry.ReadString('BackupFiles');
  1881.                   RegisterBackupFile(FCurrSelServer,lSourceDBAlias,lBackupAliases[i],lBackupFiles)
  1882.                 end;
  1883.               end;
  1884.             end;
  1885.             FRegistry.CloseKey;
  1886.           end;
  1887.         finally
  1888.           lDatabases.Free;
  1889.           lBackupFiles.Free;
  1890.           lBackupAliases.Free;
  1891.           lDatabaseFiles.Free;
  1892.         end;
  1893.       end;
  1894.     finally
  1895.       tvMainChange(nil,nil);
  1896.     end;
  1897.   end;
  1898. end;
  1899.  
  1900. {****************************************************************
  1901. *
  1902. *  F i l l O b j e c t L i s t ( )
  1903. *
  1904. ****************************************************************
  1905. *  Author: The Client Server Factory Inc.
  1906. *  Date:   March 1, 1999
  1907. *
  1908. *  Input:
  1909. *
  1910. *  Return: None
  1911. *
  1912. *  Description:
  1913. *
  1914. *****************************************************************
  1915. * Revisions:
  1916. *
  1917. *****************************************************************}
  1918. procedure TfrmMain.FillObjectList(const CurrSelNode: TibcTreeNode);
  1919. var
  1920.   loListItem: TListItem;
  1921.   loListColumn: TListColumn;
  1922.   lsCurrLine: string;
  1923.   i: integer;
  1924.  
  1925. begin
  1926.   if not Assigned(CurrSelNode.ObjectList) or
  1927.      (CurrSelNode.NodeType in [NODE_SERVER, NODE_DATABASE, NODE_TABLE]) then
  1928.     exit;
  1929.  
  1930.   case CurrSelNode.NodeType of
  1931.     NODE_SERVERS,
  1932.     NODE_DATABASES,
  1933.     NODE_USERS,
  1934.     NODE_CERTIFICATES,
  1935.     NODE_BACKUP_ALIASES:
  1936.      lvObjects.Tag := STATIC;
  1937.     else
  1938.      lvObjects.Tag := OBJECTS;
  1939.   end;
  1940.  
  1941.   FLastActions := nil;
  1942.   lvObjects.SmallImages := imgTreeView;
  1943.   lvObjects.StateImages := imgTreeView;
  1944.   lvObjects.LargeImages := imgLargeView;
  1945.  
  1946.   if (CurrSelNode.ObjectList.Count = 0) then
  1947.   begin
  1948.     lvObjects.Items.BeginUpdate;
  1949.     lvObjects.Items.Clear;
  1950.  
  1951.     lvObjects.Columns.BeginUpdate;
  1952.     lvObjects.Columns.Clear;
  1953.  
  1954.     lvObjects.Items.EndUpdate;
  1955.     lvObjects.Columns.EndUpdate;
  1956.   end
  1957.   else
  1958.   begin
  1959.     Screen.Cursor := crHourglass;
  1960.  
  1961.     lvObjects.Items.BeginUpdate;
  1962.     lvObjects.Items.Clear;
  1963.  
  1964.     lvObjects.Columns.BeginUpdate;
  1965.     lvObjects.Columns.Clear;
  1966.  
  1967.     lvObjects.AllocBy := CurrSelNode.ObjectList.Count;
  1968.  
  1969.     lsCurrLine := CurrSelNode.ObjectList.Strings[0];
  1970.     while Length(lsCurrLine) > 0 do
  1971.     begin
  1972.       loListColumn := lvObjects.Columns.Add;
  1973.       loListColumn.Caption := GetNextField(lsCurrLine, DEL);
  1974.     end;
  1975.  
  1976.     for i := 1  to CurrSelNode.ObjectList.Count - 1 do
  1977.     begin
  1978.       lsCurrLine := CurrSelNode.ObjectList.Strings[i];
  1979.       loListItem := lvObjects.Items.Add;
  1980.       loListItem.Caption := GetNextField(lsCurrLine, DEL);
  1981.  
  1982.       if Assigned(CurrSelNode.ObjectList.Objects[i]) then
  1983.       begin
  1984.         loListItem.Data := CurrSelNode.ObjectList.Objects[i];
  1985.       end;
  1986.  
  1987.       case CurrSelNode.NodeType of
  1988.         NODE_SERVERS:
  1989.         begin
  1990.           if Assigned(CurrSelNode.ObjectList.Objects[i]) then
  1991.           begin
  1992.             if TibcServerNode(TTreeNode(CurrSelNode.ObjectList.Objects[i]).Data).Server.Active then
  1993.               loListItem.ImageIndex := NODE_SERVERS_ACTIVE_IMG
  1994.             else
  1995.               loListItem.ImageIndex := NODE_SERVERS_INACTIVE_IMG;
  1996.           end;
  1997.         end;
  1998.  
  1999.         NODE_DATABASES:
  2000.         begin
  2001.           if Assigned(CurrSelNode.ObjectList.Objects[i]) then
  2002.           begin
  2003.           if TibcDatabaseNode(TTreeNode(CurrSelNode.ObjectList.Objects[i]).Data).Database.Connected then
  2004.             loListItem.ImageIndex := NODE_DATABASES_CONNECTED_IMG
  2005.           else
  2006.             loListItem.ImageIndex := NODE_DATABASES_DISCONNECTED_IMG;
  2007.           end;
  2008.         end;
  2009.  
  2010.         NODE_BACKUP_ALIASES: loListItem.ImageIndex := NODE_BACKUP_ALIASES_IMG;
  2011.         NODE_USERS: loListItem.ImageIndex := NODE_USERS_IMG;
  2012.         NODE_CERTIFICATES: loListItem.ImageIndex := NODE_CERTIFICATES_IMG;
  2013.         
  2014.         NODE_DOMAINS: loListItem.ImageIndex := NODE_DOMAINS_IMG;
  2015.         NODE_TABLES: loListItem.ImageIndex := NODE_TABLES_IMG;
  2016.         NODE_VIEWS: loListItem.ImageIndex := NODE_VIEWS_IMG;
  2017.         NODE_PROCEDURES: loListItem.ImageIndex := NODE_PROCEDURES_IMG;
  2018.         NODE_FUNCTIONS: loListItem.ImageIndex := NODE_FUNCTIONS_IMG;
  2019.         NODE_GENERATORS: loListItem.ImageIndex := NODE_GENERATORS_IMG;
  2020.         NODE_EXCEPTIONS: loListItem.ImageIndex := NODE_EXCEPTIONS_IMG;
  2021.         NODE_BLOB_FILTERS: loListItem.ImageIndex := NODE_BLOB_FILTERS_IMG;
  2022.         NODE_ROLES: loListItem.ImageIndex := NODE_ROLES_IMG;
  2023.         NODE_COLUMNS: loListItem.ImageIndex := NODE_COLUMNS_IMG;
  2024.         NODE_INDEXES: loListItem.ImageIndex := NODE_INDEXES_IMG;
  2025.         NODE_REFERENTIAL_CONSTRAINTS: loListItem.ImageIndex := NODE_REFERENTIAL_CONSTRAINTS_IMG;
  2026.         NODE_UNIQUE_CONSTRAINTS: loListItem.ImageIndex := NODE_UNIQUE_CONSTRAINTS_IMG;
  2027.         NODE_CHECK_CONSTRAINTS: loListItem.ImageIndex := NODE_CHECK_CONSTRAINTS_IMG;
  2028.         NODE_TRIGGERS: loListItem.ImageIndex := NODE_TRIGGERS_IMG;
  2029.       end;
  2030.  
  2031.       while Length(lsCurrLine) > 0 do
  2032.       begin
  2033.         loListItem.SubItems.Add(GetNextField(lsCurrLine, DEL));
  2034.       end;
  2035.     end;
  2036.     for i := 0 to lvObjects.Columns.Count -1 do
  2037.     begin
  2038.       lvObjects.Columns[i].Width := ColumnHeaderWidth;     
  2039.     end;
  2040.     lvObjects.Columns.EndUpdate;
  2041.     lvObjects.Items.EndUpdate;
  2042.  
  2043.     Application.ProcessMessages;
  2044.     Screen.Cursor := crDefault;
  2045.     stbMain.Panels[3].Text := Format('%d objects listed',[lvObjects.Items.Count]);
  2046.   end;
  2047. end;
  2048.  
  2049. {****************************************************************
  2050. *
  2051. *  I n i t R e g i s t r y ( )
  2052. *
  2053. ****************************************************************
  2054. *  Author: The Client Server Factory Inc.
  2055. *  Date:   March 1, 1999
  2056. *
  2057. *  Input: None
  2058. *
  2059. *  Return: None
  2060. *
  2061. *  Description: Initializes the registry with default values
  2062. *
  2063. *****************************************************************
  2064. * Revisions:
  2065. *
  2066. *****************************************************************}
  2067. procedure TfrmMain.InitRegistry;
  2068. var
  2069.   lCnt: integer;
  2070.  
  2071. begin
  2072.   with FRegistry do begin
  2073.     OpenKey('Software',true);
  2074.     OpenKey('Borland',true);
  2075.     OpenKey('InterBase',true);
  2076.     OpenKey('IBConsole',true);
  2077.     CreateKey('Servers');
  2078.     gRegServersKey := Format('\%s\Servers\',[CurrentPath]);
  2079.     CreateKey('Settings');
  2080.     gRegSettingsKey := Format('\%s\Settings',[CurrentPath]);
  2081.     gRegToolsKey := Format('%s\Tools',[gRegSettingsKey]);
  2082.   end;
  2083.  
  2084.   with FRegistry do begin
  2085.     OpenKey(gRegSettingsKey,false);
  2086.     for lCnt := 0 to NUM_SETTINGS-1 do begin
  2087.       if not ValueExists (gAppSettings[lCnt].Name) then begin
  2088.         case (VarType(gAppSettings[lCnt].Setting) and varTypeMask) of
  2089.           varSmallint: WriteInteger (gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  2090.           varInteger: WriteInteger (gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  2091.           varBoolean: WriteBool (gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  2092.           varString: WriteString (gAppSettings[lCnt].Name, gAppSettings[lCnt].Setting);
  2093.         end;
  2094.       end;
  2095.     end;
  2096.     CloseKey;
  2097.   end;
  2098. end;
  2099.  
  2100. {****************************************************************
  2101. *
  2102. *  I n i t T r e e V i e w ( )
  2103. *
  2104. ****************************************************************
  2105. *  Author: The Client Server Factory Inc.
  2106. *  Date:   March 1, 1999
  2107. *
  2108. *  Input:
  2109. *
  2110. *  Return: None
  2111. *
  2112. *  Description:
  2113. *
  2114. *****************************************************************
  2115. * Revisions:
  2116. *
  2117. *****************************************************************}
  2118. procedure TfrmMain.InitTreeView;
  2119. var
  2120.   lCurrNode: TTreeNode;
  2121. begin
  2122.   lCurrNode := tvMain.Items.GetFirstNode;
  2123.   lCurrNode.Data := TibcTreeNode.Create(tvMain, lCurrNode.ItemID,'',NODE_SERVERS);
  2124.   lCurrNode.ImageIndex :=  0;
  2125.   lCurrNode.SelectedIndex := 0;
  2126. end;
  2127.  
  2128. {****************************************************************
  2129. *
  2130. *  R e a d R e g i s t r y ( )
  2131. *
  2132. ****************************************************************
  2133. *  Author: The Client Server Factory Inc.
  2134. *  Date:   March 1, 1999
  2135. *
  2136. *  Input: None
  2137. *
  2138. *  Return: None
  2139. *
  2140. *  Description: This procedure reads application settings from
  2141. *               the registry.
  2142. *
  2143. *****************************************************************
  2144. * Revisions:
  2145. *
  2146. *****************************************************************}
  2147. procedure TfrmMain.ReadRegistry;
  2148. var
  2149.   lServerName,lServerAlias,lServerUserName, lDescription: string;
  2150.   lLastAccessed: TDateTime;
  2151.   lProtocol: TProtocol;
  2152.   lServers: TStringList;
  2153.   i, j: integer;
  2154.   lTempInt, lResult: integer;
  2155.   lException: boolean;
  2156.   lMessage: String;
  2157.  
  2158. begin
  2159.   lServers := TStringList.Create;
  2160.   try
  2161.     InitTreeView;
  2162.     with FRegistry do begin
  2163.       { Read Option Settings }
  2164.       OpenKey(gRegSettingsKey,false);
  2165.       for i:= 0 to NUM_SETTINGS-1 do begin
  2166.         case i of
  2167.           SYSTEM_DATA..CLEAR_INPUT:
  2168.               gAppSettings[i].Setting := ReadBool(gAppSettings[i].Name);
  2169.           CHARACTER_SET..ISQL_TERMINATOR:
  2170.               gAppSettings[i].Setting := ReadString(gAppSettings[i].Name);
  2171.           COMMIT_ON_EXIT..DEFAULT_DIALECT:
  2172.               gAppSettings[i].Setting := ReadInteger(gAppSettings[i].Name);
  2173.         end;
  2174.       end;
  2175.  
  2176.       lTempInt := gAppSettings[VIEW_STYLE].Setting;;
  2177.       case lTempInt of
  2178.         0: ViewIcon.OnExecute(self);
  2179.         1: ViewSmallIcon.OnExecute(self);
  2180.         2: ViewList.OnExecute(self);
  2181.         3: ViewReport.OnExecute(self);
  2182.       end;
  2183.       FViewSystemData := gAppSettings[SYSTEM_DATA].Setting;
  2184.  
  2185.       { Get the window state }
  2186.       if ValueExists('MainState') then
  2187.         ReadBinaryData ('MainState', FMainWindowState, Sizeof(FMainwindowState));
  2188.  
  2189.       if ValueExists('ObjState') then
  2190.         ReadBinaryData ('ObjState', FObjectWindowState, Sizeof(FMainwindowState));
  2191.  
  2192.       if ValueExists('SQLState') then
  2193.         ReadBinaryData ('SQLState', FISQLWindowState, Sizeof(FMainwindowState));
  2194.  
  2195.       CloseKey; { end read options settings}
  2196.  
  2197.       { Read the external tools }
  2198.  
  2199.       gExternalApps := TStringList.Create;
  2200.       if OpenKey (gRegToolsKey, false) and ValueExists('Count') then
  2201.       begin
  2202.         i := ReadInteger ('Count');
  2203.         for j := 0 to i - 1 do
  2204.           gExternalApps.Add (ReadString (Format('Title%d', [j])));
  2205.       end;
  2206.       CloseKey;
  2207.  
  2208.       { Read the servers }
  2209.       if OpenKey(gRegServersKey,false) then begin
  2210.         GetKeyNames(lServers);
  2211.         for i := 0 to lServers.Count - 1 do begin
  2212.           lServerName := '';
  2213.           lServerUserName := '';
  2214.           lDescription := '';
  2215.           lLastAccessed := Now;
  2216.           lTempInt := -1;
  2217.           lException := false;
  2218.           lResult := mrOK;
  2219.           lProtocol := Local;
  2220.           if OpenKey(Format('%s%s',[gRegServersKey, lServers.Strings[i]]),false) then begin
  2221.             try
  2222.               lTempInt := ReadInteger('Protocol');
  2223.               case lTempInt of
  2224.                 0: lProtocol := TCP;
  2225.                 1: lProtocol := NamedPipe;
  2226.                 2: lProtocol := SPX;
  2227.                 3: lProtocol := Local;
  2228.               end;
  2229.  
  2230.               lServerName := ReadString('ServerName');
  2231.               if lServerName = '' then
  2232.               begin
  2233.                 { Attempt to read the other settings }
  2234.                 lServerUserName := ReadString('UserName');
  2235.                 raise Exception.Create('Failed to get data for ''ServerName''.');
  2236.               end;
  2237.  
  2238.               lServerUserName := ReadString('UserName');
  2239.               if lServerUserName = '' then
  2240.                 raise Exception.Create('Failed to get data for ''UserName''.');
  2241.  
  2242.               try
  2243.                 lDescription := ReadString('Description');
  2244.                 lLastAccessed := ReadDateTime ('Last Accessed');
  2245.               except
  2246.                 begin
  2247.                   lLastAccessed := Now;
  2248.                   lDescription := '';
  2249.                 end;
  2250.               end;
  2251.  
  2252.             except on E: Exception do
  2253.               begin
  2254.                 lException := true;
  2255.                 lMessage := E.Message;
  2256.                 lServerUserName := ReadString('UserName');
  2257.                 lServerName := ReadString('ServerName');                
  2258.               end;
  2259.             end;
  2260.  
  2261.             if lException then
  2262.               lResult := DisplayModifyAlias (lServers.Strings[i], lServerName, lServerUserName,
  2263.                                              lTempInt, lMessage);
  2264.             if lResult = mrOK then
  2265.               RegisterServer(lServerName,lServers.Strings[i],lServerUserName,'',
  2266.                              lDescription,lProtocol, lException, lLastAccessed)
  2267.             else begin
  2268.               while not (UnRegisterServer (lServerAlias)) do begin
  2269.                 lResult := DisplayModifyAlias (lServers.Strings[i], lServerName, lServerUserName,
  2270.                                                lTempInt, lMessage);
  2271.                 if lResult = mrOK then begin
  2272.                   RegisterServer(lServerName,lServers.Strings[i],lServerUserName,'',
  2273.                                  lDescription, lProtocol, lException, lLastAccessed);
  2274.                   break;
  2275.                 end;
  2276.               end;
  2277.             end;
  2278.           end;
  2279.         end;
  2280.       end;
  2281.     end;
  2282.     finally
  2283.       FRegistry.CloseKey;
  2284.       lServers.Free;
  2285.       Application.ProcessMessages;
  2286.     end;
  2287. end;
  2288.  
  2289. procedure TfrmMain.RenameTreeNode(SelTreeNode: TibcTreeNode; NewNodeName: string);
  2290. var
  2291.   lSelTreeNode: TTreeNode;
  2292.   idx: Integer;
  2293.  
  2294. begin
  2295.  
  2296.   lSelTreeNode := tvMain.Items.GetNode(SelTreeNode.NodeID);
  2297.   if SelTreeNode is TIBCServerNode then
  2298.   begin
  2299.     with TibcTreeNode(frmMain.tvMain.Items[0].Data).ObjectList do
  2300.     begin
  2301.       for idx := 0 to Count - 1 do
  2302.         if Pos(lSelTreeNode.Text, Strings[Idx]) = 1 then
  2303.         begin
  2304.           Strings[idx] := newNodeName;
  2305.           break;
  2306.         end;
  2307.     end;
  2308.   end;
  2309.   lSelTreeNode.Text := NewNodeName;
  2310.   tvMain.Refresh;
  2311. end;
  2312.  
  2313. {****************************************************************
  2314. *
  2315. *  G e t C e r t i f i c a t e s ( )
  2316. *
  2317. ****************************************************************
  2318. *  Author: The Client Server Factory Inc.
  2319. *  Date:   May 4, 1999
  2320. *
  2321. *  Input: SelServerNode - The selected server
  2322. *         SelTreeNode - The selected treenode
  2323. *
  2324. *  Return: interger - Indicates the success/failure of the operation
  2325. *
  2326. *  Description: Retrieves a list of certificates for the selected server
  2327. *
  2328. *****************************************************************
  2329. * Revisions:
  2330. *
  2331. *****************************************************************}
  2332. function TfrmMain.GetCertificates(const SelServerNode: TibcServerNode; const SelTreeNode: TibcTreeNode): integer;
  2333. var
  2334.   lObjectList: TStringList;
  2335.   i: integer;
  2336. begin
  2337.   lObjectList := TStringList.Create;
  2338.   try
  2339.     SelServerNode.Server.LoginPrompt := false;
  2340.     try
  2341.       if not SelServerNode.server.Active then
  2342.         SelServerNode.server.Attach;
  2343.       SelServerNode.Server.FetchLicenseInfo;
  2344.       lObjectList.Add(Format('Certificate ID%sCertificate Key%sDescription',[DEL,DEL]));
  2345.       for i:=0 to high(SelServerNode.Server.LicenseInfo.Key) do
  2346.         lObjectList.Add(Format('%s%s%s%s%s',
  2347.          [SelServerNode.Server.LicenseInfo.ID[i],DEL,
  2348.          SelServerNode.Server.LicenseInfo.Key[i],DEL,
  2349.          SelServerNode.Server.LicenseInfo.Desc[i]]));
  2350.       SelTreeNode.ObjectList.Assign(lObjectList);
  2351.       result := SUCCESS;
  2352.     except
  2353.       on E:EIBError do
  2354.       begin
  2355.         DisplayMsg(ERR_SERVER_SERVICE,E.Message + #13#10 + 'Cannot display server certificates');
  2356.         result := FAILURE;
  2357.         SelServerNode.Server.Active := true;
  2358.         if (E.IBErrorCode = isc_lost_db_connection) or
  2359.            (E.IBErrorCode = isc_unavailable) or
  2360.            (E.IBErrorCode = isc_network_error) then
  2361.           SetErrorState;
  2362.       end;
  2363.     end;
  2364.   finally
  2365.     lObjectList.Free;
  2366.   end;
  2367. end;
  2368.  
  2369. procedure TfrmMain.mmiHeContentsClick(Sender: TObject);
  2370. begin
  2371.    WinHelp(Handle,CONTEXT_HELP_FILE,HELP_FINDER,0);
  2372. end;
  2373.  
  2374. procedure TfrmMain.mmiHeOverviewClick(Sender: TObject);
  2375. begin
  2376.   WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,GENERAL_OVERVIEW);
  2377. end;
  2378.  
  2379. procedure TfrmMain.mmiHeUsingHelpClick(Sender: TObject);
  2380. begin
  2381.    WinHelp(Handle,CONTEXT_HELP_FILE,HELP_HELPONHELP,0);
  2382. end;
  2383.  
  2384. procedure TfrmMain.mmiHeInterBaseHelpClick(Sender: TObject);
  2385. begin
  2386.    WinHelp(Handle,INTERBASE_HELP_FILE,HELP_FINDER,0);
  2387. end;
  2388.  
  2389. function TfrmMain.FormHelp(Command: Word; Data: Integer;
  2390.   var CallHelp: Boolean): Boolean;
  2391. begin
  2392.   CallHelp := False;
  2393.   Result := WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_FINDER,0);
  2394. end;
  2395.  
  2396. procedure TfrmMain.tvMainKeyPress(Sender: TObject; var Key: Char);
  2397. begin
  2398.   case Ord(Key) of
  2399.     VK_RETURN :
  2400.     begin
  2401.       Key := '0';
  2402.       case FCurrSelTreeNode.NodeType of
  2403.         NODE_SERVER :
  2404.           if (not FCurrSelServer.Server.Active) and (not FCurrSelServer.Version < 6) then
  2405.             tvMainDblClick(Nil);
  2406.  
  2407.         NODE_DATABASE :
  2408.           if (not FCurrSelDatabase.Database.Connected) then
  2409.              tvMainDblClick(Nil);
  2410.  
  2411.         NODE_SERVERS, NODE_BACKUP_ALIASES, NODE_DATABASES :
  2412.           tvMainDblClick(Nil);
  2413.  
  2414.         NODE_BACKUP_ALIAS, NODE_USERS, NODE_CERTIFICATES :
  2415.           tvMainDblClick(Nil);
  2416.       end;  // of case nodetype of
  2417.     end;
  2418.   end;  // of case ord(key) of 
  2419. end;
  2420.  
  2421. procedure TfrmMain.tvMainMouseDown(Sender: TObject; Button: TMouseButton;
  2422.   Shift: TShiftState; X, Y: Integer);
  2423. begin
  2424.   if Button = mbRight then
  2425.   begin
  2426.     tvMain.Selected := tvMain.GetNodeAt(X,Y);
  2427.   end;
  2428. end;
  2429.  
  2430. procedure TfrmMain.FormResize(Sender: TObject);
  2431. begin
  2432.   splVertical.Left := tvMain.Width;
  2433.   splVertical.Width := 3;
  2434. end;
  2435.  
  2436.  
  2437. procedure TfrmMain.lvObjectsSelectItem(Sender: TObject; Item: TListItem;
  2438.   Selected: Boolean);
  2439. begin
  2440.   if (FCurrSelTreeNode.NodeType = NODE_CERTIFICATES) then
  2441.   begin
  2442.     FCurrSelCertificateID := Item.Caption;
  2443.     FCurrSelCertificateKey := Item.SubItems.Strings[0];
  2444.   end;
  2445. end;
  2446. function TfrmMain.AliasExists(const AliasName: String): boolean;
  2447. var
  2448.   lAliases: TStringList;
  2449. begin
  2450.   result := false;
  2451.   lAliases := TStringList.Create;
  2452.   FRegistry.OpenKey(gRegServersKey,false);
  2453.   if FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.ServerName]),false) then
  2454.     FRegistry.GetKeyNames(lAliases);
  2455.   FRegistry.CloseKey;
  2456.  
  2457.   if lAliases.IndexOf(AliasName) <> -1 then
  2458.     result := true;
  2459.   lAliases.Free;
  2460. end;
  2461.  
  2462. function TfrmMain.IsDBRegistered(const DBFile : String; var ExistingDBAlias : String) : Boolean;
  2463. var
  2464.   lDatabaseFiles : TStringList;
  2465.   lDatabases     : TStringList;
  2466.   i              : Integer;
  2467. begin
  2468.   Result         := False;
  2469.   lDatabaseFiles := Nil;
  2470.   lDatabases     := Nil;
  2471.  
  2472.   try
  2473.     lDatabaseFiles := TStringList.Create;
  2474.     lDatabases := TStringList.Create;
  2475.  
  2476.     if FRegistry.OpenKey(gRegServersKey,false) then
  2477.     begin
  2478.       if FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.ServerName]),false) then
  2479.       begin
  2480.         FRegistry.GetKeyNames(lDatabases);
  2481.         i := 0;
  2482.  
  2483.         while (i < lDatabases.Count) do
  2484.         begin
  2485.           if FRegistry.OpenKey(Format('%s%s\Databases\%s',[gRegServersKey,FCurrSelServer.ServerName,
  2486.             lDatabases[i]]),false) then
  2487.           begin
  2488.             lDatabaseFiles.Text := FRegistry.ReadString('DatabaseFiles');
  2489.             if lDatabaseFiles.Strings[0] = DBFile then
  2490.             begin
  2491.               ExistingDBAlias := lDatabases.Strings[i];
  2492.               Result := True;
  2493.               Exit;
  2494.             end;
  2495.           end;
  2496.           Inc(i);
  2497.         end;  // of database loop
  2498.       end;
  2499.     end;
  2500.   finally
  2501.     lDatabaseFiles.Free;
  2502.     lDatabases.Free;
  2503.     FRegistry.CloseKey;
  2504.   end;
  2505.   if result then
  2506.     if MessageDlg(Format('This database is already registered with the following alias: %s.%s'+
  2507.       'Are you sure you want to register this database again?',
  2508.       [ExistingDBAlias, #13#10]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  2509.       result := false
  2510.     else
  2511.       result := true;
  2512. end;
  2513.  
  2514. function TfrmMain.UnRegisterServer(const Node: String): boolean;
  2515. begin
  2516.   if MessageDlg(Format('Are you sure that you want to un-register %s?', [Node]),
  2517.       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  2518.   begin
  2519.     FRegistry.DeleteKey(Format('%s%s\Databases',[gRegServersKey,Node]));
  2520.     FRegistry.DeleteKey(Format('%s%s',[gRegServersKey, Node]));
  2521.     FRegistry.CloseKey;
  2522.     result := true
  2523.   end
  2524.   else
  2525.     result := false;
  2526. end;
  2527.  
  2528. procedure TfrmMain.AddTreeRootNode(const ObjType: Integer; const Parent: TTreeNode);
  2529. var
  2530.   lCurrNode: TTreeNode;
  2531.  
  2532. begin
  2533.   lCurrNode := tvMain.Items.AddChild(Parent, NODE_ARRAY[Objtype]);
  2534.   lCurrNode.Data := TibcTreeNode.Create(tvMain,lCurrNode.ItemID,'',ObjType);
  2535.  
  2536.   case ObjType of
  2537.     NODE_DOMAINS:
  2538.     begin
  2539.       lCurrNode.ImageIndex := NODE_DOMAINS_IMG;
  2540.       lCurrNode.SelectedIndex := NODE_DOMAINS_IMG;
  2541.       TibcDatabaseNode(Parent.Data).DomainsID := lCurrNode.ItemID;
  2542.     end;
  2543.     NODE_TABLES:
  2544.     begin
  2545.       lCurrNode.ImageIndex := NODE_TABLES_IMG;
  2546.       lCurrNode.SelectedIndex := NODE_TABLES_IMG;
  2547.       TibcDatabaseNode(Parent.Data).TablesID := lCurrNode.ItemID;
  2548.     end;
  2549.     NODE_PROCEDURES:
  2550.     begin
  2551.       lCurrNode.ImageIndex := NODE_PROCEDURES_IMG;
  2552.       lCurrNode.SelectedIndex := NODE_PROCEDURES_IMG;
  2553.       TibcDatabaseNode(Parent.Data).ProceduresID := lCurrNode.ItemID;
  2554.     end;
  2555.     NODE_VIEWS:
  2556.     begin
  2557.       lCurrNode.ImageIndex := NODE_VIEWS_IMG;
  2558.       lCurrNode.SelectedIndex := NODE_VIEWS_IMG;
  2559.       TibcDatabaseNode(Parent.Data).ViewsID := lCurrNode.ItemID;
  2560.     end;
  2561.     NODE_TRIGGERS:
  2562.     begin
  2563.       lCurrNode.ImageIndex := NODE_TRIGGERS_IMG;
  2564.       lCurrNode.SelectedIndex := NODE_TRIGGERS_IMG;
  2565.       TibcDatabaseNode(Parent.Data).TriggersID := lCurrNode.ItemID;
  2566.     end;
  2567.     NODE_EXCEPTIONS:
  2568.     begin
  2569.       lCurrNode.ImageIndex := NODE_EXCEPTIONS_IMG;
  2570.       lCurrNode.SelectedIndex := NODE_EXCEPTIONS_IMG;
  2571.       TibcDatabaseNode(Parent.Data).ExceptionsID := lCurrNode.ItemID;
  2572.     end;
  2573.     NODE_BLOB_FILTERS:
  2574.     begin
  2575.       lCurrNode.ImageIndex := NODE_BLOB_FILTERS_IMG;
  2576.       lCurrNode.SelectedIndex := NODE_BLOB_FILTERS_IMG;
  2577.       TibcDatabaseNode(Parent.Data).FiltersID := lCurrNode.ItemID;
  2578.     end;
  2579.     NODE_GENERATORS:
  2580.     begin
  2581.       lCurrNode.ImageIndex := NODE_GENERATORS_IMG;
  2582.       lCurrNode.SelectedIndex := NODE_GENERATORS_IMG;
  2583.       TibcDatabaseNode(Parent.Data).GeneratorsID := lCurrNode.ItemID;
  2584.     end;
  2585.     NODE_ROLES:
  2586.     begin
  2587.       lCurrNode.ImageIndex := NODE_ROLES_IMG;
  2588.       lCurrNode.SelectedIndex := NODE_ROLES_IMG;
  2589.       TibcDatabaseNode(Parent.Data).RolesID := lCurrNode.ItemID;
  2590.     end;
  2591.     NODE_FUNCTIONS:
  2592.     begin
  2593.       lCurrNode.ImageIndex := NODE_FUNCTIONS_IMG;
  2594.       lCurrNode.SelectedIndex := NODE_FUNCTIONS_IMG;
  2595.       TibcDatabaseNode(Parent.Data).FunctionsID := lCurrNode.ItemID;
  2596.     end;
  2597.   end;
  2598. end;
  2599.  
  2600. procedure TfrmMain.lvActionsDblClick(Sender: TObject);
  2601. begin
  2602.   with Sender as TListView do
  2603.   begin
  2604.     if Assigned (Selected) and Assigned (Selected.Data) then
  2605.       TAction(Selected.Data).OnExecute(Sender);
  2606.   end;
  2607. end;
  2608.  
  2609. procedure TfrmMain.lvObjectsKeyDown(Sender: TObject; var Key: Word;
  2610.   Shift: TShiftState);
  2611. var
  2612.  pt: TPoint;
  2613. begin
  2614.   if (Sender as TListView).Tag in [ACTIONS, OBJECTS] then
  2615.     if (Key = VK_RETURN) then
  2616.     begin
  2617.        if (ssAlt in Shift) and Assigned (lvObjects.PopupMenu) then
  2618.        begin
  2619.          pt := ClientToScreen(lvObjects.Selected.GetPosition);
  2620.          lvObjects.PopupMenu.Popup (pt.X, pt.Y);
  2621.        end
  2622.        else
  2623.          lvObjectsDblClick (Sender);
  2624.     end;
  2625. end;
  2626.  
  2627. procedure TfrmMain.ConsoleExitExecute(Sender: TObject);
  2628. begin
  2629.   Close;
  2630. end;
  2631.  
  2632. procedure TfrmMain.DatabaseShutdownExecute(Sender: TObject);
  2633. begin
  2634.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  2635.     frmuDBShutDown.DoDBShutdown(FCurrSelServer,FCurrSelDatabase);
  2636. end;
  2637.  
  2638. procedure TfrmMain.DatabaseRegisterExecute(Sender: TObject);
  2639. var
  2640.   lDBAlias,lUserName,lPassword,lRole: string;
  2641.   lExistingAlias : String;
  2642.   lDatabaseFiles : TStringList;
  2643.   lSaveAlias, lCaseSensitive  : boolean;
  2644.  
  2645. begin
  2646.   if not Assigned(FCurrSelServer) then
  2647.     Exit;
  2648.  
  2649.   lDatabaseFiles := TStringList.Create;
  2650.   try
  2651.     tvMain.Items.BeginUpdate;
  2652.     if frmuDBRegister.RegisterDB(lDBAlias,lUserName,lPassword,lRole,
  2653.                                  lDatabaseFiles,FCurrSelServer,
  2654.                                  lSaveAlias, lCaseSensitive) then
  2655.     begin
  2656.       lExistingAlias := '';
  2657.       if not FRegistry.KeyExists(Format('%s%s\Databases\%s',[gRegServersKey,FCurrSelServer.Nodename,lDBAlias])) then
  2658.       begin
  2659.         if not IsDBRegistered(lDatabaseFiles.Strings[0], lExistingAlias) then
  2660.         begin
  2661.           if FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.Nodename,lDBAlias]),true) then
  2662.           begin
  2663.             if FRegistry.OpenKey(Format('%s%s\Databases\%s',[gRegServersKey,FCurrSelServer.Nodename,lDBAlias]),true) then
  2664.             begin
  2665.               FRegistry.WriteString('DatabaseFiles',lDatabaseFiles.Text);
  2666.               RegisterDatabase(FCurrSelServer,lDBAlias,lUserName,lPassword,lRole,
  2667.                 lDatabaseFiles,lSaveAlias, lCaseSensitive, FNILLDATABASE);
  2668.             end;
  2669.             FRegistry.CloseKey;
  2670.           end;
  2671.  
  2672.           if (lUserName <> '') and (lPassword <> '') then
  2673.           begin
  2674.             if not DoDBConnect(FCurrSelServer,FCurrSelDatabase,true) then
  2675.             begin
  2676.               FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.Nodename]),true);
  2677.               FRegistry.DeleteKey(FCurrSelDatabase.NodeName);
  2678.               FRegistry.CloseKey;
  2679.               DeleteNode(tvMain.Items.GetNode(FCurrSelDatabase.NodeID),false);
  2680.               FCurrSelDatabase := nil;
  2681.               tvMainChange(nil,nil);
  2682.               GetDatabases(FCurrSelServer);
  2683.             end;
  2684.           end;
  2685.         end
  2686.         else { database is registered }
  2687.           DisplayMsg(WAR_DUPLICATE_DB_ALIAS,'');
  2688.       end;
  2689.     end;
  2690.   finally
  2691.     lDatabaseFiles.Free;
  2692.     tvMain.Items.EndUpdate;
  2693.   end;
  2694. end;
  2695.  
  2696. procedure TfrmMain.DatabaseUnregisterExecute(Sender: TObject);
  2697. begin
  2698.   if MessageDlg('Are you sure that you want to un-register the selected database?',
  2699.       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  2700.   begin
  2701.     if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  2702.     begin
  2703.       if FCurrSelDatabase.Database.Connected then
  2704.         if not DoDBDisConnect(FCurrSelDatabase) then
  2705.         begin
  2706.           DisplayMsg (ERR_DB_DISCONNECT, 'Database registration not removed.');
  2707.           exit;
  2708.         end;
  2709.         FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.Nodename]),true);
  2710.         FRegistry.DeleteKey(FCurrSelDatabase.NodeName);
  2711.         FRegistry.CloseKey;
  2712.         DeleteNode(tvMain.Items.GetNode(FCurrSelDatabase.NodeID),false);
  2713.         FCurrSelDatabase := nil;
  2714.         tvMainChange(nil,nil);
  2715.         GetDatabases(FCurrSelServer);
  2716.     end;
  2717.   end;
  2718. end;
  2719.  
  2720. procedure TfrmMain.DatabaseConnectExecute(Sender: TObject);
  2721. begin
  2722.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase))
  2723.     and (not FCurrSelDatabase.Database.Connected) then
  2724.     DoDBConnect(FCurrSelServer,FCurrSelDatabase,true);
  2725. end;
  2726.  
  2727. procedure TfrmMain.DatabaseConnectAsExecute(Sender: TObject);
  2728. begin
  2729.   if Assigned(FCurrSelServer) and Assigned(FCurrSelDatabase) then
  2730.   begin
  2731.     if not FCurrSelDatabase.Database.Connected then
  2732.       DoDBConnect(FCurrSelServer,FCurrSelDatabase,false);
  2733.   end;
  2734. end;
  2735.  
  2736. procedure TfrmMain.DatabaseDisconnectExecute(Sender: TObject);
  2737. var
  2738.   lCurrNode: TTreeNode;
  2739. begin
  2740.   if not Assigned(FCurrSelDatabase) then
  2741.     exit;
  2742.   if MessageDlg('Are you sure that you want to close the connection to the selected database?',
  2743.       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  2744.   begin
  2745.     if DoDBDisconnect(FCurrSelDatabase) then
  2746.     begin
  2747.       lCurrNode := tvMain.Items.GetNode(FCurrSelDatabase.NodeID);
  2748.       lCurrNode.SelectedIndex := 2;
  2749.       lCurrNode.ImageIndex := 2;
  2750.       DeleteNode(lCurrNode, true);
  2751.       tvMainChange(nil,nil);
  2752.     end;
  2753.   end;
  2754. end;
  2755.  
  2756. procedure TfrmMain.ToolsStatisticsExecute(Sender: TObject);
  2757. begin
  2758.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  2759.     frmuDBStatistics.DoDBStatistics(FCurrSelServer,FCurrSelDatabase);
  2760. end;
  2761.  
  2762. procedure TfrmMain.ToolsSweepExecute(Sender: TObject);
  2763. var
  2764.   lValidation: TIBValidationService;  // validation object
  2765.   lOptions: TValidateOptions;         // validation options
  2766. begin
  2767.   // show message and verify action
  2768.   if MessageDlg('Sweeping a large database may take a while and can impact server ' +
  2769.    'performance during that time. Do you wish to perform a sweep?',
  2770.       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  2771.   begin
  2772.     // if user presses the OK button and they wish to proceed
  2773.     lValidation := Nil;                // initialize
  2774.     try
  2775.       lValidation := TIBValidationService.Create(Self);
  2776.       try                              // attach to currently selected server
  2777.         lValidation.LoginPrompt := false;
  2778.         lValidation.ServerName := FCurrSelServer.Server.ServerName;
  2779.         lValidation.Protocol := FCurrSelServer.Server.Protocol;
  2780.         lValidation.Params.Assign(FCurrSelServer.Server.Params);
  2781.         lValidation.Attach;
  2782.       except                           // if an exception occurs
  2783.         on E:EIBError do               // trap it and show error message
  2784.         begin
  2785.           DisplayMsg(ERR_SERVER_LOGIN, E.Message);
  2786.           if (E.IBErrorCode = isc_lost_db_connection) or
  2787.              (E.IBErrorCode = isc_unavailable) or
  2788.              (E.IBErrorCode = isc_network_error) then
  2789.             SetErrorState;
  2790.           Exit;
  2791.         end;
  2792.       end;
  2793.  
  2794.       if lValidation.Active then       // if successfully attached to server
  2795.       begin
  2796.         Screen.Cursor := crHourGlass;  // change cursor to hourglass
  2797.  
  2798.         // define database
  2799.         lValidation.DatabaseName := FCurrSelDatabase.DatabaseFiles.Strings[0];
  2800.  
  2801.         // clear option lists
  2802.         lValidation.Options := [];
  2803.         lOptions := [];
  2804.  
  2805.         // specify SweepDB validation option
  2806.         Include(lOptions, SweepDB);
  2807.  
  2808.         lValidation.Options := lOptions;
  2809.  
  2810.         // start service
  2811.         try
  2812.           lValidation.ServiceStart;
  2813.           while (lValidation.IsServiceRunning) and (not gApplShutdown) do
  2814.           begin
  2815.             Application.ProcessMessages;
  2816.             Screen.Cursor := crHourGlass;
  2817.           end;
  2818.  
  2819.           if lValidation.Active then
  2820.             lValidation.Detach;
  2821.         except
  2822.           on E: EIBError do
  2823.           begin
  2824.             DisplayMsg(E.IBErrorCode, E.Message);
  2825.             if (E.IBErrorCode = isc_lost_db_connection) or
  2826.                (E.IBErrorCode = isc_unavailable) or
  2827.                (E.IBErrorCode = isc_network_error) then
  2828.               SetErrorState;
  2829.         end;
  2830.       end;
  2831.       end;
  2832.     finally
  2833.       if lValidation.Active then
  2834.         lValidation.Detach;
  2835.       lValidation.Free;
  2836.       Screen.Cursor := crDefault;
  2837.       DisplayMsg(INF_DATABASE_SWEEP, '');
  2838.     end;
  2839.   end;
  2840. end;
  2841.  
  2842. procedure TfrmMain.ToolsSQLExecute(Sender: TObject);
  2843. var
  2844.   lCnt: integer;
  2845.   str: string;
  2846. begin
  2847.   with FWisql do
  2848.   begin
  2849.     if CheckTransactionStatus (true) then
  2850.     begin
  2851.  
  2852.       if Assigned(FCurrSelDatabase) and
  2853.          Assigned(FCurrSelDatabase.Database) and
  2854.          Assigned(FCurrSelDatabase.Database.Handle) and
  2855.          (FCurrSelDatabase.Database.Connected) then
  2856.       begin
  2857.         Database := FCurrSelDatabase.Database;
  2858.         OnDropDatabase := EventDatabaseDrop;
  2859.         OnCreateObject := EventObjectRefresh;
  2860.         OnDropObject := EventObjectRefresh;
  2861.       end
  2862.       else
  2863.         Database := nil;
  2864.       
  2865.       ServerList.Clear;
  2866.       for lCnt := 1 to TibcServerNode(tvMain.Items[0].Data).ObjectList.Count - 1 do
  2867.       begin
  2868.         str := TibcServerNode(tvMain.Items[0].Data).ObjectList.Strings[lCnt];
  2869.         ServerList.Append(GetNextField(Str, DEL));
  2870.       end;
  2871.       if Assigned(FCurrSelServer) and (FCurrSelServer.Server.Active) then
  2872.         ServerIndex := ServerList.IndexOf(FCurrSelServer.NodeName)
  2873.       else
  2874.         ServerIndex := -1;
  2875.  
  2876.       if Assigned (FCurrSelServer) and (FCurrSelServer.server.Active) then
  2877.       begin
  2878.       OnConnectDatabase := EventDatabaseConnect;
  2879.       OnCreateDatabase := EventDatabaseCreate;
  2880.       end;
  2881.       ShowDialog;
  2882.     end;
  2883.   end;
  2884. end;
  2885.  
  2886. procedure TfrmMain.ServerViewLogExecute(Sender: TObject);
  2887. var
  2888.   ibcLogSvc: TIBLogService;
  2889.  
  2890. begin
  2891.   ibcLogSvc := TIBLogService.create(self);
  2892.   Screen.Cursor := crHourGlass;
  2893.   try
  2894.     ibcLogSvc.ServerName := FCurrSelServer.Servername;
  2895.     ibcLogSvc.Protocol := FCurrSelServer.Server.Protocol;
  2896.     ibcLogSvc.Params := FCurrSelServer.Server.Params;
  2897.     ibcLogSvc.LoginPrompt := false;
  2898.     try
  2899.       ibcLogSvc.Attach;
  2900.       ibcLogSvc.ServiceStart;
  2901.       FCurrSelServer.OpenTextViewer (ibcLogSvc, 'Server Log', false);
  2902.       ibcLogSvc.Detach;
  2903.       Screen.Cursor := crDefault;
  2904.     except
  2905.       on E: EIBError do
  2906.       begin
  2907.         DisplayMsg(E.IBErrorCode, E.Message);
  2908.         if (E.IBErrorCode = isc_lost_db_connection) or
  2909.            (E.IBErrorCode = isc_unavailable) or
  2910.            (E.IBErrorCode = isc_network_error) then
  2911.           SetErrorState;
  2912.     end;
  2913.     end;
  2914.   finally
  2915.     ibcLogSvc.Free;
  2916.     Screen.Cursor := crDefault;
  2917.   end;
  2918. end;
  2919.  
  2920. procedure TfrmMain.ServerAddCertificateExecute(Sender: TObject);
  2921. var
  2922.   lCertificateID, lCertificateKey: string;
  2923.   ibcLicenser : TIBLicensingService;
  2924. begin
  2925.   ibcLicenser := TIBLicensingService.Create(self);
  2926.   try
  2927.     if Assigned(FCurrSelServer) and Assigned(FCurrSelTreeNode) then
  2928.     begin
  2929.       ibcLicenser.ServerName := FCurrSelServer.Servername;
  2930.       ibcLicenser.Protocol := FCurrSelServer.Server.Protocol;
  2931.       ibcLicenser.Params := FCurrSelServer.Server.Params;
  2932.       ibcLicenser.LoginPrompt := false;
  2933.       try
  2934.         ibcLicenser.Attach;
  2935.         if frmuAddCertificate.AddCertificate(lCertificateID, lCertificateKey) then
  2936.         begin
  2937.           Application.ProcessMessages;
  2938.           Screen.Cursor := crHourGlass;
  2939.           if not ibcLicenser.Active then
  2940.             ibcLicenser.Attach;
  2941.           ibcLicenser.ID := lCertificateID;
  2942.           ibcLicenser.Key := lCertificateKey;
  2943.           ibcLicenser.AddLicense;
  2944.         end;
  2945.       except
  2946.         on E:EIBInterBaseError do
  2947.         begin
  2948.           DisplayMsg(ERR_INVALID_CERTIFICATE,E.Message);
  2949.           if (E.IBErrorCode = isc_lost_db_connection) or
  2950.              (E.IBErrorCode = isc_unavailable) or
  2951.              (E.IBErrorCode = isc_network_error) then
  2952.             SetErrorState;
  2953.       end;
  2954.     end;
  2955.     end;
  2956.   finally
  2957.     Screen.Cursor := crDefault;
  2958.     ibcLicenser.Free;
  2959.     tvMainChange(nil,nil);
  2960.   end;
  2961. end;
  2962.  
  2963. procedure TfrmMain.ServerRemoveCertificateExecute(Sender: TObject);
  2964. var
  2965.   ibcLicenser : TIBLicensingService;
  2966. begin
  2967.   ibcLicenser := TIBLicensingService.Create(self);
  2968.  
  2969.   if MessageDlg(Format('Are you sure you want to remove certificate %s?',
  2970.     [FCurrSelCertificateID]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  2971.   begin
  2972.     try
  2973.       if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelTreeNode))
  2974.         and (FCurrSelTreeNode.NodeType = NODE_CERTIFICATES) then
  2975.       begin
  2976.         if lvObjects.SelCount > 0 then
  2977.         try
  2978.           Screen.Cursor := crHourGlass;
  2979.           Application.ProcessMessages;
  2980.           ibcLicenser.ServerName := FCurrSelServer.ServerName;
  2981.           ibcLicenser.Protocol := FCurrSelServer.Server.Protocol;
  2982.           ibcLicenser.Params := FCurrSelServer.Server.Params;
  2983.           ibcLicenser.LoginPrompt := false;
  2984.  
  2985.           ibcLicenser.ID := FCurrSelCertificateID;
  2986.           ibcLicenser.Key := FCurrSelCertificateKey;
  2987.           ibcLicenser.Attach;
  2988.           ibcLicenser.RemoveLicense;
  2989.         except
  2990.           on E:EIBError do
  2991.           begin
  2992.             DisplayMsg(ERR_INVALID_CERTIFICATE,E.Message + #13#10 +
  2993.               'Unable to remove certificate.');
  2994.             if (E.IBErrorCode = isc_lost_db_connection) or
  2995.                (E.IBErrorCode = isc_unavailable) or
  2996.                (E.IBErrorCode = isc_network_error) then
  2997.               SetErrorState;
  2998.         end;
  2999.       end;
  3000.       end;
  3001.     finally
  3002.       Screen.Cursor := crDefault;
  3003.       ibcLicenser.Free;
  3004.       tvMainChange(nil,nil);
  3005.     end;
  3006.   end;
  3007. end;
  3008.  
  3009. procedure TfrmMain.DatabaseRestartExecute(Sender: TObject);
  3010. var
  3011.   lConfig: TIBConfigService;
  3012. begin
  3013.   lConfig:=Nil;                        // initilialize variables
  3014.   try                                  // create ConfigService object
  3015.     lConfig:=TIBConfigService.Create(Nil);
  3016.     Screen.Cursor := crHourGlass;
  3017.     try                                // specify server information
  3018.       lConfig.LoginPrompt:=False;      // and Attempt to login
  3019.       lConfig.ServerName:=FCurrSelServer.ServerName;
  3020.       lConfig.Protocol:=FCurrSelServer.Server.Protocol;
  3021.       lConfig.DatabaseName:=FCurrSelDatabase.DatabaseFiles.Strings[0];
  3022.       lConfig.Params.Assign(FCurrSelServer.Server.Params);
  3023.       lConfig.Attach;
  3024.     except                             // if an error occurs
  3025.       on E:EIBError do                 // trap it and show
  3026.       begin                            // error message
  3027.         DisplayMsg(ERR_SERVER_LOGIN, E.Message);
  3028.         if (E.IBErrorCode = isc_lost_db_connection) or
  3029.            (E.IBErrorCode = isc_unavailable) or
  3030.            (E.IBErrorCode = isc_network_error) then
  3031.           SetErrorState;
  3032.         Exit;
  3033.       end;
  3034.     end;
  3035.  
  3036.     if lConfig.Active then             // if ConfigService is active
  3037.     begin                              // set the database name
  3038.       lConfig.DatabaseName:=FCurrSelDatabase.DatabaseFiles.Strings[0];
  3039.  
  3040.       // bring database back online
  3041.       lConfig.BringDatabaseOnline;
  3042.  
  3043.       // wait while processing
  3044.       while (lConfig.IsServiceRunning) and (not gApplShutdown) do
  3045.       begin
  3046.         Application.ProcessMessages;
  3047.         Screen.Cursor := crHourGlass;
  3048.       end;
  3049.  
  3050.       // if ConfigService is no longer active then detach
  3051.       if lConfig.Active then
  3052.         lConfig.Detach;
  3053.     end;
  3054.  
  3055.     DisplayMsg(INF_DATABASE_RESTARTED, '');
  3056.  
  3057.   finally
  3058.     Screen.Cursor := crDefault;
  3059.     // deallocate memory
  3060.     lConfig.Free;
  3061.   end;
  3062. end;
  3063.  
  3064. procedure TfrmMain.ToolsTransRecoverExecute(Sender: TObject);
  3065. begin
  3066.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  3067.     frmuDBTransactions.DoDBTransactions(FCurrSelServer,FCurrSelDatabase);
  3068. end;
  3069.  
  3070. procedure TfrmMain.DatabaseCreateExecute(Sender: TObject);
  3071. var
  3072.   DBAlias: string;
  3073.   DatabaseFiles: TStringList;
  3074. begin
  3075.   if Assigned(FCurrSelServer) then
  3076.   begin
  3077.     DatabaseFiles := TStringList.Create;
  3078.     try
  3079.       if frmuDBCreate.CreateDB(DBAlias,DatabaseFiles,FCurrSelServer) = SUCCESS then
  3080.       begin
  3081.         RegisterDatabase(FCurrSelServer,DBAlias,'','','',DatabaseFiles,
  3082.           True, false, FNILLDATABASE);
  3083.         if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase))
  3084.           and (not FCurrSelDatabase.Database.Connected) then
  3085.           DoDBConnect(FCurrSelServer,FCurrSelDatabase,true);
  3086.       end;
  3087.     finally
  3088.       DatabaseFiles.Free;
  3089.     end;
  3090.   end;
  3091. end;
  3092.  
  3093. procedure TfrmMain.DatabaseDropExecute(Sender: TObject);
  3094. var
  3095.   lOriginalState : Boolean;
  3096. begin
  3097.   if MessageDlg('Are you sure that you want to drop the selected database?',
  3098.       mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  3099.   begin
  3100.     lOriginalState := FCurrSelDatabase.Database.Connected;
  3101.  
  3102.     // disconnect from database
  3103.     FCurrSelDatabase.Database.Connected := False;
  3104.  
  3105.     // check if the database is open
  3106.     if not FCurrSelDatabase.Database.Connected then
  3107.     begin
  3108.       // if the databsae is not open then connect to it using the username
  3109.       // and password used to connected to the server
  3110.       FCurrSelDatabase.Database.LoginPrompt:=False;
  3111.       FCurrSelDatabase.Database.Params.Add(Format('isc_dpb_user_name=%s',[FCurrSelServer.UserName]));
  3112.       FCurrSelDatabase.Database.Params.Add(Format('isc_dpb_password=%s',[FCurrSelServer.Password]));
  3113.       FCurrSelDatabase.Database.Connected:=True;
  3114.     end;
  3115.  
  3116.     try
  3117.     // drop the databsae
  3118.     FCurrSelDatabase.Database.DropDatabase;
  3119.  
  3120.     // remove from treeview and un-register from the windows registry
  3121.     if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  3122.     begin
  3123.       FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.Nodename]),true);
  3124.       FRegistry.DeleteKey(FCurrSelDatabase.NodeName);
  3125.       FRegistry.CloseKey;
  3126.       DeleteNode(tvMain.Items.GetNode(FCurrSelDatabase.NodeID),false);
  3127.       tvMainChange(nil,nil);
  3128.       GetDatabases(FCurrSelServer);
  3129.     end;
  3130.     except
  3131.       on E : EIBError do
  3132.       begin
  3133.         DisplayMsg(ERR_DROP_DATABASE, E.Message);
  3134.         FCurrSelDatabase.Database.Connected := lOriginalState;
  3135.       end;
  3136.     end;
  3137.   end;
  3138. end;
  3139.  
  3140. procedure TfrmMain.ToolsValidationExecute(Sender: TObject);
  3141. begin
  3142.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  3143.     frmuDBValidation.DoDBValidation(FCurrSelServer,FCurrSelDatabase);
  3144. end;
  3145.  
  3146. procedure TfrmMain.DatabasePropertiesExecute(Sender: TObject);
  3147. begin
  3148.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  3149.     frmuDBProperties.EditDBProperties(FCurrSelServer,FCurrSelDatabase);
  3150.  
  3151.   GetDatabases(FCurrSelServer);
  3152. end;
  3153.  
  3154. procedure TfrmMain.DatabaseRestoreExecute(Sender: TObject);
  3155. var
  3156.   bckupAlias: TibcBackupAliasNode;
  3157.  
  3158. begin
  3159.   if Assigned(FCurrSelServer) and Assigned(FCurrSelTreeNode) then
  3160.   begin
  3161.     if frmuDBRestore.DoDBRestore(FCurrSelServer, FCurrSelTreeNode) = SUCCESS then
  3162.     begin
  3163.       if FCurrSelTreeNode is TibcBackupAliasNode then
  3164.       begin
  3165.       bckupAlias := TibcBackupAliasNode(FCurrSelTreeNode);
  3166.       if FRegistry.OpenKey(Format('%s%s\Backup Files\%s',[gRegServersKey, FCurrSelServer.NodeName,
  3167.         FCurrSelTreeNode.Nodename]), false) then
  3168.       begin
  3169.         FRegistry.WriteDateTime ('Accessed', Now);
  3170.         FRegistry.WriteString('SourceDBAlias', bckupAlias.SourceDBAlias);
  3171.         FRegistry.WriteString('SourceDBServer', bckupAlias.SourceDBServer);
  3172.       end;
  3173.     end;
  3174.   end;
  3175. end;
  3176. end;
  3177.  
  3178. procedure TfrmMain.HelpAboutExecute(Sender: TObject);
  3179. begin
  3180.   frmuAbout.ShowAboutDialog('IBConsole', APP_VERSION);
  3181. end;
  3182.  
  3183. procedure TfrmMain.BackupRestoreModifyAliasExecute(Sender: TObject);
  3184. begin
  3185.   if (Assigned(FCurrSelTreeNode)) and (FCurrSelTreeNode is TibcBackupAliasNode) then
  3186.     frmuBackupAliasProperties.EditBackupAliasProperties(FCurrSelServer,TibcBackupAliasNode(FCurrSelTreeNode));
  3187.  
  3188.   GetBackupFiles(FCurrSelServer);
  3189. end;
  3190.  
  3191. procedure TfrmMain.ServerDiagConnectionExecute(Sender: TObject);
  3192. begin
  3193.   frmuCommDiag.DoDiagnostics(FCurrSelServer);
  3194. end;
  3195.  
  3196. procedure TfrmMain.ServerLoginExecute(Sender: TObject);
  3197. begin
  3198.   DoServerLogin(false);
  3199. end;
  3200.  
  3201. procedure TfrmMain.ServerLogoutExecute(Sender: TObject);
  3202. var
  3203.   lCurrNode     : TTreeNode;
  3204.   lDatabaseNode : TibcDatabaseNode;
  3205.   i             : integer;
  3206. begin
  3207.   if FErrorState or (MessageDlg('Are you sure that you want to close the connection to the selected server?',
  3208.       mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
  3209.   begin
  3210.     if Assigned (FCurrSelDatabase) then
  3211.     begin
  3212.       DoDBDisConnect(FCurrSelDatabase);
  3213.       FCurrSelDatabase := nil;
  3214.     end;
  3215.  
  3216.     if Assigned(FCurrSelServer) then
  3217.     begin
  3218.       try
  3219.         if Assigned(FCurrSelServer.OutputWindow) and
  3220.           (FCurrSelServer.OutputWindow.WindowState in [wsNormal, wsMinimized, wsMaximized])
  3221.         then
  3222.           FCurrSelServer.OutputWindow.Close;
  3223.           
  3224.         if FCurrSelServer.Version > 5 then
  3225.           FCurrSelServer.Server.Detach;
  3226.  
  3227.         FCurrSelServer.Version := 6;
  3228.         if not FCurrSelServer.Server.Active then
  3229.         begin
  3230.           lCurrNode := tvMain.Items.GetNode(FCurrSelServer.DatabasesID);
  3231.           for i := lCurrNode.Count - 1 downto 0  do
  3232.           begin
  3233.             lDatabaseNode := TibcDatabaseNode(lCurrNode.Item[i].Data);
  3234.             DoDBDisconnect(lDatabaseNode);
  3235.             DeleteNode(lCurrNode.Item[i], true);
  3236.             lCurrNode.Item[i].SelectedIndex := 2;
  3237.             lCurrNode.Item[i].ImageIndex := 2;
  3238.           end;
  3239.           lCurrNode := tvMain.Items.GetNode(FCurrSelServer.NodeID);
  3240.           DeleteNode(lCurrNode, true);
  3241.           lCurrNode.SelectedIndex := 1;
  3242.           lCurrNode.ImageIndex := 1;
  3243.           lCurrNode.Collapse(true);
  3244.         end;
  3245.         tvMain.Refresh;
  3246.         tvMainChange(nil,nil);
  3247.       except
  3248.         DisplayMsg(ERR_SERVER_SERVICE, 'This server may be shutdown or disconnected.');
  3249.  
  3250.         if not FCurrSelServer.Server.Active then
  3251.         begin
  3252.           tvMain.Items.BeginUpdate;
  3253.           lCurrNode := tvMain.Items.GetNode(FCurrSelServer.DatabasesID);
  3254.           if Assigned (lCurrNode) then
  3255.           begin
  3256.           for i := lCurrNode.Count - 1 downto 0  do
  3257.           begin
  3258.             lDatabaseNode := TibcDatabaseNode(lCurrNode.Item[i].Data);
  3259.             DoDBDisconnect(lDatabaseNode);
  3260.             DeleteNode(lCurrNode.Item[i], true);
  3261.             lCurrNode.Item[i].SelectedIndex := 2;
  3262.             lCurrNode.Item[i].ImageIndex := 2;
  3263.           end;
  3264.           end;
  3265.           lCurrNode := tvMain.Items.GetNode(FCurrSelServer.NodeID);
  3266.           DeleteNode(lCurrNode, true);
  3267.           lCurrNode.SelectedIndex := 1;
  3268.           lCurrNode.ImageIndex := 1;
  3269.           lCurrNode.Collapse(true);
  3270.         end;
  3271.         tvMain.Refresh;
  3272.         tvMainChange(nil,nil);
  3273.         tvMain.Items.EndUpdate;        
  3274.       end;  // of try except
  3275.     end;  // of if assigned
  3276.   end;  // of confirmation
  3277. end;
  3278.  
  3279. procedure TfrmMain.ServerPropertiesExecute(Sender: TObject);
  3280. begin
  3281.   if Assigned(FCurrSelServer) then
  3282.     frmuServerProperties.EditServerProperties(FCurrSelServer);
  3283. end;
  3284.  
  3285. procedure TfrmMain.ServerRegisterExecute(Sender: TObject);
  3286. var
  3287.   lServerName,lServerAlias,lUserName,lPassword, lDescription: string;
  3288.   lSaveAlias: boolean;
  3289.   lProtocol: TProtocol;
  3290. begin
  3291.   try
  3292.     tvMain.Items.BeginUpdate;
  3293.     lvObjects.Items.BeginUpdate;
  3294.     if frmuServerRegister.RegisterServer(lServerName,lServerAlias,lUserName,lPassword, lDescription,lProtocol,REGISTER_SERVER,lSaveAlias) = SUCCESS then
  3295.     begin
  3296.       if not FRegistry.KeyExists(Format('%s%s',[gRegServersKey,lServerName])) then
  3297.       begin
  3298.         if RegisterServer(lServerName,lServerAlias,lUserName,lPassword,lDescription,lProtocol,lSaveAlias, Now) then
  3299.         begin
  3300.           if (lUserName <> '') and (lPassword <> '') then
  3301.           begin
  3302.           { NOTE:  This code has been duplicated to save time }
  3303.             try
  3304.               DoServerLogin(true);
  3305.             except
  3306.               on E: Exception do
  3307.               begin
  3308.                 FRegistry.DeleteKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.NodeName]));
  3309.                 FRegistry.DeleteKey(Format('%s%s',[gRegServersKey, FCurrSelServer.NodeName]));
  3310.                 FRegistry.CloseKey;
  3311.                 DeleteNode(tvMain.Items.GetNode(FCurrSelServer.NodeID),false);
  3312.                 FCurrSelServer := nil;
  3313.                 tvMainChange(nil,nil);
  3314.                 GetServers;
  3315.                 tvMain.Selected := tvMain.TopItem;
  3316.                 tvMain.Items.EndUpdate;
  3317.                 lvObjects.Items.EndUpdate;
  3318.                 DisplayMsg (ERR_SERVER_LOGIN, E.Message);
  3319.               end;
  3320.             end;
  3321.           end;
  3322.         end;
  3323.       end
  3324.       else
  3325.         DisplayMsg(WAR_SERVER_REGISTERED,'');
  3326.     end;
  3327.   finally
  3328.     tvMain.Items.EndUpdate;
  3329.     lvObjects.Items.EndUpdate;
  3330.   end;
  3331. end;
  3332.  
  3333. procedure TfrmMain.ServerUnregisterExecute(Sender: TObject);
  3334. begin
  3335.   if Assigned(FCurrSelServer) then
  3336.   begin
  3337.     if UnRegisterServer (FCurrSelServer.Nodename) then
  3338.     begin
  3339.       if Assigned(FCurrSelServer.OutputWindow) and
  3340.         (FCurrSelServer.OutputWindow.WindowState in [wsNormal, wsMinimized, wsMaximized])
  3341.       then
  3342.         FCurrSelServer.OutputWindow.Close;
  3343.  
  3344.       DeleteNode(tvMain.Items.GetNode(FCurrSelServer.NodeID),false);
  3345.       FCurrSelServer := nil;
  3346.       tvMainChange(nil,nil);
  3347.       GetServers();
  3348.       tvMain.Selected := tvMain.TopItem;
  3349.     end;
  3350.   end;
  3351. end;
  3352.  
  3353. procedure TfrmMain.ServerSecurityExecute(Sender: TObject);
  3354. begin
  3355.   if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelTreeNode) and
  3356.     (FCurrSelTreeNode.NodeType = NODE_USERS)) then
  3357.   begin
  3358.     if lvObjects.SelCount > 0 then
  3359.       frmuUser.UserInfo(FCurrSelServer,lvObjects.Selected.Caption)
  3360.     else
  3361.       frmuUser.UserInfo(FCurrSelServer,'');
  3362.   end
  3363.   else
  3364.     frmuUser.UserInfo(FCurrSelServer,'');
  3365. end;
  3366.  
  3367. procedure TfrmMain.ViewSystemDataExecute(Sender: TObject);
  3368. begin
  3369.   FViewSystemData := not (Sender as TAction).Checked;
  3370.   gAppSettings[SYSTEM_DATA].Setting := FViewSystemData;
  3371.   if lvObjects.Tag = OBJECTS then
  3372.   begin
  3373.     lvObjects.Items.BeginUpdate;
  3374.     lvObjects.Items.Clear;
  3375.     GetDBObjects(FCurrSelDatabase,FCurrSelTreeNode, FCurrSelTreeNode.NodeType);
  3376.     FillObjectList (FCurrSelTreeNode);
  3377.     lvObjects.Items.EndUpdate;
  3378.   end;
  3379. end;
  3380.  
  3381. procedure TfrmMain.EditFontExecute(Sender: TObject);
  3382. begin
  3383.   if ActiveControl is TRichEditX then
  3384.     with (ActiveControl as TRichEditX) do
  3385.       ChangeFont;
  3386. end;
  3387.  
  3388. procedure TfrmMain.DatabaseBackupExecute(Sender: TObject);
  3389. var
  3390.   lSourceDBAlias,lBackupAlias: string;
  3391.   lBackupFiles: TStringList;
  3392.   lBackupAliasNode: TibcBackupAliasNode;  
  3393. begin
  3394.  lBackupFiles := TStringList.Create;
  3395.  try
  3396.    if Assigned(FCurrSelServer) then
  3397.     begin
  3398.       if Assigned(FCurrSelTreeNode) and (FcurrSelTreeNode.NodeType = NODE_BACKUP_ALIAS) then
  3399.       begin
  3400.         lBackupAliasNode := TibcBackupAliasNode(FCurrSelTreeNode);
  3401.         lSourceDBAlias := lBackupAliasNode.SourceDBAlias;
  3402.         lBackupAlias := FCurrSelTreeNode.NodeName;
  3403.         lBackupFiles.Text := lBackupAliaSNode.BackupFiles.Text;
  3404.       end;
  3405.  
  3406.       if Assigned (FCurrSelTreeNode) and (FCurrSelTreeNode.NodeType = NODE_DATABASE) then
  3407.         lSourceDBAlias := FCurrSelTreeNode.NodeName;
  3408.         
  3409.       if frmuDBBackup.DoDBBackup(lSourceDBAlias, lBackupAlias,
  3410.         lBackupFiles, FCurrSelServer,FCurrSelDatabase) = SUCCESS then
  3411.       begin
  3412.         if not FRegistry.KeyExists(Format('%s%s\Backup Files\%s',[gRegServersKey,FCurrSelServer.Nodename,lBackupAlias])) then
  3413.         begin
  3414.           RegisterBackupFile(FCurrSelServer,lSourceDBAlias,lBackupAlias, lBackupFiles);
  3415.         end
  3416.         else
  3417.         begin
  3418.           if FRegistry.OpenKey(Format('%s%s\Backup Files\%s',[gRegServersKey,FCurrSelServer.Nodename,lBackupAlias]),false) then
  3419.           begin
  3420.             FRegistry.WriteString('BackupFiles',lBackupFiles.Text);
  3421.             FRegistry.CloseKey;
  3422.           end;
  3423.         end;
  3424.       end;
  3425.     end;
  3426.   finally
  3427.     lBackupFiles.Free;
  3428.   end
  3429. end;
  3430.  
  3431. procedure TfrmMain.DatabaseMetadataExecute(Sender: TObject);
  3432. begin
  3433.   GetDDLScript;
  3434. end;
  3435.  
  3436. procedure TfrmMain.ViewListExecute(Sender: TObject);
  3437. begin
  3438.   lvObjects.ViewStyle := vsList;
  3439. end;
  3440.  
  3441. procedure TfrmMain.ViewListUpdate(Sender: TObject);
  3442. begin
  3443.   (Sender as TAction).Checked := (lvObjects.ViewStyle = vsList);
  3444. end;
  3445.  
  3446. procedure TfrmMain.ViewReportExecute(Sender: TObject);
  3447. begin
  3448.   lvObjects.ViewStyle := vsReport;
  3449. end;
  3450.  
  3451. procedure TfrmMain.ViewReportUpdate(Sender: TObject);
  3452. begin
  3453.   (Sender as TAction).Checked := (lvObjects.ViewStyle = vsReport);
  3454. end;
  3455.  
  3456. procedure TfrmMain.ViewIconExecute(Sender: TObject);
  3457. begin
  3458.   lvObjects.ViewStyle := vsIcon;
  3459. end;
  3460.  
  3461. procedure TfrmMain.ViewIconUpdate(Sender: TObject);
  3462. begin
  3463.   (Sender as TAction).Checked := (lvObjects.ViewStyle = vsIcon);
  3464. end;
  3465.  
  3466. procedure TfrmMain.ViewSmallIconExecute(Sender: TObject);
  3467. begin
  3468.   lvObjects.ViewStyle := vsSmallIcon;
  3469. end;
  3470.  
  3471. procedure TfrmMain.ViewSmallIconUpdate(Sender: TObject);
  3472. begin
  3473.   (Sender as TAction).Checked := (lvObjects.ViewStyle = vsSmallIcon);
  3474. end;
  3475.  
  3476. procedure TfrmMain.FillActionList(const ActionList: TActionList);
  3477. var
  3478.   lCnt: Integer;
  3479.   ListItem: TListItem;
  3480.   LColumn: TListColumn;
  3481. begin
  3482.   lvObjects.Tag := ACTIONS;
  3483.  
  3484.   if FLastActions <> ActionList then
  3485.   begin
  3486.     FLastActions := ActionList;
  3487.     lvObjects.Items.BeginUpdate;
  3488.     lvObjects.Items.Clear;
  3489.  
  3490.     lvObjects.Columns.BeginUpdate;
  3491.     lvObjects.Columns.Clear;
  3492.  
  3493.     lColumn := lvObjects.Columns.Add;
  3494.     lColumn.Caption := 'Action';
  3495.  
  3496.     lColumn := lvObjects.Columns.Add;
  3497.     lColumn.Caption := 'Description';
  3498.  
  3499.     lvObjects.Columns.EndUpdate;
  3500. { TODO: Do not show icons since not all objects have them }
  3501.  
  3502.     lvObjects.SmallImages := nil;
  3503.     lvObjects.StateImages := nil;
  3504.     lvObjects.LargeImages := nil;
  3505.     with ActionList do
  3506.     begin
  3507.       for lCnt := 0 to ActionCount-1 do
  3508.       begin
  3509.         with Actions[lCnt] as TAction do
  3510.         begin
  3511.           if Tag <> 1 then
  3512.           begin
  3513.             if (Tag = SYSDBA_ONLY) and
  3514.                (UpperCase(FCurrSelServer.UserName) <> 'SYSDBA') then
  3515.               continue;
  3516.             ListItem := lvObjects.Items.Add;
  3517.             ListItem.Caption := StripMenuChars(Caption);
  3518. //            ListItem.ImageIndex := ImageIndex;
  3519.             ListItem.SubItems.Add (Hint);
  3520.             ListItem.Data := TAction(Actions[lCnt]);
  3521.           end;
  3522.         end;
  3523.       end;
  3524.     end;
  3525.     lvObjects.Items.EndUpdate;
  3526.  
  3527.     lvObjects.Columns.BeginUpdate;
  3528.     for lCnt := 0 to lvObjects.Columns.Count - 1 do
  3529.     begin
  3530.       lvObjects.Columns[lCnt].Width := ColumnTextWidth;
  3531.     end;
  3532.     lvObjects.Columns.EndUpdate;
  3533.  
  3534.   end;
  3535. end;
  3536.  
  3537. procedure TfrmMain.DatabaseConnectedActionsUpdate(Sender: TObject);
  3538. begin
  3539.   if Assigned(FCurrSelDatabase) and
  3540.      Assigned (FCurrSelDatabase.Database) and  
  3541.      Assigned (FCurrSelDatabase.Database.Handle) then
  3542.     (Sender as TAction).Enabled := FCurrSelDatabase.Database.Connected
  3543.   else
  3544.     (Sender as TAction).Enabled := false;
  3545. end;
  3546.  
  3547. procedure TfrmMain.ServerActionsUpdate(Sender: TObject);
  3548. begin
  3549.   if Assigned(FCurrSelServer) and Assigned (FCurrSelServer.Server) then
  3550.     if FCurrSelTreeNode.NodeType  = NODE_SERVERS then
  3551.       (Sender as TAction).Enabled := false
  3552.     else
  3553.       (Sender as TAction).Enabled := not FCurrSelServer.Server.Active
  3554.   else
  3555.     (Sender as TAction).Enabled := true;
  3556. end;
  3557.  
  3558. procedure TfrmMain.ServerConnectedUpdate(Sender: TObject);
  3559. begin
  3560.   if Assigned(FCurrSelServer) and Assigned (FCurrSelServer.Server) then
  3561.     if FCurrSelTreeNode.NodeType  = NODE_SERVERS then
  3562.       (Sender as TAction).Enabled := false
  3563.     else
  3564.       (Sender as TAction).Enabled := FCurrSelServer.Server.Active
  3565.   else
  3566.     (Sender as TAction).Enabled := false;
  3567. end;
  3568.  
  3569. procedure TfrmMain.DatabaseRegisterUpdate(Sender: TObject);
  3570. begin
  3571.   if Assigned(FCurrSelDatabase) and
  3572.      Assigned (FCurrSelDatabase.Database) and
  3573.      Assigned (FCurrSelDatabase.Database.Handle) then
  3574.     (Sender as TAction).Enabled := not FCurrSelDatabase.Database.Connected
  3575.   else
  3576.     (Sender as TAction).Enabled := false;
  3577. end;
  3578.  
  3579. procedure TfrmMain.EventDatabaseDrop;
  3580. begin
  3581.   // remove from treeview and un-register from the windows registry
  3582.   try
  3583.     if (Assigned(FCurrSelServer)) and (Assigned(FCurrSelDatabase)) then
  3584.     begin
  3585.       FRegistry.OpenKey(Format('%s%s\Databases',[gRegServersKey,FCurrSelServer.Nodename]),true);
  3586.       FRegistry.DeleteKey(FCurrSelDatabase.NodeName);
  3587.       FRegistry.CloseKey;
  3588.       DeleteNode(tvMain.Items.GetNode(FCurrSelDatabase.NodeID),false);
  3589.       tvMainChange(nil,nil);
  3590.       GetDatabases(FCurrSelServer);
  3591.     end;
  3592.   except
  3593.     on E : EIBError do
  3594.     begin
  3595.       DisplayMsg(ERR_DROP_DATABASE, E.Message);
  3596.     end;
  3597.   end;
  3598. end;
  3599.  
  3600. procedure TfrmMain.EventDatabaseCreate(var Database: TIBDatabase);
  3601. var
  3602.   dbName: TStringList;
  3603.   alias,
  3604.   username,
  3605.   password,
  3606.   role:  String;
  3607.   lCnt: integer;
  3608. begin
  3609.   if Assigned(FCurrSelServer) and (FCurrSelServer.Server.Active) then
  3610.   begin
  3611.     dbName := TStringList.create;
  3612.     dbName.append(Database.DatabaseName);
  3613.     alias := ExtractFileName(Database.DatabaseName);
  3614.  
  3615.     { Check to make sure that we are not overwriting an alias }
  3616.     lCnt := 0;
  3617.     while AliasExists(Alias) do
  3618.     begin
  3619.       Inc(lCnt);
  3620.       Alias := Format('%s_%d',[Alias, lCnt]);
  3621.     end;
  3622.  
  3623.     username := Database.DBParamByDPB[isc_dpb_user_name];
  3624.     password := Database.DBParamByDPB[isc_dpb_password];
  3625.     role := Database.DBParamByDPB[isc_dpb_sql_role_name];
  3626.  
  3627.     if FCurrSelServer.Server.Protocol = Local then
  3628.       if ExtractFilePath(Database.DatabaseName) = '' then
  3629.          Database.DatabaseName := ExtractFilePath(Application.ExeName)+Database.Databasename;
  3630.  
  3631.     RegisterDatabase (FCurrSelServer, alias, username, password, role, dbName,
  3632.       true, false, Database);
  3633.     dbName.Free;
  3634.     GetDatabases(FCurrSelServer);
  3635.     FillObjectList(FCurrSelTreeNode);
  3636.     DoDBConnect(FCurrSelServer, FCurrSelDatabase, true);
  3637.     FWisql.OnCreateObject := EventObjectRefresh;
  3638.     FWisql.OnDropObject := EventObjectRefresh;
  3639.     FWisql.OnDropDatabase := EventDatabaseDrop;
  3640.   end;
  3641. end;
  3642.  
  3643. procedure TfrmMain.EventObjectRefresh(const Database: TIBDatabase;
  3644.   const ObjType: integer);
  3645. begin
  3646.   if ObjType = NODE_UNK then
  3647.     case FcurrSelTreeNode.NodeType of
  3648.       NODE_DOMAINS:
  3649.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_DOMAIN);
  3650.       NODE_TABLES:
  3651.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_TABLE);
  3652.       NODE_VIEWS:
  3653.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_VIEW);
  3654.       NODE_PROCEDURES:
  3655.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_PROCEDURE);
  3656.       NODE_FUNCTIONS:
  3657.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_FUNCTION);
  3658.       NODE_GENERATORS:
  3659.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_GENERATOR);
  3660.       NODE_EXCEPTIONS:
  3661.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_EXCEPTION);
  3662.       NODE_BLOB_FILTERS:
  3663.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_BLOB_FILTER);
  3664.       NODE_ROLES:
  3665.         GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, NODE_ROLE);
  3666.     end
  3667.   else
  3668.     GetDBObjects (FCurrSelDatabase, FCurrSelTreeNode, ObjType);
  3669.   FillObjectList (FCurrSelTreeNode);
  3670.   FRefetch := true;
  3671.   
  3672.   if Assigned (FCurrSelDatabase.ObjectViewer) then
  3673.     FCurrSelDatabase.ObjectViewer.Refetch;
  3674. end;
  3675.  
  3676. procedure TfrmMain.DatabaseActionsUpdate(Sender: TObject);
  3677. begin
  3678.   if Assigned (FCurrSelTreeNode) and (FCurrSelTreeNode.NodeType = NODE_DATABASE) then
  3679.   begin
  3680.     if Assigned (FCurrSelServer) and Assigned (FCurrSelServer.server) then
  3681.       (Sender as TAction).Enabled := FCurrSelServer.Server.Active
  3682.     else
  3683.       (Sender as TAction).Enabled := false;
  3684.     end
  3685.   else
  3686.     (Sender as TAction).Enabled := false;
  3687. end;
  3688.  
  3689. procedure TfrmMain.EventDatabaseConnect(const ServerName: String; const Database: TIBDatabase);
  3690. begin
  3691. { TODO: implement }
  3692. {
  3693.     FWisql.OnCreateObject := EventObjectRefresh;
  3694.     FWisql.OnDropObject := EventObjectRefresh;
  3695.     FWisql.OnDropDatabase := EventDatabaseDrop;
  3696. }
  3697. end;
  3698. {
  3699. procedure TfrmMain.EventServerConnect(const ServerName: string);
  3700. var
  3701.   treeNode: TTreeNode;
  3702.   ibTreeNode: TibcTreeNode;
  3703. begin
  3704.   with tvMain do
  3705.   begin
  3706.     treeNode := Items.GetFirstNode;
  3707.     treeNode := treeNode.GetFirstChild;
  3708.     if Assigned(treeNode) then
  3709.       ibTreeNode := TibcTreeNode(treeNode.Data)
  3710.     else
  3711.       ibTreeNode := nil;
  3712.     while Assigned(treeNode) and (ibTreeNode is TibcServerNode) do
  3713.     begin
  3714.       if (AnsiCompareText (ibTreeNode.NodeName, ServerName) = 0) then
  3715.       begin
  3716.         FCurrSelServer := TibcServerNode(ibtreeNode);
  3717.         if not FCurrSelServer.Server.Active then
  3718.           DoServerLogin (false);
  3719.         exit;
  3720.       end;
  3721.       treeNode := treeNode.GetNextSibling;
  3722.       if Assigned(treeNode) then
  3723.         ibTreeNode := TibcTreeNode(treeNode.Data)
  3724.       else
  3725.         ibTreeNode := nil;
  3726.     end;
  3727.   end;
  3728. end;
  3729. }
  3730. procedure TfrmMain.ExtToolsConfigureExecute(Sender: TObject);
  3731. var
  3732.   dlgTools: TfrmTools;
  3733. begin
  3734.   dlgTools := TfrmTools.Create (self);
  3735.   dlgTools.ShowModal;
  3736.   dlgTools.Free;
  3737. end;
  3738.  
  3739. procedure TfrmMain.ExtToolDropDownExecute(Sender: TObject);
  3740. var
  3741.   MenuItem: TMenuItem;
  3742.   lCnt, x : integer;
  3743. begin
  3744.  
  3745.   { Clear out all external tool options }
  3746.   lCnt := ToolMenu.Count;
  3747.   for x := lCnt - 1 downto FToolMenuIdx do
  3748.   begin
  3749.      MenuItem := ToolMenu.Items[x];
  3750.      MenuItem.Free;
  3751.   end;
  3752.  
  3753.   if gExternalApps.Count > 0 then
  3754.   begin
  3755.     { Add a separator }
  3756.     ToolMenu.NewBottomLine;
  3757.     for lCnt := 0 to gExternalApps.Count - 1 do
  3758.     begin
  3759.       MenuItem := ToolMenu.Find (gExternalApps.Strings[lCnt]);
  3760.       if not Assigned (MenuItem) then
  3761.       begin
  3762.         MenuItem := TMenuItem.Create (self);
  3763.         MenuItem.OnClick := ExtToolLaunchExecute;
  3764.         MenuItem.Caption := gExternalApps.Strings[lCnt];
  3765.         MenuItem.Tag := lCnt;
  3766.         ToolMenu.Add (MenuItem);
  3767.       end;
  3768.     end;
  3769.   end;
  3770. end;
  3771.  
  3772. procedure TfrmMain.ExtToolLaunchExecute(Sender: TObject);
  3773. var
  3774.   Reg: TRegistry;
  3775.   lPos: integer;
  3776.   retval: boolean;
  3777.   path,
  3778.   workDir,
  3779.   cmdLine,
  3780.   params: string;
  3781.   StartupInfo: TStartupInfo;
  3782.   ProcessInfo: TProcessInformation;
  3783.   buf: array[byte] of char;
  3784.  
  3785. begin
  3786.   with (Sender as TMenuItem) do
  3787.   begin
  3788.     lPos := Tag;
  3789.     Reg := TRegistry.Create;
  3790.     with Reg do
  3791.     begin
  3792.       OpenKey (gRegToolsKey, false);
  3793.       path := ReadString (Format('Path%d', [lPos]));
  3794.       workDir := ReadString (Format('WorkingDir%d', [lPos]));
  3795.       Params := ReadString (Format('Params%d', [lPos]));
  3796.       CloseKey;
  3797.       Free;
  3798.     end;
  3799.     cmdLine := Path+' '+Params;
  3800.     try
  3801.       FillChar (StartupInfo, sizeof(StartupInfo), 0);
  3802.       StartupInfo.cb := sizeof (StartupInfo);
  3803.       retval := CreateProcess (nil, PChar(CmdLine), nil, nil, False,
  3804.          NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
  3805.  
  3806.       if not retval then
  3807.       begin
  3808.         FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError,
  3809.                 LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil);
  3810.         raise Exception.Create (Buf+#13#10+'Command: '+cmdLine);
  3811.       end;
  3812.     except
  3813.       on E: Exception do
  3814.       begin
  3815.         DisplayMsg (ERR_EXT_TOOL_ERROR, E.Message);
  3816.       end;
  3817.     end;
  3818.   end;
  3819. end;
  3820.  
  3821. procedure TfrmMain.BackupRestoreUpdate(Sender: TObject);
  3822. begin
  3823.   if Assigned (FCurrSelDatabase) and
  3824.      Assigned (FCurrSelDatabase.Database) and
  3825.      Assigned (FCurrSelDatabase.Database.Handle) then
  3826.     (Sender as TAction).Enabled := FcurrSelDatabase.Database.Connected
  3827.   else
  3828.     (Sender as TAction).Enabled := false;
  3829. end;
  3830.  
  3831. procedure TfrmMain.DatabaseCreateUpdate(Sender: TObject);
  3832. begin
  3833.   if Assigned (FCurrSelServer) and Assigned (FCurrSelServer.server) then
  3834.     (Sender as TAction).Enabled := FCurrSelServer.Server.Active
  3835.   else
  3836.     (Sender as TAction).Enabled := false;
  3837. end;
  3838.  
  3839. function TfrmMain.GetDBObjects(const SelDatabaseNode: TibcDatabaseNode;
  3840.   const SelTreeNode: TibcTreeNode; const ObjType: integer): integer;
  3841. var
  3842.   lObjectList: TStringList;
  3843.   retval: integer;
  3844. begin
  3845.   result := FAILURE;
  3846.   lObjectList := nil;
  3847.   lObjectList := TStringList.Create;
  3848.   try
  3849.     Screen.Cursor := crHourGlass;
  3850.     case FCurrSelTreeNode.NodeType of
  3851.       NODE_DOMAINS: retval := dmMain.GetDomainList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3852.       NODE_TABLES: retval := dmMain.GetTableList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3853.       NODE_VIEWS: retval := dmMain.GetViewList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3854.       NODE_PROCEDURES: retval := dmMain.GetProcedureList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3855.       NODE_FUNCTIONS: retval := dmMain.GetFunctionList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3856.       NODE_GENERATORS: retval := dmMain.GetGeneratorList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3857.       NODE_EXCEPTIONS: retval := dmMain.GetExceptionList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3858.       NODE_BLOB_FILTERS: retval := dmMain.GetBlobFilterList(lObjectList, SelDatabaseNode.Database, FViewSystemData);
  3859.       NODE_ROLES: retval := dmMain.GetRoleList(lObjectList, SelDatabaseNode.Database);
  3860.       else
  3861.         retval := FAILURE;
  3862.     end;
  3863.     if  retval = SUCCESS then
  3864.     begin
  3865.       SelTreeNode.ObjectList.Assign(lObjectList);
  3866.       result := SUCCESS;
  3867.     end
  3868.     else
  3869.       selTreeNode.ObjectList.Clear;
  3870.   finally
  3871.     lObjectList.Free;
  3872.     Screen.Cursor := crDefault;
  3873.   end;
  3874. end;
  3875.  
  3876. procedure TfrmMain.EditFontUpdate(Sender: TObject);
  3877. begin
  3878.   (Sender as TAction).Enabled := (ActiveControl is TRichEditX);
  3879. end;
  3880.  
  3881.  
  3882. procedure TfrmMain.listViewEnter(Sender: TObject);
  3883. begin
  3884.   if (Sender is TListView) then
  3885.   begin
  3886.     with (Sender as TListView) do
  3887.     begin
  3888.       if not Assigned (Selected) then
  3889.         Selected := TopItem;
  3890.     end;
  3891.   end;
  3892. end;
  3893.  
  3894.  
  3895. procedure TfrmMain.frmMainDestroy(Sender: TObject);
  3896. begin
  3897. //  SetWindowLong(frmMain.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
  3898.   inherited;
  3899. end;
  3900.  
  3901. procedure TfrmMain.BackupRestoreRemoveAliasExecute(Sender: TObject);
  3902. begin
  3903.   if (Assigned(FCurrSelServer)) and (FCurrSelTreeNode is TibcBackupAliasNode) then
  3904.   begin
  3905.     if MessageDlg(Format('Are you sure that you want to remove "%s" from the alias list?',
  3906.       [AnsiUppercase(FCurrSelTreeNode.NodeName)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  3907.     begin
  3908.       FRegistry.OpenKey(Format('%s%s\Backup Files',[gRegServersKey,FCurrSelServer.Nodename]),true);
  3909.       FRegistry.DeleteKey(FCurrSelTreeNode.NodeName);
  3910.       FRegistry.CloseKey;
  3911.       DeleteNode(tvMain.Items.GetNode(FCurrSelTreeNode.NodeID),false);
  3912.       tvMainChange(nil,nil);
  3913.     end;
  3914.   end;
  3915. end;
  3916.  
  3917. procedure TfrmMain.BackupRestoreAliasUpdate(Sender: TObject);
  3918. begin
  3919.   if (Assigned(FCurrSelServer)) and (FCurrSelTreeNode is TibcBackupAliasNode) then
  3920.     (Sender as TAction).Enabled := True
  3921.   else
  3922.     (Sender as TAction).Enabled := False;  
  3923. end;
  3924.  
  3925. procedure TfrmMain.DatabasePropertiesUpdate(Sender: TObject);
  3926. begin
  3927.   (Sender as TAction).Enabled := Assigned(FCurrSelDatabase);
  3928. end;
  3929.  
  3930. procedure TfrmMain.DatabaseValidateUpdate(Sender: TObject);
  3931. begin
  3932.   if Assigned (FCurrSelDatabase) and
  3933.      Assigned (FCurrSelDatabase.Database) and
  3934.      not Assigned (FCurrSelDatabase.Database.Handle) then
  3935.     (Sender as TAction).Enabled := not FCurrSeldatabase.Database.connected
  3936.   else
  3937.     (Sender as TAction).Enabled := false;
  3938. end;
  3939.  
  3940. procedure TfrmMain.DisplayWindow(Sender: TObject);
  3941. begin
  3942.   with (Sender as TMenuItem) do
  3943.     ShowWindow (Tag, sW_RESTORE);
  3944. end;
  3945.  
  3946. procedure TfrmMain.ObjectDescriptionExecute(Sender: TObject);
  3947. var
  3948.   lQry: TIBQuery;
  3949.   lTrans: TIBTransaction;
  3950.   dlgDescription: TfrmDescription;
  3951.   table, fld, desc, qry: String;
  3952.   cols, retval: integer;
  3953. begin
  3954.   cols := 999;
  3955.   case FCurrSelTreeNode.NodeType of
  3956.     NODE_DOMAINS:
  3957.     begin
  3958.       table := 'RDB$FIELDS';
  3959.       fld := 'RDB$FIELD_NAME';
  3960.       cols := 2-1;
  3961.     end;
  3962.     NODE_TABLES,
  3963.     NODE_VIEWS:
  3964.     begin
  3965.       table := 'RDB$RELATIONS';
  3966.       fld := 'RDB$RELATION_NAME';
  3967.       cols := 3-1;
  3968.     end;
  3969.     NODE_PROCEDURES:
  3970.     begin
  3971.       table := 'RDB$PROCEDURES';
  3972.       fld := 'RDB$PROCEDURE_NAME';
  3973.       cols := 3-1;
  3974.     end;
  3975.     NODE_FUNCTIONS:
  3976.     begin
  3977.       table := 'RDB$FUNCTIONS';
  3978.       fld := 'RDB$FUNCTION_NAME';
  3979.       cols := 4-1;
  3980.     end;
  3981.     NODE_EXCEPTIONS:
  3982.     begin
  3983.       table := 'RDB$EXCEPTIONS';
  3984.       fld := 'RDB$EXCEPTION_NAME';
  3985.       cols := 3-1;
  3986.     end;
  3987.     NODE_BLOB_FILTERS:
  3988.     begin
  3989.       table := 'RDB$FILTERS';
  3990.       fld := 'RDB$FUNCTION_NAME';
  3991.       cols := 6-1;
  3992.     end;
  3993.   end;
  3994.  
  3995.   dlgDescription := TFrmDescription.Create (self);
  3996.   if lvObjects.Selected.Subitems.Count < cols then
  3997.     dlgDescription.reDescription.Text := ''
  3998.   else
  3999.     dlgDescription.reDescription.Text := lvObjects.Selected.SubItems[cols - 1];
  4000.   retval := dlgDescription.ShowModal;
  4001.   desc := dlgDescription.reDescription.Text;
  4002.   dlgDescription.Free;
  4003.  
  4004.   if retval = mrOK then
  4005.   begin
  4006.     lQry := TIBQuery.Create (self);
  4007.     lTrans := TIBTransaction.Create (self);
  4008.     lTrans.DefaultDatabase := FCurrSelDatabase.Database;
  4009.     with lQry do
  4010.     begin
  4011.       Transaction := lTrans;
  4012.       Database := FcurrSelDatabase.Database;
  4013.       Transaction.StartTransaction;
  4014.       qry := Format('UPDATE %s SET RDB$DESCRIPTION = :description',[table]);
  4015.       qry := Format('%s WHERE %s = ''%s''', [qry, fld, lvObjects.Selected.Caption]);
  4016.       SQL.Add(qry);
  4017.       Params[0].AsString := Desc;
  4018.       ExecSQL;
  4019.       Transaction.Commit;
  4020.       Close;
  4021.       Free;
  4022.     end;
  4023.     lTrans.Free;
  4024.     EventObjectRefresh (FCurrSelDatabase.Database, FCurrSelTreeNode.NodeType);
  4025.   end;
  4026. end;
  4027.  
  4028. procedure TfrmMain.ObjectDescriptionUpdate(Sender: TObject);
  4029. begin
  4030.   if Assigned(FCurrSelTreeNode) then
  4031.     if FCurrSelTreeNode.NodeType in [NODE_ROLES, NODE_GENERATORS] then
  4032.       (Sender as TAction).Enabled := false
  4033.     else
  4034.       (Sender as TAction).Enabled := true
  4035.   else
  4036.     (Sender as TAction).Enabled := false;
  4037. end;
  4038.  
  4039. procedure TfrmMain.ObjectExtractExecute(Sender: TObject);
  4040. var
  4041.   IBExtract: TIBExtract;
  4042.   MetadataScript: TStringList;
  4043.  
  4044. begin
  4045.  
  4046.   if Assigned(lvObjects.Selected) then
  4047.   begin
  4048.     IBExtract := TIBExtract.Create (self);
  4049.     MetadataScript := TStringList.Create;
  4050.     MetadataScript.Text := '';
  4051.     Screen.Cursor := crHourGlass;
  4052.     with IBExtract do
  4053.     begin
  4054.       Database := FCurrSelDatabase.Database;
  4055.       Items := MetadataScript;
  4056.       ObjectName := lvObjects.Selected.Caption;
  4057.       ShowSystem := FViewSystemData;
  4058.       case FCurrSelTreeNode.NodeType of
  4059.         NODE_DOMAINS:
  4060.           ObjectType := eoDomain;
  4061.         NODE_TABLES:
  4062.           ObjectType := eoTable;
  4063.         NODE_VIEWS:
  4064.           ObjectType := eoView;
  4065.         NODE_PROCEDURES:
  4066.           ObjectType := eoProcedure;
  4067.         NODE_FUNCTIONS:
  4068.           ObjectType := eoFunction;
  4069.         NODE_GENERATORS:
  4070.           ObjectType := eoGenerator;
  4071.         NODE_EXCEPTIONS:
  4072.           ObjectType := eoException;
  4073.         NODE_BLOB_FILTERS:
  4074.           ObjectType := eoBLOBFilter;
  4075.         NODE_ROLES:
  4076.           ObjectType := eoRole;
  4077.       end;
  4078.       ExtractObject;
  4079.       Screen.Cursor := crDefault;
  4080.       FCurrSelServer.ShowText(MetadataScript, Format('Metadata for %s',[ObjectName]));
  4081.       Free;
  4082.     end;
  4083.     MetadataScript.Free;
  4084.   end;
  4085. end;
  4086.  
  4087. procedure TfrmMain.ObjectDeleteUpdate(Sender: TObject);
  4088. begin
  4089.   { Do not allow System Metadata to be dropped!}
  4090.   if Assigned(lvObjects.Selected) then
  4091.   begin
  4092.     if Pos('RDB$', lvObjects.Selected.Caption) <> 0 then
  4093.       (Sender as TAction).Enabled := false
  4094.     else
  4095.       (Sender as TAction).Enabled := true;
  4096.   end;
  4097. end;
  4098.  
  4099. procedure TfrmMain.ObjectDeleteExecute(Sender: TObject);
  4100. var
  4101.   lQry: TIBSql;
  4102.   lTrans: TIBTransaction;
  4103.   Qry, Obj: String;
  4104. begin
  4105.  
  4106.   if Assigned (lvObjects.Selected) then
  4107.   begin
  4108.     Qry := 'DROP %s %s';
  4109.     case FCurrSelTreeNode.NodeType of
  4110.       NODE_DOMAINS: Obj := 'DOMAIN';
  4111.       NODE_TABLES: Obj := 'TABLE';
  4112.       NODE_VIEWS: Obj := 'VIEW';
  4113.       NODE_PROCEDURES: Obj := 'PROCEDURE';
  4114.       NODE_FUNCTIONS: Obj := 'EXTERNAL FUNCTION';
  4115.       NODE_EXCEPTIONS: Obj := 'EXCEPTION';
  4116.       NODE_BLOB_FILTERS: Obj := 'FILTER';
  4117.       NODE_ROLES: Obj := 'ROLE';
  4118.       NODE_GENERATORS:
  4119.       begin
  4120.         Qry := 'DELETE FROM RDB$GENERATORS WHERE RDB$GENERATOR_NAME = ''%s''';
  4121.         Obj := 'GENERATOR';
  4122.       end;
  4123.     end;
  4124.  
  4125.     lQry := TIBSql.Create (self);
  4126.     lTrans := TIBTransaction.Create (self);
  4127.  
  4128.     if MessageDlg (Format('Once %s is dropped it can no longer be accessed.'+
  4129.                           #13#10'Do you wish to continue?',[lvObjects.Selected.Caption]),
  4130.                           mtWarning, [mbYes, mbNo], 0) = mrYes then
  4131.     begin
  4132.       try
  4133.         lTrans.DefaultDatabase := FCurrSelDatabase.Database;
  4134.         with lQry do
  4135.         begin
  4136.           Database := FCurrSelDatabase.Database;
  4137.           Transaction := lTrans;
  4138.           Transaction.StartTransaction;
  4139.           if Obj = 'GENERATOR' then
  4140.             Qry := Format(Qry, [lvObjects.Selected.Caption])
  4141.           else
  4142.             Qry := Format(Qry, [Obj, lvObjects.Selected.Caption]);
  4143.           Sql.Add (Qry);
  4144.           Prepare;
  4145.           ExecQuery;
  4146.           Close;
  4147.         end;
  4148.       finally
  4149.         lQry.Free;
  4150.         lTrans.Commit;
  4151.         lTrans.Free;
  4152.         EventObjectRefresh (FCurrSelDatabase.Database, FCurrSelTreeNode.NodeType);
  4153.       end;
  4154.     end;
  4155.   end;
  4156. end;
  4157.  
  4158. procedure TfrmMain.ViewSystemUpdate(Sender: TObject);
  4159. begin
  4160.   (Sender as TAction).Checked := gAppSettings[SYSTEM_DATA].Setting;
  4161. end;
  4162.  
  4163. function TfrmMain.ConnectAsDatabase(Sender: Tobject): boolean;
  4164. begin
  4165.   try
  4166.     result := true;
  4167.     DatabaseConnectAsExecute (Sender);
  4168.     FWisql.Database := FCurrSelDatabase.Database;
  4169.     FWisql.OnCreateObject := EventObjectRefresh;
  4170.     FWisql.OnDropObject := EventObjectRefresh;
  4171.     FWisql.OnDropDatabase := EventDatabaseDrop;
  4172.   except
  4173.     result := false;
  4174.   end;
  4175. end;
  4176.  
  4177. function TfrmMain.CreateDatabase(Sender: TObject): boolean;
  4178. begin
  4179.   try
  4180.     result := true;
  4181.     DatabaseCreateExecute (Sender);
  4182.     if Assigned (FCurrSelDatabase) then
  4183.     begin
  4184.       FWisql.Database := FCurrSelDatabase.Database;
  4185.       FWisql.OnCreateObject := EventObjectRefresh;
  4186.       FWisql.OnDropObject := EventObjectRefresh;
  4187.       FWisql.OnDropDatabase := EventDatabaseDrop;
  4188.     end
  4189.     else
  4190.       result := false;
  4191.   except
  4192.     result := false;
  4193.   end;
  4194. end;
  4195.  
  4196. procedure TfrmMain.ShowWindows;
  4197. var
  4198.   lCnt: integer;
  4199.   dlgWindows: TdlgWindowList;
  4200. begin
  4201.   dlgWindows := TdlgWindowList.Create(self);
  4202.   with dlgWindows do
  4203.   begin
  4204.     for lCnt := 0 to FWindowList.Count - 1 do
  4205.     lbWindows.Items.AddObject(FWindowList.Strings[lCnt],
  4206.       FWindowList.Objects[lCnt]);
  4207.     ShowModal;
  4208.     Free;
  4209.   end;
  4210. end;
  4211.  
  4212. procedure TfrmMain.UpdateWindowList(const Caption: String;
  4213.   const Window: TObject; const Remove: boolean = false);
  4214. var
  4215.   idx: integer;
  4216. begin
  4217.   if Remove then
  4218.   begin
  4219.     idx := FWindowList.IndexOf(Caption);
  4220.     if idx <> -1 then
  4221.       FWindowList.Delete (idx);
  4222.   end
  4223.   else
  4224.     FWindowList.AddObject (Caption, Window);
  4225. end;
  4226.  
  4227. procedure TfrmMain.Window2Click(Sender: TObject);
  4228. begin
  4229.   ShowWindows;
  4230. end;
  4231.  
  4232. procedure TfrmMain.FormShow(Sender: TObject);
  4233. begin
  4234.   UpdateWindowList(Caption, TObject(Self));
  4235. end;
  4236.  
  4237. procedure TfrmMain.lvObjectsContextPopup(Sender: TObject; MousePos: TPoint;
  4238.   var Handled: Boolean);
  4239. begin
  4240.  
  4241.   if not Assigned (lvObjects.Selected) then
  4242.     Handled := true
  4243.   else
  4244.   begin
  4245.     case lvObjects.Tag of
  4246.       ACTIONS:
  4247.         Handled := true;
  4248.       OBJECTS, STATIC:
  4249.         if not Assigned(lvObjects.PopupMenu) then
  4250.           Handled := true;
  4251.       else
  4252.         Handled := true;
  4253.     end;
  4254.   end;
  4255. end;
  4256.  
  4257. procedure TfrmMain.tvMainCollapsing(Sender: TObject; Node: TTreeNode;
  4258.   var AllowCollapse: Boolean);
  4259. begin
  4260.   if Node.GetPrev = nil then
  4261.     AllowCollapse := false;
  4262. end;
  4263.  
  4264. procedure TfrmMain.ServerPropertiesUpdate(Sender: TObject);
  4265. begin
  4266.   if FCurrSelTreeNode.NodeType  = NODE_SERVERS then
  4267.     (Sender as TAction).Enabled := false
  4268.   else
  4269.     (Sender as TAction).Enabled := true;
  4270. end;
  4271.  
  4272. procedure TfrmMain.ServerRemoveCertificateUpdate(Sender: TObject);
  4273. begin
  4274.   if FCurrSelTreeNode.NodeType  = NODE_CERTIFICATES then
  4275.     if Assigned (FCurrSelServer) and (UpperCase(FCurrSelServer.UserName) = 'SYSDBA') then
  4276.     (Sender as TAction).Enabled := Assigned(lvObjects.Selected)
  4277.   else
  4278.       (Sender as TAction).Enabled := false
  4279.   else
  4280.     (Sender as TAction).Enabled := false;
  4281. end;
  4282.  
  4283. procedure TfrmMain.UserDeleteUpdate(Sender: TObject);
  4284. begin
  4285.   if Assigned(lvObjects.Selected) then
  4286.     (Sender as TAction).Enabled := not (lvObjects.Selected.Caption = 'SYSDBA')
  4287.   else
  4288.     (Sender as TAction).Enabled := false;
  4289. end;
  4290.  
  4291. procedure TfrmMain.UserAddExecute(Sender: TObject);
  4292. begin
  4293.   if Assigned(FCurrSelServer) then
  4294.   begin
  4295.     frmuUser.UserInfo(FCurrSelServer,'', true);
  4296.     tvMainChange(nil, nil);    
  4297.   end;
  4298. end;
  4299.  
  4300. procedure TfrmMain.UserModifyExecute(Sender: TObject);
  4301. begin
  4302.   if Assigned(FCurrSelServer) then
  4303.   begin
  4304.     frmuUser.UserInfo(FCurrSelServer,lvObjects.Selected.Caption);
  4305.     tvMainChange(nil, nil);
  4306.   end;
  4307. end;
  4308.  
  4309. procedure TfrmMain.UserModifyUpdate(Sender: TObject);
  4310. begin
  4311.   (Sender as TAction).Enabled := Assigned(lvObjects.Selected);
  4312. end;
  4313.  
  4314. procedure TfrmMain.UserDeleteExecute(Sender: TObject);
  4315. var
  4316.   SecurityService: TIBSecurityService;
  4317. begin
  4318.   if Assigned (lvObjects.Selected) then
  4319.   begin
  4320.     if MessageDlg(Format('Are you sure that you want to delete user: %s?',
  4321.        [lvObjects.Selected.Caption]),mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  4322.     begin
  4323.       try
  4324.         SecurityService := TIBSecurityService.Create(self);
  4325.         with SecurityService do
  4326.         begin
  4327.           Screen.Cursor := crHourGlass;
  4328.           LoginPrompt := false;
  4329.           ServerName := FCurrSelServer.Server.ServerName;
  4330.           Protocol := FCurrSelServer.Server.Protocol;
  4331.           Params.Assign(FCurrSelServer.Server.Params);
  4332.           Attach;
  4333.           UserName := lvObjects.Selected.Caption;
  4334.           DeleteUser;
  4335.           while (IsServiceRunning) do
  4336.             Application.ProcessMessages;
  4337.           Detach;
  4338.           Free;
  4339.         end;
  4340.       except
  4341.         on E: EIBError do
  4342.         begin
  4343.             DisplayMsg(E.IBErrorCode, E.Message);
  4344.           if (E.IBErrorCode = isc_lost_db_connection) or
  4345.              (E.IBErrorCode = isc_unavailable) or
  4346.              (E.IBErrorCode = isc_network_error) then
  4347.             SetErrorState;
  4348.           exit;
  4349.       end;
  4350.     end;
  4351.     end;
  4352.     tvMainChange(nil, nil);
  4353.   end;
  4354. end;
  4355.  
  4356. procedure TfrmMain.ServerUsersExecute(Sender: TObject);
  4357. begin
  4358.   if Assigned(FCurrSelServer) and Assigned(FCurrSelDatabase) then
  4359.     frmuDBConnections.ViewDBConnections (FCurrSelServer, FCurrSelDatabase.Database);
  4360. end;
  4361.  
  4362. procedure TfrmMain.ObjectModifyUpdate(Sender: TObject);
  4363. begin
  4364.   (Sender as TAction).Enabled := (FCurrSelTreeNode.NodeType in [NODE_DOMAINS,
  4365.         NODE_TABLES, NODE_PROCEDURES, NODE_EXCEPTIONS]);
  4366. end;
  4367.  
  4368. procedure TfrmMain.SetErrorState;
  4369. begin
  4370.   FErrorState := true;
  4371.   ServerLogoutExecute(nil);
  4372. end;
  4373.  
  4374. procedure TfrmMain.ServerAddCertificateUpdate(Sender: TObject);
  4375. begin
  4376.   if Assigned(FCurrSelServer) and Assigned (FCurrSelServer.Server) then
  4377.     if UpperCase(FCurrSelServer.UserName) <> 'SYSDBA' then
  4378.       (Sender as TAction).Enabled := false
  4379.     else
  4380.       if FCurrSelTreeNode.NodeType  = NODE_SERVERS then
  4381.         (Sender as TAction).Enabled := false
  4382.       else
  4383.         (Sender as TAction).Enabled := FCurrSelServer.Server.Active
  4384.   else
  4385.     (Sender as TAction).Enabled := false;
  4386. end;
  4387.  
  4388. procedure TfrmMain.DatabaseShutdownUpdate(Sender: TObject);
  4389. begin
  4390.   if Assigned(FCurrSelDatabase) and
  4391.      Assigned (FCurrSelDatabase.Database) and  
  4392.      Assigned (FCurrSelDatabase.Database.Handle) then
  4393.     if UpperCase(FCurrSelServer.UserName) = 'SYSDBA' then
  4394.       (Sender as TAction).Enabled := FCurrSelDatabase.Database.Connected
  4395.     else
  4396.       (Sender as TAction).Enabled := false
  4397.   else
  4398.     (Sender as TAction).Enabled := false;
  4399. end;
  4400.  
  4401. procedure TfrmMain.ObjectRefreshExecute(Sender: TObject);
  4402. begin
  4403.   if Assigned (FCurrSelTreeNode) then
  4404.     FCurrSeltreeNode.ObjectList.Clear;
  4405.   tvMainChange(nil, nil);
  4406. end;
  4407.  
  4408. end.
  4409.