rxlogin.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit RxLogin;

{$I RX.INC}

interface

uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} SysUtils,
  Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  Buttons;

type
  TUpdateCaption = (ucNoChange, ucAppTitle, ucFormCaption);
  TRxLoginEvent = 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;

  TRxLoginForm = class;

{ TRxCustomLogin }

  TRxCustomLogin = class(TComponent)
  private
    FActive: Boolean;
    FAttemptNumber: Integer;
    FLoggedUser: String;
    FMaxPasswordLen: Integer;
    FAllowEmpty: Boolean;
    FUpdateCaption: TUpdateCaption;
    FIniFileName: String;
    FUseRegistry: Boolean;
    FLocked: Boolean;
    FUnlockDlgShowing: Boolean;
    FSaveOnRestore: TNotifyEvent;
    FAfterLogin: TNotifyEvent;
    FBeforeLogin: TNotifyEvent;
    FOnUnlock: TCheckUnlockEvent;
    FOnUnlockApp: TUnlockAppEvent;
    FOnIconDblClick: TNotifyEvent;
    function GetLoggedUser: string;
    function GetIniFileName: string;
    procedure SetIniFileName(const Value: string);
    function UnlockHook(var Message: TMessage): Boolean;
  protected
    function CheckUnlock(const UserName, Password: string): Boolean; dynamic;
    function CreateLoginForm(UnlockMode: Boolean): TRxLoginForm; 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 FAllowEmpty write FAllowEmpty default True;
    property AttemptNumber: Integer read FAttemptNumber write FAttemptNumber default 3;
    property IniFileName: string read GetIniFileName write SetIniFileName;
    property MaxPasswordLen: Integer read FMaxPasswordLen write FMaxPasswordLen default 0;
    property UpdateCaption: TUpdateCaption read FUpdateCaption write FUpdateCaption default ucNoChange;
    property UseRegistry: Boolean read FUseRegistry write FUseRegistry default False;
    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;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Login: Boolean; virtual;
    procedure TerminateApplication;
    procedure Lock;
    property LoggedUser: string read GetLoggedUser;
  end;

{ TRxLoginDialog }

  TRxLoginDialog = class(TRxCustomLogin)
  private
    FOnCheckUser: TRxLoginEvent;
    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 AttemptNumber;
    property IniFileName;
    property MaxPasswordLen;
    property UpdateCaption;
    property UseRegistry;
    property OnCheckUser: TRxLoginEvent read FOnCheckUser write FOnCheckUser;
    property AfterLogin;
    property BeforeLogin;
    property OnUnlockApp;
    property OnIconDblClick;
  end;

{ TRxLoginForm }

  TRxLoginForm = class(TForm)
    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
    { Private declarations }
    FSelectDatabase: Boolean;
    FUnlockMode: Boolean;
    FAttempt: Integer;
    FOnFormShow: TNotifyEvent;
    FOnOkClick: TNotifyEvent;
  public
    { Public declarations }
    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): TRxLoginForm;

implementation

uses {$IFDEF WIN32} Registry, {$ENDIF} IniFiles, AppUtils, RxDConst,
  Consts, VclUtils, RxConst;

{$R *.DFM}

const
  keyLoginSection  = 'Login Dialog';
  keyLastLoginUserName = 'Last Logged User';

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

{ TRxCustomLogin }

constructor TRxCustomLogin.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIniFileName := EmptyStr;
  FLoggedUser := EmptyStr;
  FActive := True;
  FAttemptNumber := 3;
  FAllowEmpty := True;
  FUseRegistry := False;
end;

destructor TRxCustomLogin.Destroy;
begin
  if FLocked then begin
    Application.UnhookMainWindow(UnlockHook);
    FLocked := False;
  end;
  //DisposeStr(FLoggedUser);
  //DisposeStr(FIniFileName);
  inherited Destroy;
end;

function TRxCustomLogin.GetIniFileName: string;
begin
  Result := FIniFileName;
  if (Result = '') and not (csDesigning in ComponentState) then begin
{$IFDEF WIN32}
    if UseRegistry then Result := GetDefaultIniRegKey
    else Result := GetDefaultIniName;
{$ELSE}
    Result := GetDefaultIniName;
{$ENDIF}
  end;
end;

procedure TRxCustomLogin.SetIniFileName(const Value: string);
begin
  FIniFileName := Value;
end;

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

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

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

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

procedure TRxCustomLogin.DoIconDblCLick(Sender: TObject);
begin
  if Assigned(FOnIconDblClick) then FOnIconDblClick(Self);
end;

procedure TRxCustomLogin.DoUpdateCaption;
var
  F: TForm;
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 TRxCustomLogin.Login: Boolean;
var
  LoginName: string;
begin
  LoginName := EmptyStr;
  DoBeforeLogin;
  Result := DoLogin(LoginName);
  if Result then begin
    SetLoggedUser(LoginName);
    DoUpdateCaption;
    DoAfterLogin;
  end;
end;

procedure TRxCustomLogin.Lock;
begin
  FSaveOnRestore := Application.OnRestore;
  Application.Minimize;
  Application.HookMainWindow(UnlockHook);
  FLocked := True;
end;

procedure TRxCustomLogin.TerminateApplication;
begin
  with Application do begin
{$IFDEF WIN32}
    ShowMainForm := False;
{$ENDIF}
    if Handle <> 0 then ShowOwnedPopups(Handle, False);
    Terminate;
  end;
{$IFDEF RX_D3}
  CallTerminateProcs;
{$ENDIF}
{$IFNDEF RX_D3}
  Halt(10);
{$ENDIF}
end;