home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuDBStatistics.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  16.1 KB  |  505 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 S t a t i s t i c s
  23. *
  24. ****************************************************************
  25. *  Author: The Client Server Factory Inc.
  26. *  Date:   March 1, 1999
  27. *
  28. *  Description:  This unit provides an interface for selecting
  29. *                options when displaying database statistics
  30. *
  31. *****************************************************************
  32. * Revisions:
  33. *
  34. *****************************************************************}
  35. unit frmuDBStatistics;
  36.  
  37. interface
  38.  
  39. uses
  40.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  41.   StdCtrls, ExtCtrls, ComCtrls, zluibcClasses, IBServices, IB, Grids, frmuDlgClass;
  42.  
  43. type
  44.   TfrmDBStatistics = class(TDialog)
  45.     sgOptions: TStringGrid;
  46.     pnlOptionName: TPanel;
  47.     cbOptions: TComboBox;
  48.     lblOptions: TLabel;
  49.     lblDatabaseName: TLabel;
  50.     bvlLine1: TBevel;
  51.     btnOK: TButton;
  52.     btnCancel: TButton;
  53.     stxDatabaseName: TLabel;
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure btnCancelClick(Sender: TObject);
  56.     procedure btnOKClick(Sender: TObject);
  57.     procedure cbOptionsChange(Sender: TObject);
  58.     procedure cbOptionsDblClick(Sender: TObject);
  59.     procedure cbOptionsExit(Sender: TObject);
  60.     procedure cbOptionsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  61.     procedure sgOptionsDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
  62.     procedure sgOptionsSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
  63.   private
  64.     { Private declarations }
  65.     function VerifyInputData(): boolean;
  66.     procedure WMNCLButtonDown( var Message: TWMNCLBUTTONDOWN ); message WM_NCLBUTTONDOWN ;
  67.   public
  68.     { Public declarations }
  69.   end;
  70.  
  71. function DoDBStatistics(const SourceServerNode: TibcServerNode;
  72.                         const CurrSelDatabase: TibcDatabaseNode): integer;
  73.  
  74. implementation
  75.  
  76. uses
  77.   zluGlobal, zluUtility, zluContextHelp, frmuMessage, fileCtrl, IBErrorCodes,
  78.   frmuMain;
  79.  
  80. {$R *.DFM}
  81.  
  82. const
  83.   OPTION_NAME_COL = 0;
  84.   OPTION_VALUE_COL = 1;
  85.  
  86.   STATISTICS_OPTION_ROW = 0;
  87.  
  88. {****************************************************************
  89. *
  90. *  D o D B S t a t i s t i c s ( )
  91. *
  92. ****************************************************************
  93. *  Author: The Client Server Factory Inc.
  94. *  Date:   March 1, 1999
  95. *
  96. *  Input:  TibcServerNode  - currently selected server
  97. *          TibcDatabseNode - currently selected database (the
  98. *                            database to be validated)
  99. *
  100. *  Return: Integer - indicates success or failure
  101. *
  102. *  Description:
  103. *
  104. *****************************************************************
  105. * Revisions:
  106. *
  107. *****************************************************************}
  108. function DoDBStatistics(const SourceServerNode: TibcServerNode;
  109.   const CurrSelDatabase: TibcDatabaseNode): integer;
  110. var
  111.   frmDBStatistics: TfrmDBStatistics;
  112.   lDBStatisticsData: TStringList;
  113.   lDBStatistics: TIBStatisticalService;
  114.   lDBStatisticsOptions: TStatOptions;
  115.  
  116. begin
  117.   lDBStatisticsData := TStringList.Create();
  118.   lDBStatistics := TIBStatisticalService.Create(Application);
  119.   try
  120.     try
  121.       // assign server details
  122.       lDBStatistics.LoginPrompt := false;
  123.       lDBStatistics.ServerName := SourceServerNode.Server.ServerName;
  124.       lDBStatistics.Protocol := SourceServerNode.Server.Protocol;
  125.       lDBStatistics.Params.Clear;
  126.       lDBStatistics.Params.Assign(SourceServerNode.Server.Params);
  127.       lDBStatistics.Attach();            // try to attach to server
  128.     except                               // if an exception occurs then trap it
  129.       on E:EIBError do                   // and display an error message
  130.       begin
  131.         DisplayMsg(ERR_SERVER_LOGIN, E.Message);
  132.         result := FAILURE;
  133.         if (E.IBErrorCode = isc_lost_db_connection) or
  134.            (E.IBErrorCode = isc_unavailable) or
  135.            (E.IBErrorCode = isc_network_error) then
  136.           frmMain.SetErrorState;
  137.         Exit;
  138.       end;
  139.     end;
  140.  
  141.     // if successfully attached to server
  142.     if lDBStatistics.Active = true then
  143.     begin
  144.       frmDBStatistics := TfrmDBStatistics.Create(Application);
  145.       try
  146.         frmDBStatistics.stxDatabaseName.Caption := MinimizeName (CurrSelDatabase.NodeName,
  147.           frmDBStatistics.stxDatabaseName.Canvas,
  148.           (frmDBStatistics.stxDatabaseName.ClientRect.Left - frmDBStatistics.stxDatabaseName.ClientRect.Right));
  149.  
  150.         frmDBStatistics.stxDatabaseName.Hint := CurrSelDatabase.NodeName;
  151.  
  152.         frmDBStatistics.ShowModal;
  153.  
  154.         if (frmDBStatistics.ModalResult = mrOK) and
  155.            (not frmDBStatistics.GetErrorState) then
  156.         begin
  157.           // repaint screen
  158.           Application.ProcessMessages;
  159.           Screen.Cursor := crHourGlass;
  160.  
  161.           // assign database details
  162.           lDBStatistics.DatabaseName := CurrSelDatabase.Database.DatabaseName;
  163.  
  164.           lDBStatisticsOptions := [];
  165.           // determine which options have been selected
  166.           if frmDBStatistics.sgOptions.Cells[1,STATISTICS_OPTION_ROW] = 'Data Pages' then
  167.             Include(lDBStatisticsOptions, DataPages)
  168.           else if frmDBStatistics.sgOptions.Cells[1,STATISTICS_OPTION_ROW] = 'Database Log' then
  169.             Include(lDBStatisticsOptions, DbLog)
  170.           else if frmDBStatistics.sgOptions.Cells[1,STATISTICS_OPTION_ROW] = 'Header Page' then
  171.             Include(lDBStatisticsOptions, HeaderPages)
  172.           else if frmDBStatistics.sgOptions.Cells[1,STATISTICS_OPTION_ROW] = 'Index Pages' then
  173.             Include(lDBStatisticsOptions, IndexPages)
  174.           else if frmDBStatistics.sgOptions.Cells[1,STATISTICS_OPTION_ROW] = 'System Relations' then
  175.             Include(lDBStatisticsOptions, SystemRelations);
  176.  
  177.           // assign validation options
  178.           lDBStatistics.Options := lDBStatisticsOptions;
  179.  
  180.           // start service
  181.           try
  182.             lDBStatistics.ServiceStart;
  183.             SourceServerNode.OpenTextViewer (lDBStatistics, 'Database Statistics');
  184.             lDBStatistics.Detach;
  185.           except
  186.             on E: EIBError do
  187.             begin
  188.               DisplayMsg(E.IBErrorCode, E.Message);
  189.               if (E.IBErrorCode = isc_lost_db_connection) or
  190.                  (E.IBErrorCode = isc_unavailable) or
  191.                  (E.IBErrorCode = isc_network_error) then
  192.                 frmMain.SetErrorState;
  193.             end;
  194.           end;
  195.         end;
  196.       except
  197.         on E: Exception do
  198.         begin
  199.           DisplayMsg(ERR_SERVER_SERVICE,E.Message + #13#10 + 'Database statistics cannot be displayed.');
  200.           result := FAILURE;
  201.         end;
  202.       end;
  203.       result := SUCCESS;
  204.     end
  205.     else
  206.       result := FAILURE;
  207.   finally
  208.     Screen.Cursor := crDefault;
  209.     if lDBStatistics.Active then
  210.       lDBStatistics.Detach();
  211.     lDBStatisticsData.Free;
  212.     lDBStatistics.Free;
  213.   end;
  214. end;
  215.  
  216. {****************************************************************
  217. *
  218. *  F o r  m C r e a t e
  219. *
  220. ****************************************************************
  221. *  Author: The Client Server Factory Inc.
  222. *  Date:   March 1, 1999
  223. *
  224. *  Input:  TObject - Object that initiated the event
  225. *
  226. *  Return: None
  227. *
  228. *  Description: This procedure is responsible for populating
  229. *               the string grid when the form is created.
  230. *
  231. *****************************************************************
  232. * Revisions:
  233. *
  234. *****************************************************************}
  235.  
  236. procedure TfrmDBStatistics.FormCreate(Sender: TObject);
  237. begin
  238.   inherited;
  239.   sgOptions.DefaultRowHeight := cbOptions.Height;
  240.   cbOptions.Visible := True;
  241.   pnlOptionName.Visible := True;
  242.  
  243.   sgOptions.RowCount := 1;
  244.  
  245.   sgOptions.Cells[OPTION_NAME_COL,STATISTICS_OPTION_ROW] := 'Show data for:';
  246.   sgOptions.Cells[OPTION_VALUE_COL,STATISTICS_OPTION_ROW] := 'All Options';
  247.  
  248.   pnlOptionName.Caption := 'Show data for:';
  249.   cbOptions.Items.Add('All Options');
  250.   cbOptions.Items.Add('Data Pages');
  251.   cbOptions.Items.Add('Database Log');
  252.   cbOptions.Items.Add('Header Page');
  253.   cbOptions.Items.Add('Index Pages');
  254.   cbOptions.Items.Add('System Relations');
  255.   cbOptions.ItemIndex := 0;
  256. end;
  257.  
  258. procedure TfrmDBStatistics.btnCancelClick(Sender: TObject);
  259. begin
  260.   ModalResult := mrCancel;
  261. end;
  262.  
  263. procedure TfrmDBStatistics.btnOKClick(Sender: TObject);
  264. begin
  265.   if VerifyInputData() then
  266.     ModalResult := mrOK;
  267. end;
  268.  
  269. procedure TfrmDBStatistics.cbOptionsChange(Sender: TObject);
  270. begin
  271.   {
  272.   sgOptions.Cells[sgOptions.Col,sgOptions.Row] :=
  273.     cbOptions.Items[cbOptions.ItemIndex];
  274.   cbOptions.Visible := false;
  275.   sgOptions.SetFocus;
  276.   }
  277. end;
  278.  
  279. {****************************************************************
  280. *
  281. *  c b O p t i o n s D b l C l i c k
  282. *
  283. ****************************************************************
  284. *  Author: The Client Server Factory Inc.
  285. *  Date:   March 1, 1999
  286. *
  287. *  Input:  TObject - object that initiated the event
  288. *
  289. *  Return: None
  290. *
  291. *
  292. *  Description: This procedure rotates through a list of values
  293. *               when the option name or value is double-clicked.
  294. *
  295. *****************************************************************
  296. * Revisions:
  297. *
  298. *****************************************************************}
  299.  
  300. procedure TfrmDBStatistics.cbOptionsDblClick(Sender: TObject);
  301. begin
  302.   if (sgOptions.Col = OPTION_VALUE_COL) or (sgOptions.Col = OPTION_NAME_COL) then
  303.   begin
  304.     if cbOptions.ItemIndex = cbOptions.Items.Count - 1 then
  305.       cbOptions.ItemIndex := 0
  306.     else
  307.       cbOptions.ItemIndex := cbOptions.ItemIndex + 1;
  308.  
  309.     if sgOptions.Col = OPTION_VALUE_COL then
  310.       sgOptions.Cells[sgOptions.Col,sgOptions.Row] := cbOptions.Items[cbOptions.ItemIndex];
  311.  
  312.     // cbOptions.Visible := True;
  313.     // sgOptions.SetFocus;
  314.   end;
  315. end;
  316.  
  317. procedure TfrmDBStatistics.cbOptionsExit(Sender: TObject);
  318. var
  319.   lR     : TRect;
  320.   iIndex : Integer;
  321. begin
  322.   iIndex := cbOptions.Items.IndexOf(cbOptions.Text);
  323.  
  324.   if (iIndex = -1) then
  325.   begin
  326.     MessageDlg('Invalid option value', mtError, [mbOK], 0);
  327.  
  328.     cbOptions.ItemIndex := 0;
  329.     // Size and position the combo box to fit the cell
  330.     lR := sgOptions.CellRect(OPTION_VALUE_COL, sgOptions.Row);
  331.     lR.Left := lR.Left + sgOptions.Left;
  332.     lR.Right := lR.Right + sgOptions.Left;
  333.     lR.Top := lR.Top + sgOptions.Top;
  334.     lR.Bottom := lR.Bottom + sgOptions.Top;
  335.     cbOptions.Left := lR.Left + 1;
  336.     cbOptions.Top := lR.Top + 1;
  337.     cbOptions.Width := (lR.Right + 1) - lR.Left;
  338.     cbOptions.Height := (lR.Bottom + 1) - lR.Top;
  339.     cbOptions.Visible := True;
  340.     cbOptions.SetFocus;
  341.   end
  342.   else if (sgOptions.Col <> OPTION_NAME_COL) then
  343.   begin
  344.     sgOptions.Cells[sgOptions.Col,sgOptions.Row] := cbOptions.Items[iIndex];
  345.   end
  346.   else
  347.   begin
  348.     sgOptions.Cells[OPTION_VALUE_COL,sgOptions.Row] := cbOptions.Items[iIndex];
  349.   end;
  350. end;
  351.  
  352. procedure TfrmDBStatistics.cbOptionsKeyDown(Sender: TObject; var Key: Word;
  353.   Shift: TShiftState);
  354. begin
  355.   if (Key = VK_DOWN) then
  356.     cbOptions.DroppedDown := true;
  357. end;
  358.  
  359. {****************************************************************
  360. *
  361. *  s g O p t i o n s D r a w C e l l
  362. *
  363. ****************************************************************
  364. *  Author: The Client Server Factory Inc.
  365. *  Date:   March 1, 1999
  366. *
  367. *  Input:  TObject - Object that initiated the event
  368. *          Integer - currently selected column
  369. *          Integer - currently selected row
  370. *          TRect   - coordinates
  371. *          TGridDrawState - drawing state of grid
  372. *
  373. *  Return: None
  374. *
  375. *  Description: This procedure draws contents to a specified cell in
  376. *               the Option string grid.
  377. *
  378. *****************************************************************
  379. * Revisions:
  380. *
  381. *****************************************************************}
  382.  
  383. procedure TfrmDBStatistics.sgOptionsDrawCell(Sender: TObject; ACol,
  384.   ARow: Integer; Rect: TRect; State: TGridDrawState);
  385. const
  386.   INDENT = 2;
  387. var
  388.   lLeft: integer;
  389.   lText: string;
  390. begin
  391.   with sgOptions.canvas do
  392.   begin
  393.     if (ACol = OPTION_VALUE_COL) then
  394.     begin
  395.       font.color := clBlue;
  396.       if brush.color = clHighlight then
  397.         font.color := clWhite;
  398.       lText := sgOptions.Cells[ACol,ARow];
  399.       lLeft := Rect.Left + INDENT;
  400.       TextRect(Rect, lLeft, Rect.top + INDENT, lText);
  401.     end;
  402.   end;
  403. end;
  404.  
  405. {****************************************************************
  406. *
  407. *  s g O p t i o n s S e l e c t C e l l
  408. *
  409. ****************************************************************
  410. *  Author: The Client Server Factory Inc.
  411. *  Date:   March 1, 1999
  412. *
  413. *  Input:  TObject - Object that initiated the event
  414. *          Integer - currently selected column
  415. *          Integer - currently selected row
  416. *          Boolean - indicates whether call can be selected
  417. *
  418. *  Return: None
  419. *
  420. *  Description: This procedure shows the combo box and populates
  421. *               it when the user selects a row in the value
  422. *               column of the options grid.
  423. *
  424. *****************************************************************
  425. * Revisions:
  426. *
  427. *****************************************************************}
  428.  
  429. procedure TfrmDBStatistics.sgOptionsSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
  430. var
  431.   lR, lName : TRect;
  432. begin
  433.   cbOptions.Items.Clear;
  434.   cbOptions.Items.Add('All Options');
  435.   cbOptions.Items.Add('Data Pages');
  436.   cbOptions.Items.Add('Database Log');
  437.   cbOptions.Items.Add('Header Page');
  438.   cbOptions.Items.Add('Index Pages');
  439.   cbOptions.Items.Add('System Relations');
  440.  
  441.   pnlOptionName.Caption := sgOptions.Cells[OPTION_NAME_COL, ARow];
  442.  
  443.   if ACol = OPTION_NAME_COL then
  444.     cbOptions.ItemIndex := cbOptions.Items.IndexOf(sgOptions.Cells[ACol+1,ARow])
  445.   else if ACol = OPTION_VALUE_COL then
  446.     cbOptions.ItemIndex := cbOptions.Items.IndexOf(sgOptions.Cells[ACol,ARow]);
  447.  
  448.   if ACol = OPTION_NAME_COL then
  449.   begin
  450.     lName := sgOptions.CellRect(ACol, ARow);
  451.     lR := sgOptions.CellRect(ACol + 1, ARow);
  452.   end
  453.   else
  454.   begin
  455.     lName := sgOptions.CellRect(ACol - 1, ARow);
  456.     lR := sgOptions.CellRect(ACol, ARow);
  457.   end;
  458.  
  459.   // lName := sgOptions.CellRect(ACol, ARow);
  460.   lName.Left := lName.Left + sgOptions.Left;
  461.   lName.Right := lName.Right + sgOptions.Left;
  462.   lName.Top := lName.Top + sgOptions.Top;
  463.   lName.Bottom := lName.Bottom + sgOptions.Top;
  464.   pnlOptionName.Left := lName.Left + 1;
  465.   pnlOptionName.Top := lName.Top + 1;
  466.   pnlOptionName.Width := (lName.Right + 1) - lName.Left;
  467.   pnlOptionName.Height := (lName.Bottom + 1) - lName.Top;
  468.   pnlOptionName.Visible := True;
  469.  
  470.   // lR := sgOptions.CellRect(ACol, ARow);
  471.   lR.Left := lR.Left + sgOptions.Left;
  472.   lR.Right := lR.Right + sgOptions.Left;
  473.   lR.Top := lR.Top + sgOptions.Top;
  474.   lR.Bottom := lR.Bottom + sgOptions.Top;
  475.   cbOptions.Left := lR.Left + 1;
  476.   cbOptions.Top := lR.Top + 1;
  477.   cbOptions.Width := (lR.Right + 1) - lR.Left;
  478.   cbOptions.Height := (lR.Bottom + 1) - lR.Top;
  479.   cbOptions.Visible := True;
  480.   cbOptions.SetFocus;
  481. end;
  482.  
  483. function TfrmDBStatistics.VerifyInputData(): boolean;
  484. begin
  485.   result := true;
  486. end;
  487.  
  488. procedure TfrmDBStatistics.WMNCLButtonDown( var Message: TWMNCLButtonDown );
  489. var
  490.   ScreenPt: TPoint;
  491.   ClientPt: TPoint;
  492. begin
  493.   ScreenPt.X := Message.XCursor;
  494.   ScreenPt.Y := Message.YCursor;
  495.   ClientPt := ScreenToClient( ScreenPt );
  496.   if( ClientPt.X > Width-45 )and (ClientPt.X < Width-29) then
  497.    begin
  498.     WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_STATISTICS);
  499.     Message.Result := 0;
  500.   end else
  501.    inherited;
  502. end;
  503.  
  504. end.
  505.