jvbdelogindialog.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvxLoginDlg.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s):
  Polaris Software

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvBDELoginDialog.pas,v 1.22 2005/02/17 10:19:59 marquardt Exp $

unit JvBDELoginDialog;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Classes, DBTables,
  JvLoginForm, JvAppStorage;

type
  TCheckUserNameEvent = function(UsersTable: TTable;
    const UserName, Password: string): Boolean of object;

  TDialogMode = (dmAppLogin, dmDBLogin, dmUnlock);

  TJvDBLoginEvent = procedure(Sender: TObject; const UserName, Password: string) of object;

  TJvDBLoginDialog = class(TObject)
  private
    FDialog: TJvLoginForm;
    FMode: TDialogMode;
    FSelectDatabase: Boolean;
    FIniAliasName: string;
    FCheckUserEvent: TCheckUserNameEvent;
    FCheckUnlock: TCheckUnlockEvent;
    FIconDblClick: TNotifyEvent;
    FDatabase: TDatabase;
    FAttemptNumber: Integer;
    FShowDBName: Boolean;
    FUsersTableName: string;
    FUserNameField: string;
    FMaxPwdLen: Integer;
    FLoginName: string;
    FAppStorage: TJvCustomAppStorage;
    FAppStoragePath: string;
    FOnLoginFailure: TJvDBLoginEvent;
    procedure Login(Database: TDatabase; LoginParams: TStrings);
    function GetUserInfo: Boolean;
    function CheckUser(Table: TTable): Boolean;
    function CheckUnlock: Boolean;
    procedure OkBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    function ExecuteAppLogin: Boolean;
    function ExecuteDbLogin(LoginParams: TStrings): Boolean;
    function ExecuteUnlock: Boolean;
  public
    constructor Create(DialogMode: TDialogMode; DatabaseSelect: Boolean);
    destructor Destroy; override;
    function Execute(LoginParams: TStrings): Boolean;
    function GetUserName: string;
    function CheckDatabaseChange: Boolean;
    procedure FillParams(LoginParams: TStrings);
    property Mode: TDialogMode read FMode;
    property SelectDatabase: Boolean read FSelectDatabase;
    property OnCheckUnlock: TCheckUnlockEvent read FCheckUnlock write FCheckUnlock;
    property OnCheckUserEvent: TCheckUserNameEvent read FCheckUserEvent write FCheckUserEvent;
    property OnIconDblClick: TNotifyEvent read FIconDblClick write FIconDblClick;
    property AppStorage: TJvCustomAppStorage read FAppStorage write FAppStorage;
    property AppStoragePath: string read FAppStoragePath write FAppStoragePath;
    property Database: TDatabase read FDatabase write FDatabase;
    property AttemptNumber: Integer read FAttemptNumber write FAttemptNumber;
    property ShowDBName: Boolean read FShowDBName write FShowDBName;
    property UsersTableName: string read FUsersTableName write FUsersTableName;
    property UserNameField: string read FUserNameField write FUserNameField;
    property MaxPwdLen: Integer read FMaxPwdLen write FMaxPwdLen;
    property LoginName: string read FLoginName write FLoginName;
  published
    property OnLoginFailure: TJvDBLoginEvent read FOnLoginFailure write FOnLoginFailure;
  end;

procedure OnLoginDialog(Database: TDatabase; LoginParams: TStrings;
  AttemptNumber: Integer; ShowDBName: Boolean);

function LoginDialog(Database: TDatabase; AttemptNumber: Integer;
  const UsersTableName, UserNameField: string; MaxPwdLen: Integer;
  CheckUserEvent: TCheckUserNameEvent; IconDblClick: TNotifyEvent;
  var LoginName: string; AppStorage: TJvCustomAppStorage;
  AppStoragePath: string; SelectDatabase: Boolean;
  LoginFailure: TJvDBLoginEvent): Boolean;

function UnlockDialog(const UserName: string; OnUnlock: TCheckUnlockEvent;
  IconDblClick: TNotifyEvent): Boolean;
