{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{                                                       }
{*******************************************************}

unit LoginDlg;

{$I RX.INC}

interface

uses
  SysUtils, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DB, DBTables, Buttons;

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

  TDialogMode = (dmAppLogin, dmDBLogin, dmUnlock);

  TRxLoginForm = class(TForm)
    AppIcon: TImage;
    KeyImage: TImage;
    HintLabel: TLabel;
    UserNameLabel: TLabel;
    PasswordLabel: TLabel;
    UserNameEdit: TEdit;
    PasswordEdit: TEdit;
    AppTitleLabel: TLabel;
    OkBtn: TButton;
    CancelBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure OkBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FAttempt: Integer;
    FMode: TDialogMode;
    FUseRegistry: Boolean;
    FIniFileName: string;
    {I moved this here so that the original OnLogin gets called}
    SaveLogin: TLoginEvent;
    procedure Login(Database: TDatabase; LoginParams: TStrings);
    function GetUserInfo: Boolean;
    function CheckUser(Table: TTable): Boolean; dynamic;
    function CheckUnlock: Boolean; dynamic;
  public
    { Public declarations }
    Database: TDatabase;
    AttemptNumber: Integer;
    UsersTableName: string;
    UserNameField: string;
    OnCheckUser: TCheckUserNameEvent;
    OnCheckUnlock: TCheckUnlockEvent;
    function GetUserName: string;
    function CheckDatabaseChange: Boolean;
    procedure FillParams(LoginParams: TStrings);
  end;

function LoginDialog(Database: TDatabase; AttemptNumber: Integer;
  const UsersTableName, UserNameField: string; MaxPwdLen: Integer;
  CheckUserEvent: TCheckUserNameEvent; var LoginName: string;
  var LoginPassword: string;
  const IniFileName: string; UseRegistry: Boolean): Boolean;

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

function UnlockDialog(const UserName: string;
  OnUnlock: TCheckUnlockEvent): Boolean;

implementation

uses {$IFDEF WIN32} Windows, Registry, BDE, {$ELSE} WinTypes, WinProcs,
  DbiTypes, {$ENDIF} IniFiles, AppUtils, RxDConst, Consts, VCLUtils;

{$R *.DFM}

const
  keyLastLoginUserName = 'LastUser';

{ LoginDialog }

var
  LoginFormStyle: TFormStyle;

procedure OnLoginDialog(Database: TDatabase; LoginParams: TStrings;
  AttemptNumber: Integer; ShowDBName: Boolean);
var
  LoginForm: TRxLoginForm;
  SaveCursor: TCursor;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crDefault;
  try
    LoginFormStyle := fsStayOnTop;
    LoginForm := TRxLoginForm.Create(Application);
    try
      LoginForm.Database := Database;
      LoginForm.AttemptNumber := AttemptNumber;
      LoginForm.FMode := dmDBLogin;
      if ShowDBName then
        LoginForm.AppTitleLabel.Caption := FmtLoadStr(SDatabaseName,
          [Database.DatabaseName]);
      LoginForm.UserNameEdit.Text := LoginParams.Values[szUSERNAME];
      if LoginForm.ShowModal = mrOk then begin
        LoginForm.FillParams(LoginParams);
      end
      else SysUtils.Abort;
    finally
      LoginForm.Free;
    end;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

function LoginDialog(Database: TDatabase; AttemptNumber: Integer;
  const UsersTableName, UserNameField: string; MaxPwdLen: Integer;
  CheckUserEvent: TCheckUserNameEvent; var LoginName: string;
  var LoginPassword: string;
  const IniFileName: string; UseRegistry: Boolean): Boolean;
var
  LoginForm: TRxLoginForm;
  SaveCursor: TCursor;
  Ini: TObject;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crDefault;
  try
    LoginFormStyle := fsStayOnTop;
    LoginForm := TRxLoginForm.Create(Application);
    try
      LoginForm.FUseRegistry := UseRegistry;
      LoginForm.FIniFileName := IniFileName;
      try
{$IFDEF WIN32}
        if UseRegistry then Ini := TRegIniFile.Create(IniFileName)
        else Ini := TIniFile.Create(IniFileName);
{$ELSE}
        Ini := TIniFile.Create(IniFileName);
{$ENDIF WIN32}
        try
          LoginForm.UserNameEdit.Text := IniReadString(Ini, LoginForm.ClassName,
            keyLastLoginUserName, LoginName);
        finally
          Ini.Free;
        end;
      except
        LoginForm.FIniFileName := '';
      end;
      LoginForm.Database := Database;
      LoginForm.AttemptNumber := AttemptNumber;
      LoginForm.FMode := dmAppLogin;
      LoginForm.UsersTableName := UsersTableName;
      LoginForm.UserNameField := UserNameField;
      LoginForm.PasswordEdit.MaxLength := MaxPwdLen;
      LoginForm.OnCheckUser := CheckUserEvent;
      Result := (LoginForm.ShowModal = mrOk);
      if Result then begin
        LoginName := LoginForm.GetUserName;
        LoginPassword := LoginForm.PasswordEdit.text;
      end;
    finally
      LoginForm.Free;
    end;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

function UnlockDialog(const UserName: string;
  OnUnlock: TCheckUnlockEvent): Boolean;
var
  LoginForm: TRxLoginForm;
  SaveCursor: TCursor;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crDefault;
  try
    LoginFormStyle := fsNormal;
    LoginForm := TRxLoginForm.Create(Application);
    try
      LoginForm.FMode := dmUnlock;
      LoginForm.UserNameEdit.Text := UserName;
      LoginForm.UserNameEdit.ReadOnly := True;
      LoginForm.UserNameEdit.Font.Color := clGrayText;
      LoginForm.OnCheckUnlock := OnUnlock;
      Result := (LoginForm.ShowModal = mrOk);
    finally
      LoginForm.Free;
    end;
  finally
    Screen.Cursor := SaveCursor;
  end;
end;

{ TRxLoginForm }

procedure TRxLoginForm.FormCreate(Sender: TObject);
begin
  FormStyle := LoginFormStyle;
  Icon := Application.Icon;
  if Icon.Empty then
    Icon.Handle := LoadIcon(0, IDI_APPLICATION);
  AppIcon.Picture.Assign(Icon);
  AppTitleLabel.Caption := FmtLoadStr(SAppTitleLabel, [Application.Title]);
  PasswordLabel.Caption := LoadStr(SPasswordLabel);
  UserNameLabel.Caption := LoadStr(SUserNameLabel);
  OkBtn.Caption := ResStr(SOKButton);
  CancelBtn.Caption := ResStr(SCancelButton);
end;

procedure TRxLoginForm.FormDestroy(Sender: TObject);
var
  Ini: TObject;
begin
  if FMode <> dmAppLogin then Exit;
  Database.OnLogin := nil;
  if FIniFileName <> '' then begin
{$IFDEF WIN32}
    if FUseRegistry then Ini := TRegIniFile.Create(FIniFileName)
    else Ini := TIniFile.Create(FIniFileName);
{$ELSE}
    Ini := TIniFile.Create(FIniFileName);
{$ENDIF WIN32}
    try
      IniWriteString(Ini, Self.ClassName, keyLastLoginUserName, GetUserName);
    finally
      Ini.Free;
    end;
  end;
end;

procedure TRxLoginForm.Login(Database: TDatabase; LoginParams: TStrings);
begin
  FillParams(LoginParams);
  {if Assigned(SaveLogin) then SaveLogin(Database,LoginParams);}
end;

function TRxLoginForm.CheckUser(Table: TTable): Boolean;
begin
  if Assigned(OnCheckUser) then
    Result := OnCheckUser(Table, GetUserName, PasswordEdit.Text)
  else Result := True;
end;

function TRxLoginForm.CheckDatabaseChange: Boolean;
begin
  Result := (Pos('@', UserNameEdit.Text) > 0) and
    ((Database.DriverName <> '') and
    (CompareText(Database.DriverName, szCFGDBSTANDARD) <> 0));
end;

procedure TRxLoginForm.FillParams(LoginParams: TStrings);
begin
  LoginParams.Values[szUSERNAME] := GetUserName;
  LoginParams.Values['PASSWORD'] := PasswordEdit.Text;
  if CheckDatabaseChange then begin
    LoginParams.Values[szSERVERNAME] :=
      Copy(UserNameEdit.Text, Pos('@', UserNameEdit.Text) + 1, MaxInt)
  end;
end;

function TRxLoginForm.GetUserName: string;
begin
  if CheckDatabaseChange then
    Result := Copy(UserNameEdit.Text, 1, Pos('@', UserNameEdit.Text) - 1)
  else
    Result := UserNameEdit.Text;
end;

function TRxLoginForm.GetUserInfo: Boolean;
var
  Table: TTable;
begin
  if UsersTableName = '' then Result := CheckUser(nil)
  else begin
    Result := False;
    Table := TTable.Create(Self);
    try
      try
        Table.DatabaseName := Database.DatabaseName;
{$IFDEF WIN32}
        Table.SessionName := Database.SessionName;
{$ENDIF}
        Table.TableName := UsersTableName;
        Table.IndexFieldNames := UserNameField;
        Table.Open;
        if Table.FindKey([GetUserName]) then begin
          Result := CheckUser(Table);
          if not Result then
            raise EDatabaseError.Create(LoadStr(SInvalidUserName));
        end
        else raise EDatabaseError.Create(LoadStr(SInvalidUserName));
      except
        Application.HandleException(Self);
      end;
    finally
      Table.Free;
    end;
  end;
end;

procedure TRxLoginForm.OkBtnClick(Sender: TObject);
var
  Ok: Boolean;
  SetCursor: Boolean;
begin
  if FMode = dmDBLogin then begin
    ModalResult := mrOk;
    Exit;
  end
  else if FMode = dmUnlock then begin
    Ok := False;
    try
      Ok := CheckUnlock;
    except
      Application.HandleException(Self);
    end;
    if Ok then
      ModalResult := mrOk
    else
      ModalResult := mrCancel;
    Exit;
  end;
{$IFDEF WIN32}
  SetCursor := GetCurrentThreadID = MainThreadID;
{$ELSE}
  SetCursor := True;
{$ENDIF}
  SaveLogin := Database.OnLogin;
  try
    Inc(FAttempt);
    try
      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 ModalResult := mrOk
    else begin
      ModalResult := mrNone;
      Database.Close;
    end;
  finally
    if SetCursor then Screen.Cursor := crDefault;
  end;
  if (ModalResult <> mrOk) and (FAttempt >= AttemptNumber) then
    ModalResult := mrCancel;
end;

procedure TRxLoginForm.FormShow(Sender: TObject);
begin
  if FMode in [dmAppLogin, dmDBLogin] then begin
    HintLabel.Caption := LoadStr(SHintLabel);
    Caption := LoadStr(SRegistration);
  end
  else begin
    HintLabel.Caption := LoadStr(SUnlockHint);
    Caption := LoadStr(SUnlockCaption);
  end;
  if UserNameEdit.Text = EmptyStr then ActiveControl := UserNameEdit
  else ActiveControl := PasswordEdit;
end;

function TRxLoginForm.CheckUnlock: Boolean;
begin
  if Assigned(OnCheckUnlock) then
    Result := OnCheckUnlock(PasswordEdit.Text)
  else
    Result := True;
end;

end.
