jvloginform.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: JvxLogin.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):
  Hofi

Last Modified: 2004-10-07

Changes:
2004-10-07:
  * Added
     TJvCustomLogin
       property Caption to support a custom dialog Caption.

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: JvLoginForm.pas,v 1.31 2005/02/17 10:20:42 marquardt Exp $

unit JvLoginForm;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  {$IFDEF MSWINDOWS}
  Windows, // GetCurrentThreadID => Linux: System.pas
  {$ENDIF MSWINDOWS}
  {$IFDEF HAS_UNIT_LIBC}
  Libc, // GetCurrentThreadID Linux
  {$ENDIF HAS_UNIT_LIBC}
  Messages, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
  JvComponent, JvBaseDlg, JvAppStorage;

type
  TUpdateCaption = (ucNoChange, ucAppTitle, ucFormCaption);
  TJvLoginEvent = procedure(Sender: TObject; const UserName, Password: string;
    var AllowLogin: Boolean) of object;
  TCheckUnlockEvent = function(const Password: string): Boolean of object;
  TUnlockAppEvent = procedure(Sender: TObject; const UserName,
    Password: string; var AllowUnlock: Boolean) of object;

  TJvLoginForm = class;

  TJvCustomLogin = class(TJvCommonDialogF)
  private
    FActive: Boolean;
    FAttemptNumber: Integer;
    FCaption: string;
    FLoggedUser: string;
    FMaxPasswordLen: Integer;
    FAllowEmptyPassword: Boolean;
    FUpdateCaption: TUpdateCaption;
    FAppStorage: TJvCustomAppStorage;
    FAppStoragePath: string;
    FLocked: Boolean;
    FSaveOnRestore: TNotifyEvent;
    FAfterLogin: TNotifyEvent;
    FBeforeLogin: TNotifyEvent;
    FOnUnlock: TCheckUnlockEvent;
    FOnUnlockApp: TUnlockAppEvent;
    FOnIconDblClick: TNotifyEvent;
    {$IFDEF VCL}
    FUnlockDlgShowing: Boolean;
    FPasswordChar: Char;
    function UnlockHook(var Msg: TMessage): Boolean;
    {$ENDIF VCL}
    function GetLoggedUser: string;
    procedure SetAppStorage(Value: TJvCustomAppStorage);
  protected
    function CheckUnlock(const UserName, Password: string): Boolean; dynamic;
    function CreateLoginForm(UnlockMode: Boolean): TJvLoginForm; virtual;
    procedure DoAfterLogin; dynamic;
    procedure DoBeforeLogin; dynamic;
    procedure DoIconDblClick(Sender: TObject); dynamic;
    function DoLogin(var UserName: string): Boolean; virtual; abstract;
    function DoUnlockDialog: Boolean; virtual;
    procedure SetLoggedUser(const Value: string);
    procedure DoUpdateCaption;
    procedure UnlockOkClick(Sender: TObject);
    property Active: Boolean read FActive write FActive default True;
    property AllowEmptyPassword: Boolean read FAllowEmptyPassword write FAllowEmptyPassword default True;
    property AttemptNumber: Integer read FAttemptNumber write FAttemptNumber default 3;
    property MaxPasswordLen: Integer read FMaxPasswordLen write FMaxPasswordLen default 0;
    property UpdateCaption: TUpdateCaption read FUpdateCaption write FUpdateCaption default ucNoChange;
    {$IFDEF VCL}
    property PasswordChar: Char read FPasswordChar write FPasswordChar default '*';
    {$ENDIF VCL}
    property AfterLogin: TNotifyEvent read FAfterLogin write FAfterLogin;
    property BeforeLogin: TNotifyEvent read FBeforeLogin write FBeforeLogin;
    property OnUnlock: TCheckUnlockEvent read FOnUnlock write FOnUnlock; { obsolete }
    property OnUnlockApp: TUnlockAppEvent read FOnUnlockApp write FOnUnlockApp;
    property OnIconDblClick: TNotifyEvent read FOnIconDblClick write FOnIconDblClick;
    property AppStorage: TJvCustomAppStorage read FAppStorage write SetAppStorage;
    property AppStoragePath: string read FAppStoragePath write FAppStoragePath;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Login: Boolean; virtual;
    function Execute: Boolean; override;
    procedure TerminateApplication;
    procedure Lock;
    property LoggedUser: string read GetLoggedUser;
  published
    property Caption: string read FCaption write FCaption;
  end;

  TJvLoginDialog = class(TJvCustomLogin)
  private
    FOnCheckUser: TJvLoginEvent;
    procedure OkButtonClick(Sender: TObject);
    procedure WriteUserName(const UserName: string);
    function ReadUserName(const UserName: string): string;
  protected
    function DoCheckUser(const UserName, Password: string): Boolean; dynamic;
    function DoLogin(var UserName: string): Boolean; override;
    procedure Loaded; override;
  published
    property Active;
    property AppStorage;
    property AppStoragePath;
    property AttemptNumber;
    property Caption;
    property MaxPasswordLen;
    property UpdateCaption;
    {$IFDEF VCL}
    property PasswordChar;
    {$ENDIF VCL}
    property OnCheckUser: TJvLoginEvent read FOnCheckUser write FOnCheckUser;
    property AfterLogin;
    property BeforeLogin;
    property OnUnlockApp;
    property OnIconDblClick;
  end;

  TJvLoginForm = class(TJvForm)
    AppIcon: TImage;
    KeyImage: TImage;
    HintLabel: TLabel;
    UserNameLabel: TLabel;
    PasswordLabel: TLabel;
    UserNameEdit: TEdit;
    PasswordEdit: TEdit;
    AppTitleLabel: TLabel;
    OkBtn: TButton;
    CancelBtn: TButton;
    CustomLabel: TLabel;
    CustomCombo: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure OkBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FSelectDatabase: Boolean;
    FUnlockMode: Boolean;
    FAttempt: Integer;
    FOnFormShow: TNotifyEvent;
    FOnOkClick: TNotifyEvent;
  public
    AttemptNumber: Integer;
    property Attempt: Integer read FAttempt;
    property SelectDatabase: Boolean read FSelectDatabase write FSelectDatabase;
    property OnFormShow: TNotifyEvent read FOnFormShow write FOnFormShow;
    property OnOkClick: TNotifyEvent read FOnOkClick write FOnOkClick;
  end;