function UnlockDialogEx(const UserName: string; OnUnlock: TCheckUnlockEvent;
  IconDblClick: TNotifyEvent; MaxPwdLen, AttemptNumber: Integer): Boolean;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvBDELoginDialog.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2005/02/17 10:19:59 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Graphics, Controls, Forms, DB, BDE,
  JvBDELists, 
  JvConsts, JvResources;

constructor TJvDBLoginDialog.Create(DialogMode: TDialogMode; DatabaseSelect: Boolean);
begin
  inherited Create;
  FMode := DialogMode;
  FSelectDatabase := DatabaseSelect;
  FDialog := CreateLoginDialog((FMode = dmUnlock), FSelectDatabase,
    FormShow, OkBtnClick);
  AttemptNumber := 3;
  ShowDBName := True;
end;

destructor TJvDBLoginDialog.Destroy;
begin
  FDialog.Free;
  inherited Destroy;
end;

procedure TJvDBLoginDialog.OkBtnClick(Sender: TObject);
var
  Ok: Boolean;
  SaveLogin: TDatabaseLoginEvent;
  SetCursor: Boolean;
begin
  if FMode = dmUnlock then
  begin
    Ok := False;
    try
      Ok := CheckUnlock;
    except
      Application.HandleException(Self);
    end;
    if Ok then
      FDialog.ModalResult := mrOk
    else
      FDialog.ModalResult := mrCancel;
  end
  else
  if Mode = dmAppLogin then
  begin
    SetCursor := GetCurrentThreadID = MainThreadID;
    SaveLogin := Database.OnLogin;
    try
      try
        if Database.Connected then
          Database.Close; //Polaris
        if FSelectDatabase then
          Database.AliasName := FDialog.CustomCombo.Text;
        Database.OnLogin := Login;
        if SetCursor then
          Screen.Cursor := crHourGlass;
        try
          Database.Open;
        finally
          if SetCursor then
            Screen.Cursor := crDefault;
        end;
      except
        Application.HandleException(Self);
      end;
    finally
      Database.OnLogin := SaveLogin;
    end;
    if Database.Connected then
    try
      if SetCursor then
        Screen.Cursor := crHourGlass;
      Ok := False;
      try
        Ok := GetUserInfo;
      except
        Application.HandleException(Self);
      end;
      if Ok then
        FDialog.ModalResult := mrOk
      else
      begin
        FDialog.ModalResult := mrNone;
        Database.Close;
      end;
    finally
      if SetCursor then
        Screen.Cursor := crDefault;
    end;
  end
  else { dmDBLogin }
    FDialog.ModalResult := mrOk
end;

procedure TJvDBLoginDialog.FormShow(Sender: TObject);
var
  S: string;
begin
  if (FMode in [dmAppLogin, dmDBLogin]) and FSelectDatabase then
  begin
    with TJvBDEItems.Create(FDialog) do
    try
      SessionName := Database.SessionName;
      ItemType := bdDatabases;
      FDialog.CustomCombo.Items.Clear;
      Open;
      while not Eof do
      begin
        FDialog.CustomCombo.Items.Add(FieldByName('NAME').AsString);
        Next;
      end;
      if FIniAliasName = '' then
        S := Database.AliasName
      else
        S := FIniAliasName;
      with FDialog.CustomCombo do
        ItemIndex := Items.IndexOf(S);
    finally
      Free;
    end;
  end;
end;

function TJvDBLoginDialog.ExecuteAppLogin: Boolean;
begin
  if Assigned(AppStorage) then
  begin
    FDialog.UserNameEdit.Text := AppStorage.ReadString(AppStorage.ConcatPaths([AppStoragePath, RsLastLoginUserName]),
      LoginName);
    FSelectDatabase := AppStorage.ReadBoolean(AppStorage.ConcatPaths([AppStoragePath, RsSelectDatabase]),
      FSelectDatabase);
    FIniAliasName := AppStorage.ReadString(AppStorage.ConcatPaths([AppStoragePath, RsLastAliasName]), '');
  end;
  FDialog.SelectDatabase := SelectDatabase;
  Result := (FDialog.ShowModal = mrOk);
  Database.OnLogin := nil;
  if Result then
  begin