home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / LoginDlg.pas < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  14KB  |  465 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit LoginDlg;
  11.  
  12. {$I RX.INC}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Messages, Classes, Controls, Forms, Dialogs, StdCtrls,
  17.   ExtCtrls, DB, DBTables, DBLists, RxLogin, BdeUtils;
  18.  
  19. type
  20.   TCheckUserNameEvent = function(UsersTable: TTable;
  21.     const UserName, Password: string): Boolean of object;
  22.  
  23.   TDialogMode = (dmAppLogin, dmDBLogin, dmUnlock);
  24.  
  25.   TDBLoginDialog = class
  26.   private
  27.     FDialog: TRxLoginForm;
  28.     FMode: TDialogMode;
  29.     FSelectDatabase: Boolean;
  30.     FIniAliasName: string;
  31.     FCheckUserEvent: TCheckUserNameEvent;
  32.     FCheckUnlock: TCheckUnlockEvent;
  33.     FIconDblClick: TNotifyEvent;
  34.     procedure Login(Database: TDatabase; LoginParams: TStrings);
  35.     function GetUserInfo: Boolean;
  36.     function CheckUser(Table: TTable): Boolean;
  37.     function CheckUnlock: Boolean;
  38.     procedure OkBtnClick(Sender: TObject);
  39.     procedure FormShow(Sender: TObject);
  40.     function ExecuteAppLogin: Boolean;
  41.     function ExecuteDbLogin(LoginParams: TStrings): Boolean;
  42.     function ExecuteUnlock: Boolean;
  43.   public
  44.     Database: TDatabase;
  45.     AttemptNumber: Integer;
  46.     ShowDBName: Boolean;
  47.     UsersTableName: string;
  48.     UserNameField: string;
  49.     MaxPwdLen: Integer;
  50.     LoginName: string;
  51.     IniFileName: string;
  52.     UseRegistry: Boolean;
  53.     constructor Create(DialogMode: TDialogMode; DatabaseSelect: Boolean);
  54.     destructor Destroy; override;
  55.     function Execute(LoginParams: TStrings): Boolean;
  56.     function GetUserName: string;
  57.     function CheckDatabaseChange: Boolean;
  58.     procedure FillParams(LoginParams: TStrings);
  59.     property Mode: TDialogMode read FMode;
  60.     property SelectDatabase: Boolean read FSelectDatabase;
  61.     property OnCheckUnlock: TCheckUnlockEvent read FCheckUnlock write FCheckUnlock;
  62.     property OnCheckUserEvent: TCheckUserNameEvent read FCheckUserEvent write FCheckUserEvent;
  63.     property OnIconDblClick: TNotifyEvent read FIconDblClick write FIconDblClick;
  64.   end;
  65.  
  66. procedure OnLoginDialog(Database: TDatabase; LoginParams: TStrings;
  67.   AttemptNumber: Integer; ShowDBName: Boolean);
  68.  
  69. function LoginDialog(Database: TDatabase; AttemptNumber: Integer;
  70.   const UsersTableName, UserNameField: string; MaxPwdLen: Integer;
  71.   CheckUserEvent: TCheckUserNameEvent; IconDblClick: TNotifyEvent;
  72.   var LoginName: string; const IniFileName: string;
  73.   UseRegistry, SelectDatabase: Boolean): Boolean;
  74.  
  75. function UnlockDialog(const UserName: string; OnUnlock: TCheckUnlockEvent;
  76.   IconDblClick: TNotifyEvent): Boolean;
  77. function UnlockDialogEx(const UserName: string; OnUnlock: TCheckUnlockEvent;
  78.   IconDblClick: TNotifyEvent; MaxPwdLen, AttemptNumber: Integer): Boolean;
  79.  
  80. implementation
  81.  
  82. uses {$IFDEF WIN32} Windows, Registry, BDE, {$ELSE} WinTypes, WinProcs,
  83.   DbiTypes, {$ENDIF} IniFiles, Graphics, AppUtils, RxDConst, Consts,
  84.   VclUtils, RxConst;
  85.  
  86. const
  87.   keyLastLoginUserName = 'LastUser';
  88.   keySelectDatabase = 'SelectDatabase'; { dialog never writes this value }
  89.   keyLastAliasName = 'LastAlias';       { used if SelectDatabase = True  }
  90.  
  91. { TDBLoginDialog }
  92.  
  93. constructor TDBLoginDialog.Create(DialogMode: TDialogMode; DatabaseSelect: Boolean);
  94. begin
  95.   inherited Create;
  96.   FMode := DialogMode;
  97.   FSelectDatabase := DatabaseSelect;
  98.   FDialog := CreateLoginDialog((FMode = dmUnlock), FSelectDatabase,
  99.     FormShow, OkBtnClick);
  100.   AttemptNumber := 3;
  101.   ShowDBName := True;
  102. end;
  103.  
  104. destructor TDBLoginDialog.Destroy;
  105. begin
  106.   FDialog.Free;
  107.   inherited Destroy;
  108. end;
  109.  
  110. procedure TDBLoginDialog.OkBtnClick(Sender: TObject);
  111. var
  112.   Ok: Boolean;
  113.   SaveLogin: TDatabaseLoginEvent;
  114.   SetCursor: Boolean;
  115. begin
  116.   if FMode = dmUnlock then begin
  117.     Ok := False;
  118.     try
  119.       Ok := CheckUnlock;
  120.     except
  121.       Application.HandleException(Self);
  122.     end;
  123.     if Ok then FDialog.ModalResult := mrOk
  124.     else FDialog.ModalResult := mrCancel;
  125.   end
  126.   else if Mode = dmAppLogin then begin
  127. {$IFDEF WIN32}
  128.     SetCursor := GetCurrentThreadID = MainThreadID;
  129. {$ELSE}
  130.     SetCursor := True;
  131. {$ENDIF}
  132.     SaveLogin := Database.OnLogin;
  133.     try
  134.       try
  135.         if FSelectDatabase then
  136.           Database.AliasName := FDialog.CustomCombo.Text;
  137.         Database.OnLogin := Login;
  138.         if SetCursor then Screen.Cursor := crHourGlass;
  139.         try
  140.           Database.Open;
  141.         finally
  142.           if SetCursor then Screen.Cursor := crDefault;
  143.         end;
  144.       except
  145.         Application.HandleException(Self);
  146.       end;
  147.     finally
  148.       Database.OnLogin := SaveLogin;
  149.     end;
  150.     if Database.Connected then
  151.     try
  152.       if SetCursor then Screen.Cursor := crHourGlass;
  153.       Ok := False;
  154.       try
  155.         Ok := GetUserInfo;
  156.       except
  157.         Application.HandleException(Self);
  158.       end;
  159.       if Ok then FDialog.ModalResult := mrOk
  160.       else begin
  161.         FDialog.ModalResult := mrNone;
  162.         Database.Close;
  163.       end;
  164.     finally
  165.       if SetCursor then Screen.Cursor := crDefault;
  166.     end;
  167.   end
  168.   else { dmDBLogin } FDialog.ModalResult := mrOk
  169. end;
  170.  
  171. procedure TDBLoginDialog.FormShow(Sender: TObject);
  172. var
  173.   S: string;
  174. begin
  175.   if (FMode in [dmAppLogin, dmDBLogin]) and FSelectDatabase then begin
  176.     with TBDEItems.Create(FDialog) do
  177.     try
  178. {$IFDEF WIN32}
  179.       SessionName := Database.SessionName;
  180. {$ENDIF}
  181.       ItemType := bdDatabases;
  182.       FDialog.CustomCombo.Items.Clear;
  183.       Open;
  184.       while not Eof do begin
  185.         FDialog.CustomCombo.Items.Add(FieldByName('NAME').AsString);
  186.         Next;
  187.       end;
  188.       if FIniAliasName = '' then S := Database.AliasName
  189.       else S := FIniAliasName;
  190.       with FDialog.CustomCombo do ItemIndex := Items.IndexOf(S);
  191.     finally
  192.       Free;
  193.     end;
  194.   end;
  195. end;
  196.  
  197. function TDBLoginDialog.ExecuteAppLogin: Boolean;
  198. var
  199.   Ini: TObject;
  200. begin
  201.   try
  202. {$IFDEF WIN32}
  203.     if UseRegistry then begin
  204.       Ini := TRegIniFile.Create(IniFileName);
  205. {$IFDEF RX_D5}
  206.       TRegIniFile(Ini).Access := KEY_READ;
  207. {$ENDIF}
  208.     end
  209.     else 
  210.       Ini := TIniFile.Create(IniFileName);
  211. {$ELSE}
  212.     Ini := TIniFile.Create(IniFileName);
  213. {$ENDIF WIN32}
  214.     try
  215.       FDialog.UserNameEdit.Text := IniReadString(Ini, FDialog.ClassName,
  216.         keyLastLoginUserName, LoginName);
  217.       FSelectDatabase := IniReadBool(Ini, FDialog.ClassName,
  218.         keySelectDatabase, FSelectDatabase);
  219.       FIniAliasName := IniReadString(Ini, FDialog.ClassName,
  220.         keyLastAliasName, '');
  221.     finally
  222.       Ini.Free;
  223.     end;
  224.   except
  225.     IniFileName := '';
  226.   end;
  227.   FDialog.SelectDatabase := SelectDatabase;
  228.   Result := (FDialog.ShowModal = mrOk);
  229.   Database.OnLogin := nil;
  230.   if Result then begin
  231.     LoginName := GetUserName;
  232.     if IniFileName <> '' then begin
  233. {$IFDEF WIN32}
  234.       if UseRegistry then Ini := TRegIniFile.Create(IniFileName)
  235.       else Ini := TIniFile.Create(IniFileName);
  236. {$ELSE}
  237.       Ini := TIniFile.Create(IniFileName);
  238. {$ENDIF WIN32}
  239.       try
  240.         IniWriteString(Ini, FDialog.ClassName, keyLastLoginUserName, GetUserName);
  241.         IniWriteString(Ini, FDialog.ClassName, keyLastAliasName, Database.AliasName);
  242.       finally
  243.         Ini.Free;
  244.       end;
  245.     end;
  246.   end;
  247. end;
  248.  
  249. function TDBLoginDialog.ExecuteDbLogin(LoginParams: TStrings): Boolean;
  250. {$IFDEF WIN32}
  251. var
  252.   CurrSession: TSession;
  253. {$ENDIF}
  254. begin
  255.   Result := False;
  256.   if (Database = nil) or not Assigned(LoginParams) then Exit;
  257.   if ShowDBName then
  258.     FDialog.AppTitleLabel.Caption := FmtLoadStr(SDatabaseName,
  259.       [Database.DatabaseName]);
  260.   FDialog.UserNameEdit.Text := LoginParams.Values[szUSERNAME];
  261. {$IFDEF WIN32}
  262.   CurrSession := Sessions.CurrentSession;
  263. {$ENDIF}
  264.   try
  265.     Result := FDialog.ShowModal = mrOk;
  266.     if Result then FillParams(LoginParams)
  267.     else SysUtils.Abort;
  268.   finally
  269. {$IFDEF WIN32}
  270.     Sessions.CurrentSession := CurrSession;
  271. {$ENDIF}
  272.   end;
  273. end;
  274.  
  275. function TDBLoginDialog.ExecuteUnlock: Boolean;
  276. begin
  277.   with FDialog.UserNameEdit do begin
  278.     Text := LoginName;
  279.     ReadOnly := True;
  280.     Font.Color := clGrayText;
  281.   end;
  282.   Result := (FDialog.ShowModal = mrOk);
  283. end;
  284.  
  285. function TDBLoginDialog.Execute(LoginParams: TStrings): Boolean;
  286. var
  287.   SaveCursor: TCursor;
  288. begin
  289.   SaveCursor := Screen.Cursor;
  290.   Screen.Cursor := crDefault;
  291.   try
  292.     if Assigned(FIconDblClick) then begin
  293.       with FDialog.AppIcon do begin
  294.         OnDblClick := OnIconDblClick;
  295.         Cursor := crHand;
  296.       end;
  297.       with FDialog.KeyImage do begin
  298.         OnDblClick := OnIconDblClick;
  299.         Cursor := crHand;
  300.       end;
  301.     end;
  302.     FDialog.PasswordEdit.MaxLength := MaxPwdLen;
  303.     FDialog.AttemptNumber := AttemptNumber;
  304.     case FMode of
  305.       dmAppLogin: Result := ExecuteAppLogin;
  306.       dmDBLogin: Result := ExecuteDbLogin(LoginParams);
  307.       dmUnlock: Result := ExecuteUnlock;
  308.       else Result := False;
  309.     end;
  310.     if Result then LoginName := GetUserName;
  311.   finally
  312.     Screen.Cursor := SaveCursor;
  313.   end;
  314. end;
  315.  
  316. function TDBLoginDialog.GetUserName: string;
  317. begin
  318.   if CheckDatabaseChange then
  319.     Result := Copy(FDialog.UserNameEdit.Text, 1,
  320.       Pos('@', FDialog.UserNameEdit.Text) - 1)
  321.   else
  322.     Result := FDialog.UserNameEdit.Text;
  323. end;
  324.  
  325. function TDBLoginDialog.CheckDatabaseChange: Boolean;
  326. begin
  327.   Result := (FMode in [dmAppLogin, dmDBLogin]) and
  328.     (Pos('@', Fdialog.UserNameEdit.Text) > 0) and
  329.     ((Database <> nil) and (Database.DriverName <> '') and
  330.     (CompareText(Database.DriverName, szCFGDBSTANDARD) <> 0));
  331. end;
  332.  
  333. procedure TDBLoginDialog.FillParams(LoginParams: TStrings);
  334. begin
  335.   LoginParams.Values[szUSERNAME] := GetUserName;
  336.   LoginParams.Values['PASSWORD'] := FDialog.PasswordEdit.Text;
  337.   if CheckDatabaseChange then begin
  338.     LoginParams.Values[szSERVERNAME] := Copy(FDialog.UserNameEdit.Text,
  339.       Pos('@', FDialog.UserNameEdit.Text) + 1, MaxInt)
  340.   end;
  341. end;
  342.  
  343. procedure TDBLoginDialog.Login(Database: TDatabase; LoginParams: TStrings);
  344. begin
  345.   FillParams(LoginParams);
  346. end;
  347.  
  348. function TDBLoginDialog.GetUserInfo: Boolean;
  349. var
  350.   Table: TTable;
  351. begin
  352.   if UsersTableName = '' then Result := CheckUser(nil)
  353.   else begin
  354.     Result := False;
  355.     Table := TTable.Create(Database);
  356.     try
  357.       try
  358.         Table.DatabaseName := Database.DatabaseName;
  359. {$IFDEF WIN32}
  360.         Table.SessionName := Database.SessionName;
  361. {$ENDIF}
  362.         Table.TableName := UsersTableName;
  363.         Table.IndexFieldNames := UserNameField;
  364.         Table.Open;
  365.         if Table.FindKey([GetUserName]) then begin
  366.           Result := CheckUser(Table);
  367.           if not Result then
  368.             raise EDatabaseError.Create(LoadStr(SInvalidUserName));
  369.         end
  370.         else
  371.           raise EDatabaseError.Create(LoadStr(SInvalidUserName));
  372.       except
  373.         Application.HandleException(Self);
  374.       end;
  375.     finally
  376.       Table.Free;
  377.     end;
  378.   end;
  379. end;
  380.  
  381. function TDBLoginDialog.CheckUser(Table: TTable): Boolean;
  382. begin
  383.   if Assigned(FCheckUserEvent) then
  384.     Result := FCheckUserEvent(Table, GetUserName, FDialog.PasswordEdit.Text)
  385.   else Result := True;
  386. end;
  387.  
  388. function TDBLoginDialog.CheckUnlock: Boolean;
  389. begin
  390.   if Assigned(FCheckUnlock) then
  391.     Result := FCheckUnlock(FDialog.PasswordEdit.Text)
  392.   else Result := True;
  393. end;
  394.  
  395. { Utility routines }
  396.  
  397. procedure OnLoginDialog(Database: TDatabase; LoginParams: TStrings;
  398.   AttemptNumber: Integer; ShowDBName: Boolean);
  399. var
  400.   Dlg: TDBLoginDialog;
  401. begin
  402.   Dlg := TDBLoginDialog.Create(dmDBLogin, False);
  403.   try
  404.     Dlg.Database := Database;
  405.     Dlg.ShowDBName := ShowDBName;
  406.     Dlg.AttemptNumber := AttemptNumber;
  407.     Dlg.Execute(LoginParams);
  408.   finally
  409.     Dlg.Free;
  410.   end;
  411. end;
  412.  
  413. function UnlockDialogEx(const UserName: string; OnUnlock: TCheckUnlockEvent;
  414.   IconDblClick: TNotifyEvent; MaxPwdLen, AttemptNumber: Integer): Boolean;
  415. var
  416.   Dlg: TDBLoginDialog;
  417. begin
  418.   Dlg := TDBLoginDialog.Create(dmUnlock, False);
  419.   try
  420.     Dlg.LoginName := UserName;
  421.     Dlg.OnIconDblClick := IconDblClick;
  422.     Dlg.OnCheckUnlock := OnUnlock;
  423.     Dlg.MaxPwdLen := MaxPwdLen;
  424.     Dlg.AttemptNumber := AttemptNumber;
  425.     Result := Dlg.Execute(nil);
  426.   finally
  427.     Dlg.Free;
  428.   end;
  429. end;
  430.  
  431. function UnlockDialog(const UserName: string; OnUnlock: TCheckUnlockEvent;
  432.   IconDblClick: TNotifyEvent): Boolean;
  433. begin
  434.   Result := UnlockDialogEx(UserName, OnUnlock, IconDblClick, 0, 1);
  435. end;
  436.  
  437. function LoginDialog(Database: TDatabase; AttemptNumber: Integer;
  438.   const UsersTableName, UserNameField: string; MaxPwdLen: Integer;
  439.   CheckUserEvent: TCheckUserNameEvent; IconDblClick: TNotifyEvent;
  440.   var LoginName: string; const IniFileName: string;
  441.   UseRegistry, SelectDatabase: Boolean): Boolean;
  442. var
  443.   Dlg: TDBLoginDialog;
  444. begin
  445.   Dlg := TDBLoginDialog.Create(dmAppLogin, SelectDatabase);
  446.   try
  447.     Dlg.LoginName := LoginName;
  448.     Dlg.OnIconDblClick := IconDblClick;
  449.     Dlg.OnCheckUserEvent := CheckUserEvent;
  450.     Dlg.MaxPwdLen := MaxPwdLen;
  451.     Dlg.Database := Database;
  452.     Dlg.AttemptNumber := AttemptNumber;
  453.     Dlg.UsersTableName := UsersTableName;
  454.     Dlg.UserNameField := UserNameField;
  455.     Dlg.IniFileName := IniFileName;
  456.     Dlg.UseRegistry := UseRegistry;
  457.     Result := Dlg.Execute(nil);
  458.     if Result then LoginName := Dlg.LoginName;
  459.   finally
  460.     Dlg.Free;
  461.   end;
  462. end;
  463.  
  464. end.
  465.