home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuServerProperties.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-24  |  25KB  |  801 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 frmuServerProperties;
  21.  
  22. interface
  23.  
  24. uses
  25.   Forms, ExtCtrls, StdCtrls, Classes, Controls, SysUtils, zluibcClasses,
  26.   ComCtrls, Graphics, Registry, IBServices, frmuMessage, IB, Windows,
  27.   Messages, zluContextHelp, frmuDlgClass;
  28.  
  29. type
  30.   TfrmServerProperties = class(TDialog)
  31.     TabAlias: TTabSheet;
  32.     TabGeneral: TTabSheet;
  33.     bvlLine1: TBevel;
  34.     cboProtocol: TComboBox;
  35.     edtAliasName: TEdit;
  36.     edtHostName: TEdit;
  37.     lblAliasName: TLabel;
  38.     lblAttachmentNo: TLabel;
  39.     lblCapabilities: TLabel;
  40.     lblDatabaseNo: TLabel;
  41.     lblHostName: TLabel;
  42.     lblProtocol: TLabel;
  43.     lblVersion: TLabel;
  44.     lvDatabases: TListView;
  45.     memCapabilities: TMemo;
  46.     pgcMain: TPageControl;
  47.     stxAttachmentNo: TStaticText;
  48.     stxDatabaseNo: TStaticText;
  49.     stxVersion: TStaticText;
  50.     btnApply: TButton;
  51.     btnCancel: TButton;
  52.     btnRefresh: TButton;
  53.     Button1: TButton;
  54.     Label1: TLabel;
  55.     edtDescription: TEdit;
  56.     function FormHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;
  57.     procedure FormCreate(Sender: TObject);
  58.     procedure FormDestroy(Sender: TObject);
  59.     procedure btnApplyClick(Sender: TObject);
  60.     procedure btnCancelClick(Sender: TObject);
  61.     procedure btnRefreshClick(Sender: TObject);
  62.     procedure cboProtocolChange(Sender: TObject);
  63.     procedure cboProtocolDblClick(Sender: TObject);
  64.     procedure edtAliasNameChange(Sender: TObject);
  65.     procedure lvDatabasesDblClick(Sender: TObject);
  66.     procedure pgcMainChange(Sender: TObject);
  67.     procedure FormShow(Sender: TObject);
  68.     procedure Button1Click(Sender: TObject);
  69.   private
  70.     { Private declarations }
  71.     FAssignedServer : TibcServerNode;
  72.     FLicenseDesc: TStringList;
  73.     procedure NoteChanges();
  74.     procedure Refresh();
  75.     procedure ShowActivity();
  76.     procedure WMNCLButtonDown( var Message: TWMNCLBUTTONDOWN ); message WM_NCLBUTTONDOWN ;
  77.   public
  78.     { Public declarations }
  79.     procedure AssignServerNode(const ServerNode: TibcServerNode);
  80.     function GetNewSettings: TibcServerNode;
  81.     procedure DecodeMask(AssignedServer: TibcServerNode);
  82.   end;
  83.  
  84.   ENameError = class(Exception);
  85.  
  86. function EditServerProperties(const CurrSelServer: TibcServerNode): integer;
  87.  
  88. implementation
  89.  
  90. uses
  91.   zluGlobal, frmuMain, IBDatabase, frmuDBConnections, IBHeader, IBErrorCodes;
  92.  
  93. {$R *.DFM}
  94.  
  95. const
  96.   LIC_A_BIT=0;
  97.   LIC_B_BIT=3;
  98.   LIC_C_BIT=16;
  99.   LIC_D_BIT=1;
  100.   LIC_E_BIT=4;
  101.   LIC_F_BIT=5;
  102.   LIC_I_BIT=8;
  103.   LIC_L_BIT=11;
  104.   LIC_P_BIT=15;
  105.   LIC_Q_BIT=2;
  106.   LIC_R_BIT=17;
  107.   LIC_S_BIT=18;
  108.   LIC_W_BIT=22;
  109.   LIC_2_BIT=27;
  110.   LIC_3_BIT=28;
  111.  
  112.   LIC_A_TEXT = 'Ada language preprocessing is supported';
  113.   LIC_B_TEXT = 'Basic language preprocessing is supported';
  114.   LIC_C_TEXT = 'C language preprocessing is supported';
  115.   LIC_D_TEXT = 'Server can modify the metadata of databases';
  116.   LIC_E_TEXT = 'Server can access tables which are external to a database';
  117.   LIC_F_TEXT = 'Fortran language preprocessing is supported';
  118.   LIC_I_TEXT = 'Server can access tables which are internal to a database';
  119.   LIC_L_TEXT = 'All language preprocessing is supported except C++ and Ada';
  120.   LIC_P_TEXT = 'Pascal language preprocessing is supported';
  121.   LIC_Q_TEXT = 'Client can use query tools';
  122.   LIC_R_TEXT = 'Client can access remote servers';
  123.   LIC_S_TEXT = 'Server can process requests from remote clients';
  124.   LIC_W_TEXT = 'Server is not limited  as to the number of users it can process';
  125.   LIC_2_TEXT = 'COBOL language preprocessing is supported';
  126.   LIC_3_TEXT = 'C++ language preprocessing is supported';
  127.  
  128. {****************************************************************
  129. *
  130. *  F o r m H e l p
  131. *
  132. ****************************************************************
  133. *  Author: The Client Server Factory Inc.
  134. *  Date:   April 28, 1999
  135. *
  136. *  Input: ignored
  137. *
  138. *  Return: result of WinHelp call, True if successful
  139. *
  140. *  Description:  Captures the Help event and instead displays
  141. *                a particular topic in a new window.
  142. *
  143. *****************************************************************
  144. * Revisions:
  145. *
  146. *****************************************************************}
  147. function TfrmServerProperties.FormHelp(Command: Word; Data: Integer;
  148.   var CallHelp: Boolean): Boolean;
  149. begin
  150.   CallHelp := False;
  151.   Result := WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,SERVER_PROPERTIES);
  152. end;
  153.  
  154. {****************************************************************
  155. *
  156. *  b t n A p p l y C l i c k
  157. *
  158. ****************************************************************
  159. *  Author: The Client Server Factory Inc.
  160. *  Date:   April 28, 1999
  161. *
  162. *  Input: ignored
  163. *
  164. *  Description: Sets the modal result of the form to mrOK
  165. *               if all user entered values are valid.
  166. *
  167. *****************************************************************
  168. * Revisions:
  169. *
  170. *****************************************************************}
  171. procedure TfrmServerProperties.btnApplyClick(Sender: TObject);
  172. var
  173.   lRegistry : TRegistry;
  174.   ServerActive: boolean;
  175. begin
  176.   lRegistry := TRegistry.Create;
  177.   try
  178.     // save alias and database file information
  179.     Screen.Cursor := crHourGlass;
  180.     ServerActive := FAssignedServer.Server.Active;
  181.     if FAssignedServer.Server.Active then
  182.       FAssignedServer.Server.Active := false;
  183.     if lRegistry.OpenKey(Format('%s%s',[gRegServersKey,FAssignedServer.NodeName]),false) then
  184.     begin
  185.       case cboProtocol.ItemIndex of
  186.         0:
  187.         begin
  188.           FAssignedServer.Server.Protocol := TCP;
  189.           lRegistry.WriteInteger('Protocol',0);
  190.         end;
  191.         1:
  192.         begin
  193.           FAssignedServer.Server.Protocol := NamedPipe;
  194.           lRegistry.WriteInteger('Protocol',1);
  195.         end;
  196.         2:
  197.         begin
  198.           FAssignedServer.Server.Protocol := SPX;
  199.           lRegistry.WriteInteger('Protocol',2);
  200.         end;
  201.       end;
  202.       FAssignedServer.ServerName := edtHostName.Text;
  203.       FAssignedServer.Server.ServerName := edtHostName.Text;
  204.       lRegistry.WriteString('ServerName', edtHostName.Text);
  205.       FAssignedServer.Description := edtDescription.Text;
  206.       lRegistry.WriteString('Description', edtDescription.Text);
  207.       lRegistry.CloseKey();
  208.       lRegistry.MoveKey(Format('%s%s',[gRegServersKey,FAssignedServer.NodeName]),
  209.         Format('%s%s',[gRegServersKey,edtAliasName.Text]), true);
  210.       FAssignedServer.NodeName := edtAliasName.Text;
  211.  
  212.       if ServerActive then
  213.         FAssignedServer.Server.Active := true;
  214.     end;
  215.   finally
  216.     lRegistry.Free;
  217.     Screen.Cursor := crDefault;
  218.   end;
  219. end;
  220.  
  221. {****************************************************************
  222. *
  223. *  b t n C a n c e l C l i c k
  224. *
  225. ****************************************************************
  226. *  Author: The Client Server Factory Inc.
  227. *  Date:   April 28, 1999
  228. *
  229. *  Input: ignored
  230. *
  231. *  Description: Sets the modal result of the form to mrCancel.
  232. *
  233. *****************************************************************
  234. * Revisions:
  235. *
  236. *****************************************************************}
  237. procedure TfrmServerProperties.btnCancelClick(Sender: TObject);
  238. begin
  239.   btnApply.Click;
  240.   ModalResult := mrOK;
  241. end;
  242.  
  243. {****************************************************************
  244. *
  245. *  b t n R e f r e s h C l i c k
  246. *
  247. ****************************************************************
  248. *  Author: The Client Server Factory Inc.
  249. *  Date:   April 28, 1999
  250. *
  251. *  Input: ignored
  252. *
  253. *  Description: Retrieves server properties and displays them on
  254. *               the form.
  255. *
  256. *****************************************************************
  257. * Revisions:
  258. *
  259. *****************************************************************}
  260. procedure TfrmServerProperties.btnRefreshClick(Sender: TObject);
  261. begin
  262.   Refresh();
  263. end;
  264.  
  265. {****************************************************************
  266. *
  267. *  c b o P r o t o c o l C h a n g e
  268. *
  269. ****************************************************************
  270. *  Author: The Client Server Factory Inc.
  271. *  Date:   April 28, 1999
  272. *
  273. *  Input: ignored
  274. *
  275. *  Description: Prepares the form when changes are made.
  276. *
  277. *****************************************************************
  278. * Revisions:
  279. *
  280. *****************************************************************}
  281. procedure TfrmServerProperties.cboProtocolChange(Sender: TObject);
  282. begin
  283.   NoteChanges;
  284. end;
  285.  
  286. {****************************************************************
  287. *
  288. *  c b o P r o t o c o l D b l C l i c k
  289. *
  290. ****************************************************************
  291. *  Author: The Client Server Factory Inc.
  292. *  Date:   April 28, 1999
  293. *
  294. *  Input: ignored
  295. *
  296. *  Description: When the user doucle clicks the comco box,
  297. *               the next protocol in the combo box is selected and
  298. *               the form is prepared after the change.  Selects the
  299. *               first protocol when the end of the list is reached.
  300. *
  301. *****************************************************************
  302. * Revisions:
  303. *
  304. *****************************************************************}
  305. procedure TfrmServerProperties.cboProtocolDblClick(Sender: TObject);
  306. begin
  307.   if not cboProtocol.DroppedDown then
  308.   begin
  309.     if cboProtocol.ItemIndex = cboProtocol.Items.Count - 1 then
  310.       cboProtocol.ItemIndex := 0
  311.     else
  312.       cboProtocol.ItemIndex := cboProtocol.ItemIndex + 1;
  313.   end;
  314.   NoteChanges;
  315. end;
  316.  
  317. {****************************************************************
  318. *
  319. *  e d t A l i a s N a m e C h a n g e
  320. *
  321. ****************************************************************
  322. *  Author: The Client Server Factory Inc.
  323. *  Date:   April 28, 1999
  324. *
  325. *  Input: ignored
  326. *
  327. *  Description: Prepares the form when changes are made.
  328. *
  329. *****************************************************************
  330. * Revisions:
  331. *
  332. *****************************************************************}
  333. procedure TfrmServerProperties.edtAliasNameChange(Sender: TObject);
  334. begin
  335.   NoteChanges;
  336. end;
  337.  
  338. {****************************************************************
  339. *
  340. *  l v D a t a b a s e s D b l C l i c k
  341. *
  342. ****************************************************************
  343. *  Author: The Client Server Factory Inc.
  344. *  Date:   April 28, 1999
  345. *
  346. *  Input: ignored
  347. *
  348. *  Description: Displays additional information when the user double clicks
  349. *               an item in the list view.
  350. *
  351. *****************************************************************
  352. * Revisions:
  353. *
  354. *****************************************************************}
  355. procedure TfrmServerProperties.lvDatabasesDblClick(Sender: TObject);
  356. var
  357.   sCurrSelDB:string;
  358.   i:integer;
  359. begin
  360.   sCurrSelDB := '';
  361.  
  362.   if lvDatabases.Selected <> nil then
  363.   begin
  364.     sCurrSelDB := lvDatabases.Selected.Caption;  // get selected item
  365.     if sCurrSelDB <> '' then             // if there was a selected item before
  366.     begin
  367.       i := lvDatabases.Items.Count;      // get number of databases in list
  368.       while i > 0 do                     // loop to see if it is still attached
  369.       begin
  370.         dec(i);                          // start at end of list
  371.         if lvDatabases.Items.Item[i].Caption = sCurrSelDB then  // if found/attached
  372.         begin
  373.           lvDatabases.Items.Item[i].Selected := true;
  374.           ShowActivity;                  // show users
  375.           i := - 1;                      // lower value of i to indicate success
  376.         end;
  377.       end;  // end loop through attached databases
  378.  
  379.       if i = 0 then  // no items or original item not found
  380.         DisplayMsg(ERR_GET_USERS,'All users have disconnected from database ' +
  381.           sCurrSelDB + '.  It is no longer attached to the server.');
  382.  
  383.     end;  // end if double clicked on item
  384.     Refresh();                           // refresh unselects item
  385.   end;
  386. end;
  387.  
  388. {****************************************************************
  389. *
  390. *  p g c M a i n C h a n g e
  391. *
  392. ****************************************************************
  393. *  Author: The Client Server Factory Inc.
  394. *  Date:   April 28, 1999
  395. *
  396. *  Input: ignored
  397. *
  398. *  Description: Prepares the form when the user switches between
  399. *               tabbed pages.
  400. *
  401. *****************************************************************
  402. * Revisions:
  403. *
  404. *****************************************************************}
  405. procedure TfrmServerProperties.pgcMainChange(Sender: TObject);
  406. begin
  407.   if pgcMain.ActivePage = tabAlias then
  408.     btnRefresh.Enabled := false
  409.   else
  410.     btnRefresh.Enabled := true;
  411. end;
  412.  
  413. {****************************************************************
  414. *
  415. *  N o t e C h a n g e s
  416. *
  417. ****************************************************************
  418. *  Author: The Client Server Factory Inc.
  419. *  Date:   April 28, 1999
  420. *
  421. *  Input: none
  422. *
  423. *  Description: Prepares the form when the user makes changes.
  424. *
  425. *****************************************************************
  426. * Revisions:
  427. *
  428. *****************************************************************}
  429. procedure TfrmServerProperties.NoteChanges();
  430. begin
  431.   btnApply.Enabled := False;  // assume no changes made, then start checking
  432.   case FAssignedServer.Server.Protocol of
  433.     TCP:
  434.       if (cboProtocol.ItemIndex <> 0) and (cboProtocol.ItemIndex >= 0) then
  435.         btnApply.Enabled := True;
  436.     NamedPipe:
  437.       if (cboProtocol.ItemIndex <> 1)  and (cboProtocol.ItemIndex >= 0) then
  438.         btnApply.Enabled := True;
  439.     SPX:
  440.       if (cboProtocol.ItemIndex <> 2)  and (cboProtocol.ItemIndex >= 0) then
  441.         btnApply.Enabled := True;
  442.   end;
  443.   if edtAliasName.Text <> FAssignedServer.NodeName then
  444.     btnApply.Enabled := True;
  445.   if edtHostName.Text <> FAssignedServer.ServerName then
  446.     btnApply.Enabled := true;
  447.  
  448.   if edtDescription.Text <> FAssignedServer.Description then
  449.     btnApply.Enabled := true;
  450. end;
  451.  
  452. {****************************************************************
  453. *
  454. *  R e f r e s h
  455. *
  456. ****************************************************************
  457. *  Author: The Client Server Factory Inc.
  458. *  Date:   April 28, 1999
  459. *
  460. *  Input: none
  461. *
  462. *  Description: Retrieves server properties and displays them on
  463. *               the form.
  464. *
  465. *****************************************************************
  466. * Revisions:
  467. *
  468. *****************************************************************}
  469. procedure TfrmServerProperties.Refresh();
  470. var
  471.   i:integer;
  472.   lDatabaseName:TListItem;
  473.  
  474. begin
  475.   try
  476.     FLicenseDesc.Clear;
  477.     if FAssignedServer = nil then
  478.       Exit
  479.     else
  480.     begin
  481.       if not FAssignedServer.Server.Active then
  482.         FAssignedServer.Server.Attach;
  483.       try
  484.         FAssignedServer.Server.FetchDatabaseInfo;
  485.         FAssignedServer.Server.FetchVersionInfo;
  486.         FAssignedServer.Server.FetchLicenseMaskInfo;
  487.         FAssignedServer.Server.FetchLicenseInfo;
  488.       except
  489.         on E:EIBError do
  490.           if E.IBErrorCode = isc_insufficient_svc_privileges then
  491.             FAssignedServer.Server.Active := true
  492.           else
  493.           begin
  494.             DisplayMsg(ERR_SERVER_SERVICE,E.Message);
  495.             if (E.IBErrorCode = isc_lost_db_connection) or
  496.                (E.IBErrorCode = isc_unavailable) or
  497.                (E.IBErrorCode = isc_network_error) then
  498.               frmMain.SetErrorState;
  499.             SetErrorState;
  500.             exit;
  501.           end;
  502.       end;
  503.       DecodeMask(FAssignedServer);
  504.       memCapabilities.Lines := FLicenseDesc;
  505.     end;
  506.   except
  507.     on E:EIBError do
  508.     begin
  509.       DisplayMsg(ERR_SERVER_SERVICE,E.Message);
  510.       if (E.IBErrorCode = isc_lost_db_connection) or
  511.          (E.IBErrorCode = isc_unavailable) or
  512.          (E.IBErrorCode = isc_network_error) then
  513.         frmMain.SetErrorState;
  514.       SetErrorState;
  515.       exit;
  516.     end;
  517.   end;
  518.   stxVersion.Caption := FAssignedServer.Server.VersionInfo.ServerVersion;
  519.   stxDatabaseNo.Caption := IntToStr(FAssignedServer.Server.DatabaseInfo.NoOfDatabases);
  520.   stxAttachmentNo.Caption := IntToStr(FAssignedServer.Server.DatabaseInfo.NoOfAttachments);
  521.  
  522.   lvDatabases.Items.Clear;
  523.   for i:= 0 to FAssignedServer.Server.DatabaseInfo.NoOfDatabases - 1 do
  524.   begin
  525.     lDatabaseName := lvDatabases.Items.Add;
  526.     lDatabaseName.Caption := FAssignedServer.Server.DatabaseInfo.DbName[i];
  527.   end;
  528. end;
  529.  
  530.  
  531. {****************************************************************
  532. *
  533. *  S h o w A c t i v i t y
  534. *
  535. ****************************************************************
  536. *  Author: The Client Server Factory Inc.
  537. *  Date:   April 28, 1999
  538. *
  539. *  Input: none
  540. *
  541. *  Description: Creates a temporary TIBDatabase object and uses it
  542. *               to view the users connected to the currently highlighted
  543. *               database in the Database list, via the DBConnections form.
  544. *
  545. *****************************************************************
  546. * Revisions:
  547. *
  548. *****************************************************************}
  549. procedure TfrmServerProperties.ShowActivity();
  550. var
  551.   lDatabase : TIBDatabase;
  552. begin
  553.   lDatabase := TIBDatabase.Create(Application);
  554.   try
  555.     case FAssignedServer.Server.Protocol of
  556.       TCP: lDatabase.DatabaseName := Format('%s:%s',[FAssignedServer.ServerName,lvDatabases.Selected.Caption]);
  557.       NamedPipe: lDatabase.DatabaseName := Format('\\%s\%s',[FAssignedServer.ServerName,lvDatabases.Selected.Caption]);
  558.       SPX: lDatabase.DatabaseName := Format('%s@%s',[FAssignedServer.ServerName,lvDatabases.Selected.Caption]);
  559.       Local:  lDatabase.DatabaseName := lvDatabases.Selected.Caption;
  560.     end;
  561.     frmuDBConnections.ViewDBConnections(FAssignedServer,lDatabase);
  562.   finally
  563.     lDatabase.Free;
  564.   end;
  565. end;
  566.  
  567.  
  568. {****************************************************************
  569. *
  570. *  A s s i g n S e r v e r N o d e
  571. *
  572. ****************************************************************
  573. *  Author: The Client Server Factory Inc.
  574. *  Date:   April 28, 1999
  575. *
  576. *  Input: A TibcServerNode object for which properties are to be retrieved
  577. *
  578. *  Description: assigns a server node to the form and prepares features
  579. *               that do not change and inserts initial values for
  580. *               data.
  581. *
  582. *****************************************************************
  583. * Revisions:
  584. *
  585. *****************************************************************}
  586. procedure TfrmServerProperties.AssignServerNode(const ServerNode: TibcServerNode);
  587. begin
  588.   FAssignedServer := ServerNode;
  589.   if FAssignedServer <> nil then
  590.   begin
  591.     edtAliasName.Text:= FAssignedServer.NodeName;
  592.     edtHostName.Text:= FAssignedServer.ServerName;
  593.     edtDescription.Text := FAssignedServer.Description;
  594.     case FAssignedServer.Server.Protocol of
  595.     Local:
  596.       begin
  597.         edtAliasName.Color := clSilver;
  598.         edtHostName.Color := clSilver;
  599.         cboProtocol.Color := clSilver;
  600.         edtAliasName.Enabled := false;
  601.         edtHostName.Enabled := false;
  602.         cboProtocol.Enabled := false;
  603.         edtHostName.Text:= FAssignedServer.NodeName;
  604.       end;
  605.     TCP:
  606.       cboProtocol.ItemIndex := 0;
  607.     NamedPipe:
  608.       cboProtocol.ItemIndex := 1;
  609.     SPX:
  610.       cboProtocol.ItemIndex := 2;
  611.     end;
  612.  
  613.     if not FAssignedServer.Server.Active then
  614.     begin
  615.       TabGeneral.TabVisible := false;
  616.       cboProtocol.Enabled := true;
  617.       edtHostName.Enabled := true;
  618.     end
  619.     else
  620.       Refresh();
  621.   end;
  622. end;
  623.  
  624.  
  625. {****************************************************************
  626. *
  627. *  E d i t S e r v e r P r o p e r t i e s
  628. *
  629. ****************************************************************
  630. *  Author: The Client Server Factory Inc.
  631. *  Date:   April 28, 1999
  632. *
  633. *  Input: Server node for which properties are requested.
  634. *
  635. *  Returns: Modal Result of Server Properties form.
  636. *
  637. *  Description: Displays the Server Properties form and saves
  638. *               changes to server alias and/or protocol in the
  639. *               registry.
  640. *
  641. *****************************************************************
  642. * Revisions:
  643. *
  644. *****************************************************************}
  645. function EditServerProperties(const CurrSelServer: TibcServerNode): integer;
  646. var
  647.   frmServerProperties : TfrmServerProperties;
  648.   tmpServer: TibcServerNode;
  649.   ServerActive: boolean;
  650.  
  651. begin
  652.   result := FAILURE;
  653.   frmServerProperties := TfrmServerProperties.Create(Application);
  654.   try
  655.     frmServerProperties.AssignServerNode(CurrSelServer);
  656.     if not frmServerProperties.GetErrorState then
  657.     begin
  658.       frmServerProperties.ShowModal;
  659.       tmpServer := frmServerProperties.GetNewSettings;
  660.       with CurrSelServer do
  661.       begin
  662.         if Server.Protocol <> tmpServer.Server.Protocol then
  663.         begin
  664.           ServerActive := Server.Active;
  665.           if Server.Active then
  666.             Server.Active := false;
  667.           Server.Protocol := tmpServer.Server.Protocol;
  668.  
  669.           if ServerActive then
  670.           Server.Active := true;
  671.         end;
  672.         NodeName := tmpServer.NodeName;
  673.       end;
  674.       frmMain.RenameTreeNode(CurrSelServer,frmServerProperties.edtAliasName.Text);
  675.       result := SUCCESS;
  676.     end;
  677.   finally
  678.     frmServerProperties.Free;
  679.   end;
  680. end;
  681.  
  682. {****************************************************************
  683. *
  684. *  D e c o d e M a s k
  685. *
  686. ****************************************************************
  687. *  Author: The Client Server Factory Inc.
  688. *  Date:   May 5, 1999
  689. *
  690. *  Input:  none
  691. *
  692. *  Description: Decodes the masks previously fetched and sets up
  693. *               the output TStrings.
  694. *
  695. *
  696. *****************************************************************
  697. * Revisions:
  698. *
  699. *****************************************************************}
  700. procedure TfrmServerProperties.DecodeMask(AssignedServer: TibcServerNode);
  701. var
  702.   lLicenseMask: integer;
  703. begin
  704.   lLicenseMask := AssignedServer.Server.LicenseMaskInfo.LicenseMask;
  705.   if ((lLicenseMask shr LIC_A_BIT) and 1) = 1 then
  706.     FLicenseDesc.Add(LIC_A_TEXT);
  707.  
  708.   if ((lLicenseMask shr LIC_B_BIT) and 1) = 1 then
  709.     FLicenseDesc.Add(LIC_B_TEXT);
  710.  
  711.   if ((lLicenseMask shr LIC_C_BIT) and 1) = 1 then
  712.     FLicenseDesc.Add(LIC_C_TEXT);
  713.  
  714.   if ((lLicenseMask shr LIC_D_BIT) and 1) = 1 then
  715.     FLicenseDesc.Add(LIC_D_TEXT);
  716.  
  717.   if ((lLicenseMask shr LIC_E_BIT) and 1) = 1 then
  718.     FLicenseDesc.Add(LIC_E_TEXT);
  719.  
  720.   if ((lLicenseMask shr LIC_F_BIT) and 1) = 1 then
  721.     FLicenseDesc.Add(LIC_F_TEXT);
  722.  
  723.   if ((lLicenseMask shr LIC_I_BIT) and 1) = 1 then
  724.     FLicenseDesc.Add(LIC_I_TEXT);
  725.  
  726.   if ((lLicenseMask shr LIC_L_BIT) and 1) = 1 then
  727.     FLicenseDesc.Add(LIC_L_TEXT);
  728.  
  729.   if ((lLicenseMask shr LIC_P_BIT) and 1) = 1 then
  730.     FLicenseDesc.Add(LIC_P_TEXT);
  731.  
  732.   if ((lLicenseMask shr LIC_Q_BIT) and 1) = 1 then
  733.     FLicenseDesc.Add(LIC_Q_TEXT);
  734.  
  735.   if ((lLicenseMask shr LIC_R_BIT) and 1) = 1 then
  736.     FLicenseDesc.Add(LIC_R_TEXT);
  737.  
  738.   if ((lLicenseMask shr LIC_S_BIT) and 1) = 1 then
  739.     FLicenseDesc.Add(LIC_S_TEXT);
  740.  
  741.   if ((lLicenseMask shr LIC_W_BIT) and 1) = 1 then
  742.     FLicenseDesc.Add(LIC_W_TEXT)
  743.   else
  744.     FLicenseDesc.Add('Server is limited to ' + IntToStr(FAssignedServer.Server.LicenseInfo.LicensedUsers) + ' users');
  745.  
  746.   if ((lLicenseMask shr LIC_2_BIT) and 1) = 1 then
  747.     FLicenseDesc.Add(LIC_2_TEXT);
  748.  
  749.   if ((lLicenseMask shr LIC_3_BIT) and 1) = 1 then
  750.     FLicenseDesc.Add(LIC_3_TEXT);
  751. end;
  752.  
  753. procedure TfrmServerProperties.FormCreate(Sender: TObject);
  754. begin
  755.   inherited;
  756.   FLicenseDesc := TStringList.Create();
  757. end;
  758.  
  759. procedure TfrmServerProperties.FormDestroy(Sender: TObject);
  760. begin
  761.   FLicenseDesc.Free;
  762. end;
  763.  
  764. procedure TfrmServerProperties.WMNCLButtonDown( var Message: TWMNCLButtonDown );
  765. var
  766.   ScreenPt: TPoint;
  767.   ClientPt: TPoint;
  768. begin
  769.   ScreenPt.X := Message.XCursor;
  770.   ScreenPt.Y := Message.YCursor;
  771.   ClientPt := ScreenToClient( ScreenPt );
  772.   if( ClientPt.X > Width-45 )and (ClientPt.X < Width-29) then
  773.    begin
  774.     WinHelp(WindowHandle,CONTEXT_HELP_FILE,HELP_CONTEXT,SERVER_PROPERTIES);
  775.     Message.Result := 0;
  776.   end else
  777.    inherited;
  778. end;
  779.  
  780. procedure TfrmServerProperties.FormShow(Sender: TObject);
  781. begin
  782.   inherited;
  783.   pgcMain.ActivePage := tabAlias;
  784.   pgcMainChange(Sender);
  785. end;
  786.  
  787. function TfrmServerProperties.GetNewSettings: TibcServerNode;
  788. begin
  789.   result := FAssignedServer;
  790. end;
  791.  
  792. procedure TfrmServerProperties.Button1Click(Sender: TObject);
  793. begin
  794.   inherited;
  795.   ModalResult := mrCancel;
  796. end;
  797.  
  798. end.
  799.  
  800.  
  801.