function CreateLoginDialog(UnlockMode, ASelectDatabase: Boolean;
 FormShowEvent, OkClickEvent: TNotifyEvent;
 ACaption: string = ''): TJvLoginForm;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvLoginForm.pas,v $';
    Revision: '$Revision: 1.31 $';
    Date: '$Date: 2005/02/17 10:20:42 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Consts,
  IniFiles,
  JvJCLUtils, JvJVCLUtils, JvResources, JvConsts;

{$R *.dfm}

function CreateLoginDialog(UnlockMode, ASelectDatabase: Boolean;
 FormShowEvent, OkClickEvent: TNotifyEvent; ACaption: string = ''): TJvLoginForm;
begin
  Result := TJvLoginForm.Create(Application);
  with Result do
  begin
    Caption := ACaption;
    FSelectDatabase := ASelectDatabase;
    FUnlockMode := UnlockMode;
    if FUnlockMode then
    begin
      FormStyle := fsNormal;
      FSelectDatabase := False;
    end
    else
      FormStyle := fsStayOnTop;
    OnFormShow := FormShowEvent;
    OnOkClick := OkClickEvent;
  end;
end;

//=== { TJvCustomLogin } =====================================================

constructor TJvCustomLogin.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLoggedUser := '';
  FActive := True;
  FAttemptNumber := 3;
  {$IFDEF VCL}
  FPasswordChar := '*';
  {$ENDIF VCL}
  FAllowEmptyPassword := True;
end;

destructor TJvCustomLogin.Destroy;
begin
  if FLocked then
  begin
    {$IFDEF VCL}
    Application.UnhookMainWindow(UnlockHook);
    {$ENDIF VCL}
    FLocked := False;
  end;
  inherited Destroy;
end;

procedure TJvCustomLogin.SetAppStorage(Value: TJvCustomAppStorage);
begin
  FAppStorage := Value;
end;

function TJvCustomLogin.GetLoggedUser: string;
begin
  Result := FLoggedUser;
end;

procedure TJvCustomLogin.SetLoggedUser(const Value: string);
begin
  FLoggedUser := Value;
end;

procedure TJvCustomLogin.DoAfterLogin;
begin
  if Assigned(FAfterLogin) then
    FAfterLogin(Self);
end;

procedure TJvCustomLogin.DoBeforeLogin;
begin
  if Assigned(FBeforeLogin) then
    FBeforeLogin(Self);
end;

procedure TJvCustomLogin.DoIconDblClick(Sender: TObject);
begin
  if Assigned(FOnIconDblClick) then
    FOnIconDblClick(Self);
end;

procedure TJvCustomLogin.DoUpdateCaption;
var
  F: TCustomForm;
begin
  F := Application.MainForm;
  if (F = nil) and (Owner is TForm) then
    F := Owner as TForm;
  if (F <> nil) and (LoggedUser <> '') then
    case UpdateCaption of
      ucAppTitle:
        F.Caption := Format('%s (%s)', [Application.Title, LoggedUser]);
      ucFormCaption:
        begin
          F.Caption := Format('%s (%s)', [F.Caption, LoggedUser]);
          UpdateCaption := ucNoChange;
        end;
    end;
end;

function TJvCustomLogin.Login: Boolean;
var
  LoginName: string;
begin
  LoginName := '';
  DoBeforeLogin;
  Result := DoLogin(LoginName);
  if Result then
  begin
    SetLoggedUser(LoginName);
    DoUpdateCaption;
    DoAfterLogin;
  end;
end;

procedure TJvCustomLogin.Lock;