home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuServerLogin.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-24  |  8KB  |  251 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 S e r v e r L o g i n
  23. *
  24. ****************************************************************
  25. *  Author: The Client Server Factory Inc.
  26. *  Date:   March 1, 1999
  27. *
  28. *  Description:  This unit provides an interface for connecting
  29. *                to a server
  30. *
  31. *****************************************************************
  32. * Revisions:
  33. *
  34. *****************************************************************}
  35.  
  36. unit frmuServerLogin;
  37.  
  38. interface
  39.  
  40. uses
  41.   Windows, SysUtils, Forms, ExtCtrls, StdCtrls, Classes, Controls,
  42.   Messages, zluibcClasses, IB, frmuDlgClass;
  43.  
  44. type
  45.   TfrmServerLogin = class(TDialog)
  46.     lblServerName: TLabel;
  47.     stxServerName: TStaticText;
  48.     lblUsername: TLabel;
  49.     edtUsername: TEdit;
  50.     lblPassword: TLabel;
  51.     edtPassword: TEdit;
  52.     btnLogin: TButton;
  53.     btnCancel: TButton;
  54.     bvlLine1: TBevel;
  55.     function FormHelp(Command: Word; Data: Integer;var CallHelp: Boolean): Boolean;
  56.     procedure FormShow(Sender: TObject);
  57.     procedure btnCancelClick(Sender: TObject);
  58.     procedure btnLoginClick(Sender: TObject);
  59.   private
  60.     { Private declarations }
  61.     function VerifyInputData(): boolean;
  62.     procedure WMNCLButtonDown( var Message: TWMNCLBUTTONDOWN ); message WM_NCLBUTTONDOWN ;
  63.   public
  64.     { Public declarations }
  65.   end;
  66.  
  67. function ServerLogin(var CurrSelServer: TibcServerNode; const SilentLogin: boolean): boolean;
  68.  
  69. implementation
  70.  
  71. uses zluGlobal, frmuMessage, zluContextHelp, iberrorcodes;
  72.  
  73. {$R *.DFM}
  74.  
  75. function TfrmServerLogin.FormHelp(Command: Word; Data: Integer;
  76.   var CallHelp: Boolean): Boolean;
  77. begin
  78.   CallHelp := False;
  79.   Result := WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,SERVER_LOGIN);
  80. end;
  81.  
  82. {****************************************************************
  83. *
  84. *  S e r v e r L o g i n ( )
  85. *
  86. ****************************************************************
  87. *  Author: The Client Server Factory Inc.
  88. *  Date:   March 1, 1999
  89. *
  90. *  Input:  CurrSelServer - The specified server
  91. *          SilentLogin   - Indicates whether or not no perform a
  92. *                          silent login.
  93. *
  94. *  Return: Boolean - Indicates the success/failure of the
  95. *                    operation
  96. *
  97. *  Description:  If SilentLogin is true an attempt is made to
  98. *                connect to the server without promting the user
  99. *                for login information, otherwise the user is
  100. *                prompted for login information.
  101. *
  102. *****************************************************************
  103. * Revisions:
  104. *
  105. *****************************************************************}
  106. function ServerLogin(var CurrSelServer: TibcServerNode; const SilentLogin: boolean): boolean;
  107. var
  108.   frmServerLogin: TfrmServerLogin;
  109. begin
  110.   // check if a silent login was specified
  111.   if not SilentLogin then
  112.   begin
  113.     // if no silent login was specified
  114.     frmServerLogin:= TfrmServerLogin.Create(Application);
  115.     try
  116.       // set server name
  117.       frmServerLogin.stxServerName.Caption := CurrSelServer.NodeName;
  118.       // set username
  119.       frmServerLogin.edtUsername.Text := CurrSelServer.UserName;
  120.       // show form as modal dialog box
  121.       frmServerLogin.ShowModal;
  122.       if frmServerLogin.ModalResult = mrOK then
  123.       begin
  124.         // set server details based on user input
  125.         CurrSelServer.UserName := frmServerLogin.edtUsername.Text;
  126.         CurrSelServer.Password := frmServerLogin.edtPassword.Text;
  127.       end
  128.       else
  129.       begin
  130.         result := false;
  131.         Exit;
  132.       end;
  133.     finally
  134.       // deallocate memory
  135.       frmServerLogin.Free;
  136.     end;
  137.   end;
  138.  
  139.   // if a silent login is specified or the user has successfully entered the
  140.   // proper login details
  141.   try
  142.     Application.ProcessMessages;
  143.  
  144.     Screen.Cursor := crHourGlass;      // change cursor to hourglass
  145.     // submit server login parameters and attach to server
  146.     CurrSelServer.Version := 6;
  147.     CurrSelServer.Server.Params.Add(Format('isc_spb_user_name=%s',[CurrSelServer.UserName]));
  148.     CurrSelServer.Server.Params.Add(Format('isc_spb_password=%s',[CurrSelServer.Password]));
  149.     CurrSelServer.Server.Attach();
  150.     Screen.Cursor := crDefault;        // change cursor to default
  151.     // if the server successfully attached
  152.     if CurrSelServer.Server.Active = true then
  153.       result := true                   // set result to true
  154.     else
  155.       result := false;
  156.   except                               // otherwise set result to false
  157.     on E : EIBError do                 // if an exception occurs then trap it
  158.     begin                              // and show error message
  159.       Screen.Cursor := crDefault;      // change cursor to default
  160.       case E.IBErrorCode of
  161.         isc_svcnotdef:
  162.           raise Exception.Create ('IBConsole can not be used to administer pre-InterBase 6.0 servers');
  163.         else
  164.           DisplayMsg (ERR_SERVER_LOGIN, E.Message);
  165.       end;
  166.       result := false;      
  167.     end;
  168.   end;
  169. end;
  170.  
  171. procedure TfrmServerLogin.btnCancelClick(Sender: TObject);
  172. begin
  173.   ModalResult := mrCancel;
  174. end;
  175.  
  176. procedure TfrmServerLogin.btnLoginClick(Sender: TObject);
  177. begin
  178.   if VerifyInputData() then
  179.     ModalResult := mrOK;
  180. end;
  181.  
  182. {****************************************************************
  183. *
  184. *  V e r i f y I n p u t D a t a ( )
  185. *
  186. ****************************************************************
  187. *  Author: The Client Server Factory Inc.
  188. *  Date:   March 1, 1999
  189. *
  190. *  Input:  None
  191. *
  192. *  Return: Boolean - Indicates the success/failure of the operation
  193. *
  194. *  Description:  Performs some basic validation on data entered by
  195. *                the user
  196. *
  197. *****************************************************************
  198. * Revisions:
  199. *
  200. *****************************************************************}
  201. function TfrmServerLogin.VerifyInputData(): boolean;
  202. begin
  203.   result := true;
  204.  
  205.   // if no username is supplied
  206.   if (edtUsername.Text = '') or (edtUsername.Text = ' ') then
  207.   begin
  208.     DisplayMsg(ERR_USERNAME,'');       // display an error message
  209.     edtUsername.SetFocus;              // give focus to control
  210.     result := false;
  211.     Exit;
  212.   end;
  213.  
  214.   // if no password is supplied
  215.   if (edtPassword.Text = '') or (edtPassword.Text = ' ') then
  216.   begin
  217.     DisplayMsg(ERR_PASSWORD,'');       // display an error message
  218.     edtPassword.SetFocus;              // give focus to control
  219.     result := false;
  220.     Exit;
  221.   end;
  222. end;
  223.  
  224. procedure TfrmServerLogin.FormShow(Sender: TObject);
  225. begin
  226.   if edtUserName.Text = '' then
  227.     edtUserName.SetFocus
  228.   else if edtPassword.Text = '' then
  229.     edtPassword.SetFocus
  230.   else
  231.     btnLogin.SetFocus;
  232. end;
  233.  
  234. procedure TfrmServerLogin.WMNCLButtonDown( var Message: TWMNCLButtonDown );
  235. var
  236.   ScreenPt: TPoint;
  237.   ClientPt: TPoint;
  238. begin
  239.   ScreenPt.X := Message.XCursor;
  240.   ScreenPt.Y := Message.YCursor;
  241.   ClientPt := ScreenToClient( ScreenPt );
  242.   if( ClientPt.X > Width-45 )and (ClientPt.X < Width-29) then
  243.    begin
  244.     WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,SERVER_LOGIN);
  245.     Message.Result := 0;
  246.   end else
  247.    inherited;
  248. end;
  249.  
  250. end.
  251.