home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuDBRegister.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-24  |  11KB  |  350 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 R e g i s t e r
  23. *
  24. ****************************************************************
  25. *  Author: The Client Server Factory Inc.
  26. *  Date:   March 1, 1999
  27. *
  28. *  Description:  This unit provides an interface for registering
  29. *                a database
  30. *
  31. *****************************************************************
  32. * Revisions:
  33. *
  34. *****************************************************************}
  35.  
  36. unit frmuDBRegister;
  37.  
  38. interface
  39.  
  40. uses
  41.   SysUtils, Forms, ExtCtrls, StdCtrls, Classes, Controls, Dialogs,
  42.   Windows, zluibcClasses, Messages, Registry, frmuDlgClass;
  43.  
  44. type
  45.   TfrmDBRegister = class(TDialog)
  46.     lblServerName: TLabel;
  47.     stxServerName: TStaticText;
  48.     bvlLine1: TBevel;
  49.     gbDatabase: TGroupBox;
  50.     lblDBAlias: TLabel;
  51.     lblDBFile: TLabel;
  52.     btnSelDBFile: TButton;
  53.     edtDBFile: TEdit;
  54.     edtDBAlias: TEdit;
  55.     chkSaveAlias: TCheckBox;
  56.     gbLoginInfo: TGroupBox;
  57.     lblUsername: TLabel;
  58.     lblPassword: TLabel;
  59.     lblRole: TLabel;
  60.     edtUsername: TEdit;
  61.     edtPassword: TEdit;
  62.     edtRole: TEdit;
  63.     btnOK: TButton;
  64.     btnCancel: TButton;
  65.     cbCaseSensitive: TCheckBox;
  66.     function FormHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
  67.     procedure btnCancelClick(Sender: TObject);
  68.     procedure btnOKClick(Sender: TObject);
  69.     procedure btnSelDBFileClick(Sender: TObject);
  70.     procedure edtDBFileChange(Sender: TObject);
  71.     procedure edtDBFileExit(Sender: TObject);
  72.     procedure edtRoleChange(Sender: TObject);
  73.   private
  74.     { Private declarations }
  75.     FCurrSelServer : TibcServerNode;
  76.     function VerifyInputData(): boolean;
  77.     procedure WMNCLButtonDown( var Message: TWMNCLBUTTONDOWN ); message WM_NCLBUTTONDOWN ;
  78.   public
  79.     { Public declarations }
  80.   end;
  81.  
  82. function RegisterDB(var DBAlias,Username,Password,Role: string;
  83.                         DatabaseFiles: TStringList;
  84.                         const SelServer: TibcServerNode;
  85.                         var SaveAlias, CaseSensitive: boolean): boolean;
  86.  
  87. implementation
  88.  
  89. uses
  90.    IBServices, frmuMessage, zluGlobal, zluContextHelp, zluUtility;
  91.  
  92. {$R *.DFM}
  93.  
  94. {****************************************************************
  95. *
  96. *  R e g i s t e r D B ( )
  97. *
  98. ****************************************************************
  99. *  Author: The Client Server Factory Inc.
  100. *  Date:   March 1, 1999
  101. *
  102. *  Input:  DBAlias   - The database alias
  103. *          DBFile    - The database file, including path
  104. *          Username  - The username to use when connecting to
  105. *                      the database
  106. *          Password  - The password to use when connecting to
  107. *                      the database
  108. *          Role      - The role to use when connecting to the
  109. *                      database
  110. *          SelServer - The specified server
  111. *          SaveAlias - Indicates whether or not to save the alias
  112. *                      information to the registry
  113. *
  114. *  Return: boolean - Indicates the success/failure of the operation
  115. *
  116. *  Description:  Captures the information required in order to
  117. *                register the specified database.  The actual
  118. *                registration of the database is performed by
  119. *                the main form.
  120. *
  121. *****************************************************************
  122. * Revisions:
  123. *
  124. *****************************************************************}
  125. function RegisterDB(var DBAlias, Username, Password, Role: string;
  126.   DatabaseFiles: TStringList; const SelServer: TibcServerNode; var SaveAlias, CaseSensitive: boolean): boolean;
  127. var
  128.   frmDBRegister: TfrmDBRegister;
  129. begin
  130.   frmDBRegister := TfrmDBRegister.Create(Application);
  131.   try
  132.     // show servername
  133.     frmDBRegister.stxServerName.Caption := SelServer.NodeName;
  134.     frmDBRegister.FCurrSelServer := SelServer;
  135.     // disable browse button if remote server
  136.     if SelServer.Server.Protocol <> Local then
  137.       frmDBRegister.btnSelDBFile.Enabled := false;
  138.     frmDBRegister.ShowModal;
  139.     if frmDBRegister.ModalResult = mrOK then
  140.     begin
  141.       // set database information
  142.       DBAlias := frmDBRegister.edtDBAlias.Text;
  143.  
  144.       { Force a path for all databases if the current protocol is local }
  145.       if SelServer.Server.Protocol = Local then
  146.       begin
  147.         if ExtractFilePath(frmDBRegister.edtDBFile.Text) = '' then
  148.           frmDBRegister.edtDBFile.Text := ExtractFilePath(Application.ExeName)+
  149.            frmDBRegister.edtDBFile.Text;
  150.       end;
  151.       DatabaseFiles.Add(frmDBRegister.edtDBFile.Text);
  152.       Username := frmDBRegister.edtUsername.Text;
  153.       Password := frmDBRegister.edtPassword.Text;
  154.       Role := frmDBRegister.edtRole.Text;
  155.       SaveAlias := frmDBRegister.chkSaveAlias.Checked;
  156.       CaseSensitive := frmDBRegister.cbCaseSensitive.Checked;
  157.       result := true;
  158.     end
  159.     else
  160.       result := false;
  161.   finally
  162.     // deallocate memory
  163.     frmDBRegister.Free;
  164.   end;
  165. end;
  166.  
  167. function TfrmDBRegister.FormHelp(Command: Word; Data: Integer;
  168.   var CallHelp: Boolean): Boolean;
  169. begin
  170.   CallHelp := False;
  171.   // call WinHelp and show Register Database topic
  172.   Result := WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_REGISTER);
  173. end;
  174.  
  175. procedure TfrmDBRegister.btnCancelClick(Sender: TObject);
  176. begin
  177.   ModalResult := mrCancel;
  178. end;
  179.  
  180. procedure TfrmDBRegister.btnOKClick(Sender: TObject);
  181. begin
  182.   if VerifyInputData() then
  183.     ModalResult := mrOK;
  184. end;
  185.  
  186. {****************************************************************
  187. *
  188. *  b t n S e l D B F i l e C l i c k ( )
  189. *
  190. ****************************************************************
  191. *  Author: The Client Server Factory Inc.
  192. *  Date:   March 1, 1999
  193. *
  194. *  Input:  Sender - The object that initiated the event
  195. *
  196. *  Return: None
  197. *
  198. *  Description:  Displays a default windows file open dialog for capturing filenames
  199. *
  200. *
  201. *****************************************************************
  202. * Revisions:
  203. *
  204. *****************************************************************}
  205. procedure TfrmDBRegister.btnSelDBFileClick(Sender: TObject);
  206. var
  207.   lOpenDialog: TOpenDialog;
  208. begin
  209.   lOpenDialog := nil;
  210.   try
  211.   begin
  212.     lOpenDialog := TOpenDialog.Create(self);
  213.     // setup Open Dialog title, extension, filters and options
  214.     lOpenDialog.Title := 'Select Database';
  215.     lOpenDialog.DefaultExt := 'gdb';
  216.     lOpenDialog.Filter := 'Database File (*.gdb)|*.GDB|All files (*.*)|*.*';
  217.     lOpenDialog.Options := [ofHideReadOnly,ofNoNetworkButton, ofEnableSizing];
  218.     if lOpenDialog.Execute then
  219.     begin
  220.       // get filename
  221.       edtDBFile.Text := lOpenDialog.FileName;
  222.       // if no dbalias is specified then make it the name of the file
  223.       if (edtDBAlias.Text = '') or (edtDBAlias.Text = ' ') then
  224.       begin
  225.         edtDBAlias.Text := ExtractFileName(edtDbFile.Text);
  226.         if (edtDBAlias.Text = '') or (edtDBAlias.Text = ' ') then
  227.         begin
  228.           edtDBAlias.Text := ExtractFileName(edtDbFile.Text);
  229.         end;
  230.       end;
  231.     end;
  232.   end
  233.   finally
  234.     // deallocate memory
  235.     lOpenDialog.free;
  236.   end;
  237. end;
  238.  
  239. procedure TfrmDBRegister.edtDBFileChange(Sender: TObject);
  240. begin
  241.   edtDBFile.hint := edtDBFile.text;
  242. end;
  243.  
  244. procedure TfrmDBRegister.edtDBFileExit(Sender: TObject);
  245. begin
  246.   // if no dbalias is specified then make filename the dbalias
  247.   if (edtDBAlias.Text = '') or (edtDBAlias.Text = ' ') then
  248.   begin
  249.     edtDBAlias.Text := ExtractFileName(edtDbFile.Text);
  250.   end;
  251.   if not (IsValidDBName(edtDBFile.Text)) then
  252.      DisplayMsg(WAR_REMOTE_FILENAME, Format('File: %s', [edtDBFile.Text]));
  253. end;
  254.  
  255. {****************************************************************
  256. *
  257. *  V e r i f y I n p u t D a t a ( )
  258. *
  259. ****************************************************************
  260. *  Author: The Client Server Factory Inc.
  261. *  Date:   March 1, 1999
  262. *
  263. *  Input:  None
  264. *
  265. *  Return: Boolean - Indicates the success/failure of the operation
  266. *
  267. *  Description:  Performs some basic validation on data entered by
  268. *                the user
  269. *
  270. *****************************************************************
  271. * Revisions:
  272. *
  273. *****************************************************************}
  274. function TfrmDBRegister.VerifyInputData(): boolean;
  275. var
  276.   lRegistry : TRegistry;
  277. begin
  278.   lRegistry := Nil;
  279.   result := true;
  280.  
  281.   try
  282.     lRegistry := TRegistry.Create;
  283.  
  284.     // if no dbalias is specified
  285.     if (edtDBAlias.Text = '') or (edtDBAlias.Text = ' ') then
  286.     begin
  287.       DisplayMsg(ERR_DB_ALIAS,'');       // show error message
  288.       edtDBAlias.SetFocus;               // give focus to control
  289.       result := false;
  290.       Exit;
  291.     end;
  292.  
  293.     // check for backslash in dbalias
  294.     // If backslashes are used (i.e. for a path), then the registry
  295.     // key will not be created properly
  296.     if Pos('\',edtDBAlias.Text) <> 0 then
  297.     begin
  298.       DisplayMsg(ERR_DB_ALIAS,'');       // show error message
  299.       edtDBAlias.SetFocus;               // give focus to control
  300.       result := false;
  301.       Exit;
  302.     end;
  303.  
  304.     // if no dbfile is specified
  305.     if (edtDBFile.GetTextLen = 0) then
  306.     begin
  307.       DisplayMsg(ERR_DB_FILE,edtDBFile.Text);        // show error message
  308.       edtDBFile.SetFocus;                            // give focus to control
  309.       result := false;
  310.       Exit;
  311.     end;
  312.  
  313.     if lRegistry.KeyExists(Format('%s%s\Databases\%s',[gRegServersKey,FCurrSelServer.Nodename,edtDBAlias.Text])) then
  314.     begin                                // show error message
  315.       DisplayMsg(ERR_DB_ALIAS,'This database alias already exists.');
  316.       edtDBAlias.SetFocus;               // give focus to control
  317.       result := false;
  318.       Exit;
  319.     end;
  320.  
  321.  
  322.   finally
  323.     lRegistry.Free;
  324.   end;
  325. end;
  326.  
  327. procedure TfrmDBRegister.WMNCLButtonDown( var Message: TWMNCLButtonDown );
  328. var
  329.   ScreenPt: TPoint;
  330.   ClientPt: TPoint;
  331. begin
  332.   ScreenPt.X := Message.XCursor;
  333.   ScreenPt.Y := Message.YCursor;
  334.   ClientPt := ScreenToClient( ScreenPt );
  335.   if( ClientPt.X > Width-45 )and (ClientPt.X < Width-29) then
  336.    begin
  337.     WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,DATABASE_REGISTER);
  338.     Message.Result := 0;
  339.   end else
  340.    inherited;
  341. end;
  342.  
  343. procedure TfrmDBRegister.edtRoleChange(Sender: TObject);
  344. begin
  345.   inherited;
  346.   cbCaseSensitive.Enabled := (edtRole.GetTextLen > 0);
  347. end;
  348.  
  349. end.
  350.