home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuDBConnections.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-24  |  6KB  |  197 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. unit frmuDBConnections;
  21.  
  22. interface
  23.  
  24. uses
  25.   Forms, ExtCtrls, StdCtrls, Classes, Controls, zluibcClasses, ComCtrls,
  26.   IBDatabase, SysUtils, IBDatabaseInfo, Windows, zluContextHelp,
  27.   IBServices, IB, frmuMessage, Messages, frmuDlgClass;
  28.  
  29. type
  30.   TfrmDBConnections = class(TDialog)
  31.     lvConnections: TListView;
  32.     btnOK: TButton;
  33.     function FormHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
  34.     procedure btnOKClick(Sender: TObject);
  35.   private
  36.     { Private declarations }
  37.     procedure WMNCLButtonDown( var Message: TWMNCLBUTTONDOWN ); message WM_NCLBUTTONDOWN ;
  38.   public
  39.     { Public declarations }
  40.   end;
  41.  
  42. function ViewDBConnections(const CurrSelServer: TibcServerNode; const CurrDatabase: TIBDatabase): boolean;
  43.  
  44. implementation
  45.  
  46. uses
  47.   zluGlobal, zluUtility;
  48.  
  49. {$R *.DFM}
  50.  
  51. {****************************************************************
  52. *
  53. *  V i e w D B C o n n e c t i o n s
  54. *
  55. ****************************************************************
  56. *  Author: The Client Server Factory Inc.
  57. *  Date:   April 28, 1999
  58. *
  59. *  Input: TIBDatabase -  Database for which a list of connections
  60. *                        is requested
  61. *
  62. *  Return: FAILURE on database login failure, SUCCESS otherwise
  63. *
  64. *  Description:  Displays the DB Connections form and fills in the
  65. *                list of connected users.
  66. *
  67. *****************************************************************
  68. * Revisions:
  69. *
  70. *****************************************************************}
  71. function ViewDBConnections(const CurrSelServer: TibcServerNode; const CurrDatabase: TIBDatabase): boolean;
  72. var
  73.   frmDBConnections: TfrmDBConnections;
  74.   lIBDBInfo: TIBDatabaseInfo;
  75.   lUserName: TListItem;
  76.   i: integer;
  77.   lDatabase : TIBDatabase;
  78. begin
  79.   lDatabase := nil;
  80.   lIBDBInfo := nil;
  81.   frmDBConnections := nil;
  82.   try
  83.     Screen.Cursor := crHourGlass;
  84.     frmDBConnections := TfrmDBConnections.Create(Application);
  85.     lDatabase := TIBDatabase.Create(Application);
  86.     lIBDBInfo := TIBDatabaseInfo.Create(Application);
  87.     try
  88.       case CurrSelServer.Server.Protocol of
  89.         TCP: lDatabase.DatabaseName := Format('%s:%s',[CurrSelServer.ServerName,CurrDatabase.DatabaseName]);
  90.         NamedPipe: lDatabase.DatabaseName := Format('\\%s\%s',[CurrSelServer.ServerName,CurrDatabase.DatabaseName]);
  91.         SPX: lDatabase.DatabaseName := Format('%s@%s',[CurrSelServer.ServerName,CurrDatabase.DatabaseName]);
  92.         Local:  lDatabase.DatabaseName := CurrDatabase.DatabaseName;
  93.       end;
  94.  
  95.       lDatabase.LoginPrompt := false;
  96.       lDatabase.Params.Clear;
  97.       lDatabase.Params.Add(Format('isc_dpb_user_name=%s',[CurrSelServer.UserName]));
  98.       lDatabase.Params.Add(Format('isc_dpb_password=%s',[CurrSelServer.Password]));
  99.       lDatabase.Connected := true;
  100.       Application.ProcessMessages;
  101.       result := true;
  102.     except
  103.       on E:EIBError do
  104.       begin
  105.         DisplayMsg(ERR_DB_CONNECT,E.Message);
  106.         result := false;
  107.         exit;
  108.       end;
  109.     end;
  110.  
  111.     lIBDBInfo.Database := lDatabase;
  112.  
  113.     for i := 1 to lIBDBInfo.UserNames.Count - 1 do
  114.     begin
  115.       lUserName := frmDBConnections.lvConnections.Items.Add;
  116.       lUserName.Caption := lIBDBInfo.UserNames[i];
  117.     end;
  118.  
  119.     frmDBConnections.ShowModal;
  120.     result := true;
  121.  
  122.   finally
  123.     if lDatabase.Connected then
  124.       lDatabase.Connected := false;
  125.     Application.ProcessMessages;
  126.     lDatabase.Free;
  127.     lIBDBInfo.Free;
  128.     frmDBConnections.Free;
  129.     Screen.Cursor := crDefault;
  130.   end;
  131. end;
  132.  
  133. {****************************************************************
  134. *
  135. *  F o r m H e l p
  136. *
  137. ****************************************************************
  138. *  Author: The Client Server Factory Inc.
  139. *  Date:   April 28, 1999
  140. *
  141. *  Input: ignored
  142. *
  143. *  Return: result of WinHelp call, True if successful
  144. *
  145. *  Description:  Captures the Help event and instead displays
  146. *                a particular topic in a new window.
  147. *
  148. *****************************************************************
  149. * Revisions:
  150. *
  151. *****************************************************************}
  152. function TfrmDBConnections.FormHelp(Command: Word; Data: Integer;
  153.   var CallHelp: Boolean): Boolean;
  154. begin
  155.   CallHelp := False;
  156.   Result := WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_ACTIVITY);
  157. end;
  158.  
  159. {****************************************************************
  160. *
  161. *  b t n O K C l i c k
  162. *
  163. ****************************************************************
  164. *  Author: The Client Server Factory Inc.
  165. *  Date:   April 28, 1999
  166. *
  167. *  Input: ignored
  168. *
  169. *  Description:  Closes the form with a modal result of mrOK.
  170. *
  171. *****************************************************************
  172. * Revisions:
  173. *
  174. *****************************************************************}
  175. procedure TfrmDBConnections.btnOKClick(Sender: TObject);
  176. begin
  177.   ModalResult := mrOK;
  178. end;
  179.  
  180. procedure TfrmDBConnections.WMNCLButtonDown( var Message: TWMNCLButtonDown );
  181. var
  182.   ScreenPt: TPoint;
  183.   ClientPt: TPoint;
  184. begin
  185.   ScreenPt.X := Message.XCursor;
  186.   ScreenPt.Y := Message.YCursor;
  187.   ClientPt := ScreenToClient( ScreenPt );
  188.   if( ClientPt.X > Width-45 )and (ClientPt.X < Width-29) then
  189.    begin
  190.     WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_ACTIVITY);
  191.     Message.Result := 0;
  192.   end else
  193.    inherited;
  194. end;
  195.  
  196. end.
  197.