home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuDBProperties.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  37.2 KB  |  1,084 lines
  1. {
  2.  * The contents of this file are subject to the InterBase Public License
  3.  * Version 1.0 (the "License"); you may not use this file except in
  4.  * compliance with the License.
  5.  * 
  6.  * You may obtain a copy of the License at http://www.Inprise.com/IPL.html.
  7.  * 
  8.  * Software distributed under the License is distributed on an "AS IS"
  9.  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  10.  * the License for the specific language governing rights and limitations
  11.  * under the License.  The Original Code was created by Inprise
  12.  * Corporation and its predecessors.
  13.  * 
  14.  * Portions created by Inprise Corporation are Copyright (C) Inprise
  15.  * Corporation. All Rights Reserved.
  16.  * 
  17.  * Contributor(s): ______________________________________.
  18. }
  19.  
  20. {****************************************************************
  21. *
  22. *  f r m u D B P r o p e r t i e s
  23. *
  24. ****************************************************************
  25. *  Author: The Client Server Factory Inc.
  26. *  Date:   April 28, 1999
  27. *
  28. *  Description:  This unit provides an interface for viewing
  29. *                and changing database properties
  30. *
  31. *****************************************************************
  32. * Revisions:
  33. *
  34. *****************************************************************}
  35. unit frmuDBProperties;
  36.  
  37. interface
  38.  
  39. uses
  40.   Windows, Forms, ExtCtrls, StdCtrls, Classes, Controls, zluibcClasses, ComCtrls,
  41.   SysUtils, Dialogs, Grids, Graphics, Registry, IBDatabaseInfo, zluContextHelp,
  42.   IBEvents, IBServices, frmuMessage, IB, IBDatabase, Db, IBCustomDataSet,
  43.   IBQuery, Messages, frmuDlgClass;
  44.  
  45. type
  46.   TfrmDBProperties = class(TDialog)
  47.     TabAlias: TTabSheet;
  48.     TabGeneral: TTabSheet;
  49.     cbOptions: TComboBox;
  50.     edtAliasName: TEdit;
  51.     edtFilename: TEdit;
  52.     gbSummaryInfo: TGroupBox;
  53.     lblAliasName: TLabel;
  54.     lblDBOwner: TLabel;
  55.     lblDBPages: TLabel;
  56.     lblFilename: TLabel;
  57.     lblOptions: TLabel;
  58.     lblPageSize: TLabel;
  59.     lvSecondaryFiles: TListView;
  60.     pgcMain: TPageControl;
  61.     sgOptions: TStringGrid;
  62.     stxDBOwner: TStaticText;
  63.     stxDBPages: TStaticText;
  64.     stxPageSize: TStaticText;
  65.     btnSelFilename: TButton;
  66.     pnlOptionName: TPanel;
  67.     lblServerName: TLabel;
  68.     stxServerName: TStaticText;
  69.     btnApply: TButton;
  70.     btnCancel: TButton;
  71.     Button1: TButton;
  72.     function  FormHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
  73.     procedure FormCreate(Sender: TObject);
  74.     procedure FormShow(Sender: TObject);
  75.     procedure btnApplyClick(Sender: TObject);
  76.     procedure btnCancelClick(Sender: TObject);
  77.     procedure cbOptionsChange(Sender: TObject);
  78.     procedure cbOptionsDblClick(Sender: TObject);
  79.     procedure cbOptionsExit(Sender: TObject);
  80.     procedure cbOptionsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  81.     procedure edtAliasNameChange(Sender: TObject);
  82.     procedure sgOptionsDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
  83.     procedure sgOptionsSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
  84.     procedure btnSelFilenameClick(Sender: TObject);
  85.     procedure edtFilenameChange(Sender: TObject);
  86.     procedure SetDefaults (const readOnly, sweep, synch, dialect: String);
  87.     procedure edtFilenameExit(Sender: TObject);
  88.     procedure Button1Click(Sender: TObject);
  89.   private
  90.     FApplyChanges: boolean;
  91.     FOriginalAlias: string;
  92.     FOriginalReadOnly: string;
  93.     FOriginalSweepInterval: string;
  94.     FOriginalSynchMode: string;
  95.     FOriginalSQLDialect: String;
  96.     FAliaschanged: boolean;
  97.     function  VerifyInputData(): boolean;
  98.     procedure WMNCLButtonDown( var Message: TWMNCLBUTTONDOWN ); message WM_NCLBUTTONDOWN ;
  99.   public
  100.     sOriginalForcedWrites: string;
  101.     sOriginalReadOnly: string;
  102.     sOriginalSweepInterval: string;
  103.     sOriginalSQLDialect: string;
  104.     bOriginalConnectStatus: boolean;
  105.     CurrSelDatabase: TibcDatabaseNode;
  106.     CurrSelServer: TibcServerNode;
  107. end;
  108.  
  109. function EditDBProperties(const CurrSelServer: TibcServerNode; var CurrSelDatabase: TibcDatabaseNode): integer;
  110.  
  111. implementation
  112.  
  113. uses
  114.   zluGlobal, zluUtility,frmuMain, IBErrorCodes;
  115.  
  116. {$R *.DFM}
  117.  
  118. const
  119.   OPTION_NAME_COL = 0;
  120.   OPTION_VALUE_COL = 1;
  121.   FORCED_WRITES_ROW = 0;
  122.   SWEEP_INTERVAL_ROW = 1;
  123.   READ_ONLY_ROW = 3;
  124.   SQL_DIALECT_ROW = 2;
  125.   FORCED_WRITES_TRUE = 'Enabled';
  126.   FORCED_WRITES_FALSE = 'Disabled';
  127.   READ_ONLY_TRUE = 'True';
  128.   READ_ONLY_FALSE = 'False';
  129.   SWEEP_INTERVAL_MIN = 0;
  130.   SWEEP_INTERVAL_MAX = 200000;
  131.   SQL_DIALECT1 = '1';
  132.   SQL_DIALECT2 = '2';
  133.   SQL_DIALECT3 = '3';
  134.  
  135. {****************************************************************
  136. *
  137. *  F o r m C r e a t e
  138. *
  139. ****************************************************************
  140. *  Author: The Client Server Factory Inc.
  141. *  Date:   April 28, 1999
  142. *
  143. *  Input: Sender - The object that initiated the event
  144. *
  145. *  Return:
  146. *
  147. *  Description:  This procedure creates an instance of the TfrmDBProperties
  148. *                class and fills in some properties
  149. *
  150. *****************************************************************
  151. * Revisions:
  152. *
  153. *****************************************************************}
  154. procedure TfrmDBProperties.FormCreate(Sender: TObject);
  155. begin
  156.   inherited;
  157.   FApplyChanges := false;
  158.   FAliasChanged := false;
  159.   sgOptions.DefaultRowHeight := cbOptions.Height;
  160.   sgOptions.RowCount := 4;
  161.   sgOptions.Cells[OPTION_NAME_COL,FORCED_WRITES_ROW] := 'Forced Writes';
  162.   sgOptions.Cells[OPTION_NAME_COL,SWEEP_INTERVAL_ROW] := 'Sweep Interval';
  163.   sgOptions.Cells[OPTION_NAME_COL,SQL_DIALECT_ROW] := 'Database Dialect';
  164.   sgOptions.Cells[OPTION_NAME_COL,READ_ONLY_ROW] := 'Read Only';
  165.  
  166.   cbOptions.Visible := True;
  167.   pnlOptionName.Visible := True;
  168.   btnApply.Enabled := false;
  169. end;
  170.  
  171. {****************************************************************
  172. *
  173. *  F o r m H e l p
  174. *
  175. ****************************************************************
  176. *  Author: The Client Server Factory Inc.
  177. *  Date:   April 28, 1999
  178. *
  179. *  Input: ignored
  180. *
  181. *  Return: result of WinHelp call, True if successful
  182. *
  183. *  Description:  Captures the Help event and instead displays
  184. *                a particular topic in a new window.
  185. *
  186. *****************************************************************
  187. * Revisions:
  188. *
  189. *****************************************************************}
  190. function TfrmDBProperties.FormHelp(Command: Word; Data: Integer;
  191.   var CallHelp: Boolean): Boolean;
  192. begin
  193.   CallHelp := False;
  194.   Result := WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_PROPERTIES);
  195. end;
  196.  
  197. {****************************************************************
  198. *
  199. *  F o r m S h o w
  200. *
  201. ****************************************************************
  202. *  Author: The Client Server Factory Inc.
  203. *  Date:   April 28, 1999
  204. *
  205. *  Input: Sender - The object that initiated the event
  206. *
  207. *  Return:
  208. *
  209. *  Description:  Assigns initial values of editable form items
  210. *                for use in determining if changes are made and
  211. *                if the user enters valid combinations of input.
  212. *                Sets up the combobox to prevent blank string grid
  213. *                cells from occurring.
  214. *
  215. *****************************************************************
  216. * Revisions:
  217. *
  218. *****************************************************************}
  219. procedure TfrmDBProperties.FormShow(Sender: TObject);
  220. begin
  221.   FOriginalAlias := edtAliasName.Text;
  222.   pnlOptionName.Caption := 'Forced Writes';
  223.   cbOptions.Style := csDropDown;
  224.   cbOptions.Items.Add(FORCED_WRITES_TRUE);
  225.   cbOptions.Items.Add(FORCED_WRITES_FALSE);
  226.   cbOptions.ItemIndex := cbOptions.Items.IndexOf(FOriginalSynchMode);
  227.   cbOptions.Tag := FORCED_WRITES_ROW;
  228.   btnApply.Enabled := false;
  229.   FAliasChanged := false;
  230. end;
  231.  
  232. {****************************************************************
  233. *
  234. *  b t n A p p l y C l i c k
  235. *
  236. ****************************************************************
  237. *  Author: The Client Server Factory Inc.
  238. *  Date:   April 28, 1999
  239. *
  240. *  Input: Sender - The object that initiated the event
  241. *
  242. *  Return:
  243. *
  244. *  Description:  This procedure verifies user entries and closes the
  245. *                form when the user clicks on the Apply button
  246. *
  247. *****************************************************************
  248. * Revisions:
  249. *
  250. *****************************************************************}
  251. procedure TfrmDBProperties.btnApplyClick(Sender: TObject);
  252. var
  253.   lRegistry: TRegistry;
  254.   i: integer;
  255.   lConfigService: TIBConfigService;
  256.  
  257. begin
  258.   if VerifyInputData() then
  259.   begin
  260.     Screen.Cursor := crHourGlass;
  261.     // save alias and database file information
  262.     lRegistry := TRegistry.Create;
  263.     lConfigService := TIBConfigService.Create(self);
  264.  
  265.     CurrSelDatabase.DatabaseFiles.Clear;
  266.     CurrSelDatabase.DatabaseFiles.Add(edtFilename.Text);
  267.  
  268.     for i := 0 to lvSecondaryFiles.Items.Count-1 do
  269.       CurrSelDatabase.DatabaseFiles.Add(lvSecondaryFiles.Items[i].Caption);
  270.  
  271.     if lRegistry.OpenKey(Format('%s%s\Databases\%s',[gRegServersKey,CurrSelServer.NodeName,CurrSelDatabase.NodeName]),false) then
  272.     begin
  273.       lRegistry.WriteString('DatabaseFiles',CurrSelDatabase.DatabaseFiles.Text);
  274.       lRegistry.CloseKey();
  275.       lRegistry.MoveKey(Format('%s%s\Databases\%s',[gRegServersKey,CurrSelServer.NodeName,CurrSelDatabase.NodeName]),
  276.         Format('%s%s\Databases\%s',[gRegServersKey,CurrSelServer.NodeName, edtAliasName.Text]), true);
  277.     end;
  278.  
  279.     CurrSelDatabase.NodeName := edtAliasName.Text;
  280.     frmMain.RenameTreeNode(CurrSelDatabase, edtAliasName.Text);
  281.  
  282.     // Set properties if general tab was shown
  283.  
  284.     if TabGeneral.TabVisible then
  285.     begin
  286.       try  // try to connect to configuration service
  287.         lConfigService.DatabaseName := CurrSelDatabase.Database.DatabaseName;
  288.         lConfigService.LoginPrompt := false;
  289.         lConfigService.ServerName := CurrSelServer.Servername;
  290.         lConfigService.Protocol := CurrSelServer.Server.Protocol;
  291.         lConfigService.Params.Add(Format('isc_spb_user_name=%s', [CurrSelDatabase.UserName]));
  292.         lConfigService.Params.Add(Format('isc_spb_password=%s', [CurrSelDatabase.Password]));
  293.         lConfigService.Attach();
  294.       except
  295.         on E:EIBError do
  296.         begin
  297.           DisplayMsg(ERR_SERVER_LOGIN, E.Message);
  298.           if (E.IBErrorCode = isc_lost_db_connection) or
  299.              (E.IBErrorCode = isc_unavailable) or
  300.              (E.IBErrorCode = isc_network_error) then
  301.             frmMain.SetErrorState;
  302.           SetErrorState;
  303.           Screen.Cursor := crDefault;
  304.           Exit;
  305.         end;
  306.       end;
  307.  
  308.       if lConfigService.Active then // if attached successfully
  309.       begin
  310.         try
  311.           // Toggle Read-Only first if changing from Read_Only
  312.           if ((sgOptions.Cells[OPTION_VALUE_COL,READ_ONLY_ROW] <> sOriginalReadOnly) and
  313.            (sOriginalReadOnly = READ_ONLY_TRUE))   then
  314.           begin
  315.             CurrSelDatabase.Database.Connected := False;  // need to disconnect from database
  316.             if not lConfigService.Active then
  317.               lConfigService.Attach();
  318.  
  319.             if lConfigService.Active then  // if attached successfully
  320.             begin
  321.               lConfigService.SetReadOnly(False);  // toggle original value
  322.               CurrSelDatabase.Database.Connected := bOriginalConnectStatus;
  323.             end;
  324.           end; // end if read-only changed
  325.  
  326.           // Set sweep interval if changed
  327.           if sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW] <> sOriginalSweepInterval then
  328.           begin
  329.             lConfigService.SetSweepInterval(StrToInt(sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW]));
  330.             while (lConfigService.IsServiceRunning) and (not gApplShutdown) do
  331.               Application.ProcessMessages;
  332.           end;
  333.  
  334.           // Set SQL Dialect if changed
  335.           if sgOptions.Cells[OPTION_VALUE_COL,SQL_DIALECT_ROW] <> sOriginalSQLDialect then
  336.           begin
  337.             try
  338.               lConfigService.SetDBSqlDialect (StrToInt(sgOptions.Cells[OPTION_VALUE_COL,SQL_DIALECT_ROW]));
  339.               while (lConfigService.IsServiceRunning) and (not gApplShutdown) do
  340.                 Application.ProcessMessages;
  341.             except
  342.               on E : EIBError do
  343.               begin
  344.                 DisplayMsg(ERR_SERVICE, E.Message);
  345.                 if (E.IBErrorCode = isc_lost_db_connection) or
  346.                    (E.IBErrorCode = isc_unavailable) or
  347.                    (E.IBErrorCode = isc_network_error) then
  348.                   frmMain.SetErrorState;
  349.                 SetErrorState;
  350.                 Screen.Cursor := crDefault;
  351.                 exit;
  352.               end;
  353.             end;
  354.           end;
  355.  
  356.           // Set forced writes if changed
  357.           if sgOptions.Cells[OPTION_VALUE_COL,FORCED_WRITES_ROW] <> sOriginalForcedWrites then
  358.           begin
  359.             lConfigService.SetAsyncMode(sOriginalForcedWrites = FORCED_WRITES_TRUE);  // toggle original value
  360.             while (lConfigService.IsServiceRunning) and (not gApplShutdown) do
  361.               Application.ProcessMessages;
  362.           end;
  363.  
  364.           // Toggle read only if changed
  365.           if ((sgOptions.Cells[OPTION_VALUE_COL,READ_ONLY_ROW] <> sOriginalReadOnly) and
  366.            (sOriginalReadOnly = READ_ONLY_FALSE)) then
  367.           begin
  368.             CurrSelDatabase.Database.Connected := False;  // need to disconnect from database
  369.             try
  370.               if not lConfigService.Active then
  371.                 lConfigService.Attach();
  372.             except
  373.               on E : EIBError do
  374.               begin
  375.                 DisplayMsg(ERR_SERVER_LOGIN, E.Message);
  376.                 if (E.IBErrorCode = isc_lost_db_connection) or
  377.                    (E.IBErrorCode = isc_unavailable) or
  378.                    (E.IBErrorCode = isc_network_error) then
  379.                 begin
  380.                   frmMain.SetErrorState;
  381.                   SetErrorState;
  382.                 end
  383.                 else
  384.                   CurrSelDatabase.Database.Connected := True;
  385.                 Screen.Cursor := crDefault;
  386.                 Exit;
  387.               end;
  388.             end;
  389.             try
  390.               if lConfigService.Active then               // if attached successfully
  391.               begin
  392.                 lConfigService.SetReadOnly(True);         // toggle original value
  393.                 CurrSelDatabase.Database.Connected := bOriginalConnectStatus;
  394.               end;
  395.             except
  396.               on E : EIBError do
  397.               begin
  398.                 DisplayMsg(ERR_SERVER_LOGIN, E.Message);
  399.                 if (E.IBErrorCode = isc_lost_db_connection) or
  400.                    (E.IBErrorCode = isc_unavailable) or
  401.                    (E.IBErrorCode = isc_network_error) then
  402.                 begin
  403.                   frmMain.SetErrorState;
  404.                   SetErrorState;
  405.                 end
  406.                 else
  407.                   // reconnect to database if an exception occurs
  408.                   CurrSelDatabase.Database.Connected := True;
  409.                 Screen.Cursor := crDefault;
  410.                 Exit;
  411.               end;
  412.             end;
  413.           end; // end if read-only changed
  414.         except
  415.           on E : EIBError do
  416.           begin
  417.             DisplayMsg(ERR_MODIFY_DB_PROPERTIES, E.Message);
  418.             Screen.Cursor := crDefault;
  419.             Exit;
  420.           end;
  421.         end;
  422.  
  423.       end; // end successful service start
  424.       if lConfigService.Active then
  425.         lConfigService.Detach();  // finally detach
  426.       Screen.Cursor := crDefault;
  427.     end;  // end if connected
  428.   end;  // end if VerifyData
  429. end;
  430.  
  431. {****************************************************************
  432. *
  433. *  b t n C a n c e l C l i c k
  434. *
  435. ****************************************************************
  436. *  Author: The Client Server Factory Inc.
  437. *  Date:   April 28, 1999
  438. *
  439. *  Input: Sender - The object that initiated the event
  440. *
  441. *  Return:
  442. *
  443. *  Description:  This procedure returns a ModalResult of mrCancel
  444. *                whent the user presses the Cancel button, btnCancel
  445. *
  446. *****************************************************************
  447. * Revisions:
  448. *
  449. *****************************************************************}
  450. procedure TfrmDBProperties.btnCancelClick(Sender: TObject);
  451. begin
  452.   Cursor := crHourGlass;
  453.   btnApply.Click;
  454.   Cursor := crHourGlass;
  455.   ModalResult := mrOK;
  456. end;
  457.  
  458. {****************************************************************
  459. *
  460. *  c b O p t i o n s C h a n g e
  461. *
  462. ****************************************************************
  463. *  Author: The Client Server Factory Inc.
  464. *  Date:   April 28, 1999
  465. *
  466. *  Input: Sender - The object that initiated the event
  467. *
  468. *  Return:
  469. *
  470. *  Description:  This procedure handles changes to the text of the
  471. *                options combo box.  It calls the function NoteChanges
  472. *                to look for and prepare the form to accept changes
  473. *
  474. *****************************************************************
  475. * Revisions:
  476. *
  477. *****************************************************************}
  478. procedure TfrmDBProperties.cbOptionsChange(Sender: TObject);
  479. begin
  480.   FApplyChanges := True;
  481.   btnApply.Enabled := True;
  482. end;
  483.  
  484. {****************************************************************
  485. *
  486. *  c b O p t i o n s D b l C l i c k
  487. *
  488. ****************************************************************
  489. *  Author: The Client Server Factory Inc.
  490. *  Date:   April 28, 1999
  491. *
  492. *  Input: Sender - The object that initiated the event
  493. *
  494. *  Return:
  495. *
  496. *  Description:  Flips through the items in the combo box,
  497. *                assigning the next value or the first one when the
  498. *                last item is reached.  Notifies the form that changes
  499. *                may have been made via NoteChanges.
  500. *
  501. *****************************************************************
  502. * Revisions:
  503. *
  504. *****************************************************************}
  505. procedure TfrmDBProperties.cbOptionsDblClick(Sender: TObject);
  506. begin
  507.   if (sgOptions.Col = OPTION_VALUE_COL) or (sgOptions.Col = OPTION_NAME_COL) then
  508.   begin
  509.     if cbOptions.ItemIndex = cbOptions.Items.Count - 1 then
  510.       cbOptions.ItemIndex := 0
  511.     else
  512.       cbOptions.ItemIndex := cbOptions.ItemIndex + 1;
  513.  
  514.     if sgOptions.Col = OPTION_VALUE_COL then
  515.       sgOptions.Cells[sgOptions.Col,sgOptions.Row] := cbOptions.Items[cbOptions.ItemIndex];
  516.   end;
  517.   FApplyChanges := True;
  518.   btnApply.Enabled := True;
  519. end;
  520.  
  521. {****************************************************************
  522. *
  523. *  c b O p t i o n s E x i t
  524. *
  525. ****************************************************************
  526. *  Author: The Client Server Factory Inc.
  527. *  Date:   April 28, 1999
  528. *
  529. *  Input: Sender - The object that initiated the event
  530. *
  531. *  Return:
  532. *
  533. *  Description:  This procedure adjusts the appearance of the form
  534. *                when the user selects another object on the form
  535. *                while cbOptions has focus.
  536. *
  537. *****************************************************************
  538. * Revisions:
  539. *
  540. *****************************************************************}
  541. procedure TfrmDBProperties.cbOptionsExit(Sender: TObject);
  542. var
  543.   lR     : Trect;
  544.   iIndex : Integer;
  545. begin
  546.   iIndex := cbOptions.Items.IndexOf(cbOptions.Text);
  547.  
  548.   if (iIndex = -1) and (sgOptions.Row <> SWEEP_INTERVAL_ROW) then
  549.   begin
  550.     MessageDlg('Invalid option value', mtError, [mbOK], 0);
  551.  
  552.     cbOptions.ItemIndex := 0;
  553.     //Size and position the combo box to fit the cell
  554.     lR := sgOptions.CellRect(OPTION_VALUE_COL, sgOptions.Row);
  555.     lR.Left := lR.Left + sgOptions.Left;
  556.     lR.Right := lR.Right + sgOptions.Left;
  557.     lR.Top := lR.Top + sgOptions.Top;
  558.     lR.Bottom := lR.Bottom + sgOptions.Top;
  559.     cbOptions.Left := lR.Left + 1;
  560.     cbOptions.Top := lR.Top + 1;
  561.     cbOptions.Width := (lR.Right + 1) - lR.Left;
  562.     cbOptions.Height := (lR.Bottom + 1) - lR.Top;
  563.     cbOptions.Visible := True;
  564.     cbOptions.SetFocus;
  565.   end
  566.   else if (sgOptions.Row = SWEEP_INTERVAL_ROW) then
  567.   begin
  568.     sgOptions.Cells[OPTION_VALUE_COL,sgOptions.Row] := cbOptions.Text;
  569.   end
  570.   else if (sgOptions.Col <> OPTION_NAME_COL) then
  571.   begin
  572.     sgOptions.Cells[sgOptions.Col,sgOptions.Row] := cbOptions.Items[iIndex];
  573.   end
  574.   else
  575.   begin
  576.     sgOptions.Cells[OPTION_VALUE_COL,sgOptions.Row] := cbOptions.Items[iIndex];
  577.   end;
  578. end;
  579.  
  580. {****************************************************************
  581. *
  582. *  c b O p t i o n s K e y D o w n
  583. *
  584. ****************************************************************
  585. *  Author: The Client Server Factory Inc.
  586. *  Date:   April 28, 1999
  587. *
  588. *  Input: Sender - The object that initiated the event
  589. *
  590. *  Return:
  591. *
  592. *  Description: Enables the user to use the keyboard to select
  593. *               items from the combo box.
  594. *
  595. *****************************************************************
  596. * Revisions:
  597. *
  598. *****************************************************************}
  599. procedure TfrmDBProperties.cbOptionsKeyDown(Sender: TObject; var Key: Word;
  600.   Shift: TShiftState);
  601. begin
  602.   if (Key = VK_DOWN) then
  603.     cbOptions.DroppedDown := true;
  604. end;
  605.  
  606. {****************************************************************
  607. *
  608. *  e d t A l i a s N a m e C h a n g e
  609. *
  610. ****************************************************************
  611. *  Author: The Client Server Factory Inc.
  612. *  Date:   April 28, 1999
  613. *
  614. *  Input: Sender - The object that initiated the event
  615. *
  616. *  Return:
  617. *
  618. *  Description:  Notifies the form that changes may have been made.
  619. *
  620. *****************************************************************
  621. * Revisions:
  622. *
  623. *****************************************************************}
  624. procedure TfrmDBProperties.edtAliasNameChange(Sender: TObject);
  625. begin
  626.   FAliasChanged := true;
  627.   FApplyChanges := True;
  628.   btnApply.Enabled := True;
  629.   edtAliasName.Hint := edtAliasName.Text;
  630. end;
  631.  
  632. {****************************************************************
  633. *
  634. *  s g O p t i o n s D r a w C e l l
  635. *
  636. ****************************************************************
  637. *  Author: The Client Server Factory Inc.
  638. *  Date:   April 28, 1999
  639. *
  640. *  Input: Sender - The object that initiated the event
  641. *
  642. *  Return:
  643. *
  644. *  Description:
  645. *
  646. *****************************************************************
  647. * Revisions:
  648. *
  649. *****************************************************************}
  650. procedure TfrmDBProperties.sgOptionsDrawCell(Sender: TObject; ACol,
  651.   ARow: Integer; Rect: TRect; State: TGridDrawState);
  652. const
  653.   INDENT = 2;
  654. var
  655.   lLeft: integer;
  656.   lText: string;
  657. begin
  658.   with sgOptions.canvas do
  659.   begin
  660.     if ACol = OPTION_VALUE_COL then
  661.     begin
  662.       font.color := clBlue;
  663.       if brush.color = clHighlight then
  664.         font.color := clWhite;
  665.       lText := sgOptions.Cells[ACol,ARow];
  666.       lLeft := Rect.Left + INDENT;
  667.       TextRect(Rect, lLeft, Rect.top + INDENT, lText);
  668.     end;
  669.   end;
  670. end;
  671.  
  672. {****************************************************************
  673. *
  674. *  s g O p t i o n s S e l e c t C e l l
  675. *
  676. ****************************************************************
  677. *  Author: The Client Server Factory Inc.
  678. *  Date:   April 28, 1999
  679. *
  680. *  Input: Sender - The object that initiated the event
  681. *
  682. *  Return:
  683. *
  684. *  Description:  This procedure prepares the combobox cbOptions
  685. *                and inserts it into the selected cell.
  686. *
  687. *****************************************************************
  688. * Revisions:
  689. *
  690. *****************************************************************}
  691. procedure TfrmDBProperties.sgOptionsSelectCell(Sender: TObject; ACol,
  692.   ARow: Integer; var CanSelect: Boolean);
  693. var
  694.   lR, lName : TRect;
  695. begin
  696.   cbOptionsExit(Sender);
  697.   cbOptions.Items.Clear;
  698.  
  699.   case ARow of
  700.     FORCED_WRITES_ROW:
  701.     begin
  702.       cbOptions.Style := csDropDown;
  703.       cbOptions.Items.Add(FORCED_WRITES_TRUE);
  704.       cbOptions.Items.Add(FORCED_WRITES_FALSE);
  705.       cbOptions.Tag := FORCED_WRITES_ROW;
  706.     end;
  707.     SWEEP_INTERVAL_ROW:
  708.     begin
  709.       cbOptions.Style := csSimple;
  710.       cbOptions.Text := sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW];
  711.       cbOptions.Tag := SWEEP_INTERVAL_ROW;
  712.     end;
  713.     READ_ONLY_ROW:
  714.     begin
  715.       cbOptions.Style := csDropDown;
  716.       cbOptions.Items.Add(READ_ONLY_TRUE);
  717.       cbOptions.Items.Add(READ_ONLY_FALSE);
  718.       cbOptions.Tag := READ_ONLY_ROW;
  719.     end;
  720.     SQL_DIALECT_ROW:
  721.     begin
  722.       cbOptions.Style := csDropDown;
  723.       cbOptions.Items.Add(SQL_DIALECT1);
  724.       cbOptions.Items.Add(SQL_DIALECT2);
  725.       cbOptions.Items.Add(SQL_DIALECT3);
  726.       cbOptions.ItemIndex := StrToInt(FOriginalSQLDialect)-1;
  727.       cbOptions.Tag := SQL_DIALECT_ROW;
  728.     end;
  729.   end;
  730.  
  731.   pnlOptionName.Caption := sgOptions.Cells[OPTION_NAME_COL, ARow];
  732.  
  733.   if ACol = OPTION_NAME_COL then
  734.     cbOptions.ItemIndex := cbOptions.Items.IndexOf(sgOptions.Cells[ACOL+1,ARow])
  735.   else if ACol = OPTION_VALUE_COL then
  736.   begin
  737.     cbOptions.ItemIndex := cbOptions.Items.IndexOf(sgOptions.Cells[ACol,ARow]);
  738.     if (cbOptions.ItemIndex = -1) or (ARow = SWEEP_INTERVAL_ROW) then
  739.       cbOptions.Text := sgOptions.Cells[ACol,ARow];
  740.   end;
  741.  
  742.   if ACol = OPTION_NAME_COL then
  743.   begin
  744.     lName := sgOptions.CellRect(ACol, ARow);
  745.     lR := sgOptions.CellRect(ACol + 1, ARow);
  746.   end
  747.   else
  748.   begin
  749.     lName := sgOptions.CellRect(ACol - 1, ARow);
  750.     lR := sgOptions.CellRect(ACol, ARow);
  751.   end;
  752.  
  753.   // lName := sgOptions.CellRect(ACol, ARow);
  754.   lName.Left := lName.Left + sgOptions.Left;
  755.   lName.Right := lName.Right + sgOptions.Left;
  756.   lName.Top := lName.Top + sgOptions.Top;
  757.   lName.Bottom := lName.Bottom + sgOptions.Top;
  758.   pnlOptionName.Left := lName.Left + 1;
  759.   pnlOptionName.Top := lName.Top + 1;
  760.   pnlOptionName.Width := (lName.Right + 1) - lName.Left;
  761.   pnlOptionName.Height := (lName.Bottom + 1) - lName.Top;
  762.   pnlOptionName.Visible := True;
  763.  
  764.   // lR := sgOptions.CellRect(ACol, ARow);
  765.   lR.Left := lR.Left + sgOptions.Left;
  766.   lR.Right := lR.Right + sgOptions.Left;
  767.   lR.Top := lR.Top + sgOptions.Top;
  768.   lR.Bottom := lR.Bottom + sgOptions.Top;
  769.   cbOptions.Left := lR.Left + 1;
  770.   cbOptions.Top := lR.Top + 1;
  771.   cbOptions.Width := (lR.Right + 1) - lR.Left;
  772.   cbOptions.Height := (lR.Bottom + 1) - lR.Top;
  773.   cbOptions.Visible := True;
  774.   cbOptions.SetFocus;
  775. end;
  776.  
  777. {****************************************************************
  778. *
  779. *  V e r i f y I n p u t D a t a
  780. *
  781. ****************************************************************
  782. *  Author: The Client Server Factory Inc.
  783. *  Date:   April 28, 1999
  784. *
  785. *  Input: none
  786. *
  787. *  Return:  Returns TRUE if all data is valid.  Returns FALSE if
  788. *           any data (Sweep Interval particularly) is invalid,
  789. *           or if an invalid combination of values has been provided.
  790. *
  791. *  Description:  This function verifies that valid values have been
  792. *                provided by the user.
  793. *
  794. *****************************************************************
  795. * Revisions:
  796. *
  797. *****************************************************************}
  798.  
  799. function TfrmDBProperties.VerifyInputData(): boolean;
  800. begin
  801.   result := true;  // only if no exceptions raised
  802.  
  803.   if FAliasChanged and frmMain.AliasExists (edtAliasName.Text) then
  804.   begin
  805.     DisplayMsg(ERR_ALIAS_EXISTS, '');
  806.     edtAliasName.text := FOriginalAlias;
  807.     result := false;
  808.     FAliasChanged := false;
  809.   end;
  810.   
  811.   if TabGeneral.Visible then
  812.   try
  813.     if (StrToInt(sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW]) < SWEEP_INTERVAL_MIN) or
  814.        (StrToInt(sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW]) > SWEEP_INTERVAL_MAX) then
  815.       raise ERangeError.Create('The Sweep Interval must be a value from ' + IntToStr(SWEEP_INTERVAL_MIN) +
  816.                  ' to ' + IntToStr(SWEEP_INTERVAL_MAX) + '.  Please enter a valid sweep interval value.');
  817.     if ((FOriginalReadOnly = READ_ONLY_TRUE) and
  818.        (sgOptions.Cells[OPTION_VALUE_COL,READ_ONLY_ROW] = READ_ONLY_TRUE) and
  819.        ((sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW] <> FOriginalSweepInterval) or
  820.        (sgOptions.Cells[OPTION_VALUE_COL,READ_ONLY_ROW] = FOriginalReadOnly))) then
  821.       raise EPropReadOnly.Create('Database Properties cannot be changed while the database is read-only.');
  822.     Exit;
  823.   except
  824.     on E:EConvertError do
  825.     begin
  826.       DisplayMsg(ERR_INVALID_PROPERTY_VALUE, 'Sweep Interval: ' + E.Message );
  827.       result := false;
  828.     end;
  829.     on E:ERangeError do
  830.     begin
  831.       DisplayMsg(ERR_NUMERIC_VALUE, E.Message );
  832.       result := false;
  833.     end;
  834.     on E:EPropReadOnly do
  835.     begin
  836.       DisplayMsg(ERR_INVALID_PROPERTY_VALUE,E.Message);
  837.       result := false;
  838.     end;
  839.   end;
  840. end;
  841.  
  842. {*******************************************************************
  843. *
  844. * E d i t D B P r o p e r t i e s ( )
  845. *
  846. ********************************************************************
  847. *  Author: The Client Server Factory Inc.
  848. *  Date:   April 28, 1999
  849. *
  850. *  Input:  CurrSelServer : TibcServerNode, the current server node
  851.            CurrSelDatabase : TibcDatabaseNode, the current database
  852. *
  853. *  Return: integer - a status code indicating the success/failure
  854. *                    of the operation.
  855. *
  856. *  Description: This procedure creates and displays the database
  857. *               properties form.  The user can then view and make
  858. *               changes to the properties.  When the user closes
  859. *               the form, the function then tests for any changes and
  860. *               applies them to the database.  Finally, the
  861. *               form and all supporting IB objects are destroyed.
  862. *
  863. ********************************************************************
  864. * Revisions:
  865. *
  866. ********************************************************************}
  867. function EditDBProperties(const CurrSelServer: TibcServerNode; var CurrSelDatabase: TibcDatabaseNode): integer;
  868. var
  869.   frmDBProperties: TfrmDBProperties;
  870.   lRegistry: TRegistry;
  871.   lSubKeys: TStringList;
  872.   lIBDBInfo: TIBDatabaseInfo;
  873.   lConfigService: TIBConfigService;
  874.   lListItem: TListItem;
  875.   qryDBProperties: TIBQuery;
  876.   sOriginalForcedWrites: string;
  877.   sOriginalReadOnly: string;
  878.   sOriginalSweepInterval: string;
  879.   sOriginalSQLDialect: string;
  880.   bOriginalConnectStatus: boolean;
  881. begin
  882.   frmDBProperties := TfrmDBProperties.Create(Application);
  883.   lRegistry := TRegistry.Create();
  884.   lSubKeys := TStringList.Create();
  885.   lIBDBInfo := TIBDatabaseInfo.Create(frmDBProperties);
  886.   lConfigService := TIBConfigService.Create(frmDBProperties);
  887.   qryDBProperties := TIBQuery.Create(frmDBProperties);
  888.   try
  889.     frmDBProperties.edtAliasName.Text := CurrSelDatabase.NodeName;
  890.     frmDBProperties.edtFilename.Text := CurrSelDatabase.DatabaseFiles.Strings[0];
  891.     frmDBProperties.stxServerName.Caption := CurrSelServer.NodeName;
  892.  
  893.     if CurrSelServer.Server.Protocol <> Local then
  894.       frmDBProperties.btnSelFilename.Enabled := false;
  895.  
  896.     bOriginalConnectStatus := CurrSelDatabase.Database.Connected;
  897.     if not CurrSelDatabase.Database.Connected then
  898.       frmDBProperties.TabGeneral.TabVisible := false
  899.     else
  900.     begin  // retrieve database properties
  901.       frmDBProperties.edtFileName.Enabled := false;
  902.       frmDBProperties.btnSelFilename.Enabled := false;
  903.       lIBDBInfo.Database := CurrSelDatabase.Database;                       // assign selected database to db info object
  904.       frmDBProperties.stxPageSize.Caption := IntToStr(lIBDBInfo.PageSize);  // get page size from ib info object
  905.       frmDBProperties.stxDBPages.Caption := IntToStr(lIBDBInfo.Allocation); // get number of pages allocated
  906.       sOriginalSweepInterval := IntToStr(lIBDBInfo.SweepInterval);
  907.       frmDBProperties.sgOptions.Cells[OPTION_VALUE_COL,SWEEP_INTERVAL_ROW] := sOriginalSweepInterval;
  908.  
  909.       if lIBDBInfo.ForcedWrites <> 0 then    // True
  910.         sOriginalForcedWrites := FORCED_WRITES_TRUE
  911.       else                                   // False
  912.         sOriginalForcedWrites := FORCED_WRITES_FALSE;
  913.  
  914.       frmDBProperties.sgOptions.Cells[OPTION_VALUE_COL,FORCED_WRITES_ROW] := sOriginalForcedWrites;
  915.  
  916.       if lIBDBInfo.ReadOnly <> 0 then        // True
  917.         sOriginalReadOnly := READ_ONLY_TRUE
  918.       else                                   // False
  919.         sOriginalReadOnly := READ_ONLY_FALSE;
  920.  
  921.       frmDBProperties.sgOptions.Cells[OPTION_VALUE_COL,READ_ONLY_ROW] := sOriginalReadOnly;
  922.  
  923.       sOriginalSQLDialect := IntToStr(lIBDBInfo.DBSQLDialect);
  924.       frmDBProperties.sgOptions.Cells[OPTION_VALUE_COL,SQL_DIALECT_ROW] := sOriginalSQLDialect;
  925.  
  926.       if not CurrSelDatabase.Database.DefaultTransaction.InTransaction then
  927.         CurrSelDatabase.Database.DefaultTransaction.StartTransaction;
  928.  
  929.       // Set the defaults for the database properties
  930.       frmDBProperties.SetDefaults (sOriginalReadOnly, sOriginalSweepInterval, sOriginalForcedWrites, sOriginalSQLDialect);
  931.       with qryDBProperties do
  932.       begin
  933.         Close;
  934.         Database := CurrSelDatabase.Database;
  935.         Transaction := CurrSelDatabase.Database.DefaultTransaction;
  936.         SQL.Clear;
  937.         SQL.Add('SELECT RDB$FILE_NAME, RDB$FILE_START FROM RDB$FILES ' +
  938.                 'WHERE RDB$SHADOW_NUMBER IS NULL OR RDB$SHADOW_NUMBER < 1 ' +
  939.                 'ORDER BY RDB$FILE_SEQUENCE ASC');
  940.         try
  941.           Open;
  942.           First;
  943.           while not eof do
  944.           begin
  945.             lListItem := frmDBProperties.lvSecondaryFiles.Items.Add;
  946.             lListItem.Caption := qryDBProperties.Fields[0].AsString;
  947.             lListItem.SubItems.Add(qryDBProperties.Fields[1].AsString);
  948.             Next;
  949.           end;
  950.         except
  951.           on e:EIBError do
  952.           begin
  953.             lListItem := frmDBProperties.lvSecondaryFiles.Items.Add;
  954.             lListItem.Caption := 'Not Available';
  955.             lListItem.SubItems.Add('Not Available');
  956.             DisplayMsg(ERR_GET_TABLE_DATA,E.Message + ' Secondary files unavailable.');
  957.           end;
  958.         end;
  959.         Close;
  960.         if not CurrSelDatabase.Database.DefaultTransaction.InTransaction then
  961.           CurrSelDatabase.Database.DefaultTransaction.StartTransaction;
  962.         Transaction := CurrSelDatabase.Database.DefaultTransaction;
  963.         SQL.Clear;
  964.         SQL.Add('SELECT RDB$OWNER_NAME FROM RDB$RELATIONS ' +
  965.                 'WHERE RDB$RELATION_NAME = ''RDB$DATABASE'' ');
  966.         try
  967.           Open;
  968.           First;
  969.           frmDBProperties.stxDBOwner.Caption := Fields[0].AsString;
  970.         except
  971.           on E:EIBError do
  972.           begin
  973.             frmDBProperties.stxDBOwner.Caption := 'Not Available';
  974.             DisplayMsg(ERR_GET_TABLE_DATA,E.Message + ' Database owner unavailable.');
  975.           end;
  976.         end;
  977.         Close;
  978.       end; // with qryDBProperties
  979.     end; // retrieve database properties
  980.     frmDBProperties.CurrSelDatabase := CurrSelDatabase;
  981.     frmDBProperties.CurrSelServer := CurrSelServer;
  982.     frmDBProperties.sOriginalForcedWrites := sOriginalForcedWrites;
  983.     frmDBProperties.sOriginalReadOnly := sOriginalReadOnly;
  984.     frmDBProperties.sOriginalSweepInterval := sOriginalSweepInterval;
  985.     frmDBProperties.sOriginalSQLDialect := sOriginalSQLDialect;
  986.     frmDBProperties.bOriginalConnectStatus := bOriginalConnectStatus;
  987.  
  988.     frmDBProperties.ShowModal;
  989.     Application.ProcessMessages;
  990.     result := SUCCESS;
  991.     
  992.   finally
  993.     Screen.Cursor := crDefault;
  994.     qryDBProperties.Free;
  995.     lConfigService.Free;
  996.     lIBDBInfo.Free;
  997.     frmDBProperties.Free;
  998.     lSubKeys.Free;
  999.     lRegistry.Free;
  1000.   end;
  1001. end;
  1002.  
  1003. procedure TfrmDBProperties.btnSelFilenameClick(Sender: TObject);
  1004. var
  1005.   lOpenDialog: TOpenDialog;
  1006. begin
  1007.   lOpenDialog := nil;
  1008.   try
  1009.   begin
  1010.     lOpenDialog := TOpenDialog.Create(self);
  1011.     // setup Open Dialog title, extension, filters and options
  1012.     lOpenDialog.Title := 'Select Database';
  1013.     lOpenDialog.DefaultExt := 'gdb';
  1014.     lOpenDialog.Filter := 'Database File (*.gdb)|*.GDB|All files (*.*)|*.*';
  1015.     lOpenDialog.Options := [ofHideReadOnly,ofNoNetworkButton, ofEnableSizing];
  1016.     if lOpenDialog.Execute then
  1017.     begin
  1018.       // get filename
  1019.       edtFilename.Text := lOpenDialog.FileName;
  1020.       // if no dbalias is specified then make it the name of the file
  1021.       if (edtAliasName.Text = '') or (edtAliasName.Text = ' ') then
  1022.       begin
  1023.         edtAliasName.Text := ExtractFileName(edtFilename.Text);
  1024.         if (edtAliasName.Text = '') or (edtAliasName.Text = ' ') then
  1025.         begin
  1026.           edtAliasName.Text := ExtractFileName(edtFilename.Text);
  1027.         end;
  1028.       end;
  1029.     end;
  1030.   end
  1031.   finally
  1032.     lOpenDialog.free;
  1033.   end;
  1034. end;
  1035.  
  1036. procedure TfrmDBProperties.edtFilenameChange(Sender: TObject);
  1037. begin
  1038.   FApplyChanges := True;
  1039.   btnApply.Enabled := True;
  1040.   edtFilename.Hint := edtFilename.Text;
  1041. end;
  1042.  
  1043. procedure TfrmDBProperties.WMNCLButtonDown( var Message: TWMNCLButtonDown );
  1044. var
  1045.   ScreenPt: TPoint;
  1046.   ClientPt: TPoint;
  1047. begin
  1048.   ScreenPt.X := Message.XCursor;
  1049.   ScreenPt.Y := Message.YCursor;
  1050.   ClientPt := ScreenToClient( ScreenPt );
  1051.   if( ClientPt.X > Width-45 )and (ClientPt.X < Width-29) then
  1052.    begin
  1053.     WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_PROPERTIES);
  1054.     Message.Result := 0;
  1055.   end else
  1056.    inherited;
  1057. end;
  1058.  
  1059. procedure TfrmDBProperties.SetDefaults(const readOnly, sweep, synch,
  1060.   dialect: String);
  1061. begin
  1062.  
  1063.   FOriginalReadOnly := readOnly;
  1064.   FOriginalSweepInterval := Sweep;
  1065.   FOriginalSynchMode := synch;
  1066.   FOriginalSQLDialect := dialect;
  1067.  
  1068. end;
  1069.  
  1070. procedure TfrmDBProperties.edtFilenameExit(Sender: TObject);
  1071. begin
  1072.   inherited;
  1073.   if not (IsValidDBName(edtFilename.text)) then
  1074.      DisplayMsg(WAR_REMOTE_FILENAME, Format('File: %s', [edtFileName.text]));
  1075. end;
  1076.  
  1077. procedure TfrmDBProperties.Button1Click(Sender: TObject);
  1078. begin
  1079.   inherited;
  1080.   ModalResult := mrCancel;
  1081. end;
  1082.  
  1083. end.
  1084.