loginf.pas

极具实用价值的文件管理系统

{ *********************************************************************** }
{ Unit Name: LoginF
{ Purpose: System Login Form
{ Author: Cyclone
{ History:
{         2005-3-19 17:50:24 Create the function
{ *********************************************************************** }

unit LoginF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, CycPanel, ExtCtrls, ShellApi, Pubfuns, jpeg,
  CycSpeedButton, BaseF, DB, ADODB, IniFiles, CycLabeledEdit, CycLabel,
  ComCtrls, CycLabeledLookupEdit;

type
  TfmLogin = class(TfmBase)
    pnlTitle: TCycPanel;
    pnlMain: TCycPanel;
    Panel1: TPanel;
    ImgSystem: TImage;
    adcLogin: TADOConnection;
    dsSystemUser: TADODataSet;
    dsSystemUserUserId: TWideStringField;
    dsSystemUserPassword: TWideStringField;
    btnLogin: TCycSpeedButton;
    btnExit: TCycSpeedButton;
    edtPassword: TCycLabeledEdit;
    edtUserName: TCycLabeledEdit;
    cbxDatabase: TComboBox;
    CycLabel1: TCycLabel;
    btnConfiguration: TCycSpeedButton;
    pnlDatabaseConnect: TPanel;
    CycPanel2: TCycPanel;
    btnConnect: TCycSpeedButton;
    btnCancel: TCycSpeedButton;
    edtDBServer: TEdit;
    edtDBDatabase: TEdit;
    edtDBUser: TEdit;
    edtDBPassword: TEdit;
    cbxDatabaseType: TComboBox;
    CycLabel2: TCycLabel;
    Label3: TCycLabel;
    Label5: TCycLabel;
    Label6: TCycLabel;
    lblWebSite: TCycLabel;
    lblEmail: TCycLabel;
    Label1: TCycLabel;
    lblServer: TCycLabel;
    lblDatabaseName: TCycLabel;
    lblUser: TCycLabel;
    lblPassword: TCycLabel;
    edtDBDatabaseFilename: TCycLabeledLookupEdit;
    OpenDialog: TOpenDialog;
    btnClose: TCycSpeedButton;
    Panel2: TPanel;
    procedure pnlTitleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lblWebSiteClick(Sender: TObject);
    procedure lblEmailClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnLoginClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure cbxDatabaseTypeChange(Sender: TObject);
    procedure edtDatabaseFilenameSubButtonClick(Sender: TObject);
    procedure btnConfigurationClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnCloseClick(Sender: TObject);
  private
    { Private declarations }
    procedure  MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure  MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    function ConnectDatabase(const DatabaseType: TDatabaseType;
      const DBServerName, DBName, DBUserName, DBPassword, AccessFilename: String): Boolean;
  public
    { Public declarations }
  end;

var
  fmLogin: TfmLogin;

implementation

uses Math;

{$R *.dfm}

procedure TfmLogin.MouseEnter(var Msg: TMessage);
var
  Obj: TObject;
begin
  Obj := TObject(Msg.LParam);
  if Obj = lblWebSite then
  begin
    Screen.Cursor := crHandPoint;
    lblWebSite.Font.Color := clBlue;
    lblWebSite.Font.Style := lblWebSite.Font.Style + [fsUnderline];
  end
  else if Obj = lblEmail then
  begin
    Screen.Cursor := crHandPoint;
    lblEmail.Font.Color := clBlue;
    lblEmail.Font.Style := lblWebSite.Font.Style + [fsUnderline];
  end;
end;

procedure TfmLogin.MouseLeave(var Msg: TMessage);
var
  Obj: TObject;
begin
  Obj := TObject(Msg.LParam);
  if Obj = lblWebSite then
  begin
    Screen.Cursor := crDefault;
    lblWebSite.Font.Color := clWindowText;
    lblWebSite.Font.Style := lblWebSite.Font.Style - [fsUnderline];
  end
  else if Obj = lblEmail then
  begin
    Screen.Cursor := crDefault;
    lblEmail.Font.Color := clWindowText;
    lblEmail.Font.Style := lblWebSite.Font.Style - [fsUnderline];
  end;
end;

procedure TfmLogin.pnlTitleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TfmLogin.lblWebSiteClick(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', Pchar(lblWebSite.Caption), '', '', SW_SHOWNORMAL);
end;

procedure TfmLogin.lblEmailClick(Sender: TObject);
begin
  ShellExecute(Handle, 'OPEN', Pchar('MailTo:' + lblEmail.Caption), '', '', SW_SHOWNORMAL);
end;

procedure TfmLogin.FormCreate(Sender: TObject);
begin
  inherited;
  ReadConnectionInformation;
  edtDBDatabaseFilename.Left := edtDBDatabase.Left;
  edtDBDatabaseFilename.Top := edtDBDatabase.Top;
  edtDBDatabaseFilename.EditLabel.Caption := '';
  pnlDatabaseConnect.Visible := False;
  pnlDatabaseConnect.Left := pnlMain.Left;
  pnlDatabaseConnect.Top := pnlMain.Top;
  pnlDatabaseConnect.Width := pnlMain.Width;
  pnlDatabaseConnect.Height := pnlMain.Height;
  pnlTitle.Caption := pSystemName + ' Login';
  lblWebSite.Caption := pCompanyWebSite;
  lblEmail.Caption := pCompanyEmail;
  cbxDatabase.ItemIndex := Ord(pDatabaseType);
  edtUserName.Text := GetLocalComputerName;
end;

{-----------------------------------------------------------------------------
  Procedure: TfmLogin.ConnectDatabase
  Purpose:   Connect Database
  Arguments: None
  Result:    Boolean
  Author:    Cyclone   
  Date:      2005-3-19 16:46:42

-----------------------------------------------------------------------------}
function TfmLogin.ConnectDatabase(const DatabaseType: TDatabaseType;
  const DBServerName, DBName, DBUserName, DBPassword, AccessFilename: String): Boolean;
begin
  Result := True;
  if adcLogin.Connected then
    adcLogin.Connected := False;
  if DatabaseType = dtAccess then
    adcLogin.ConnectionString := GetAccessConnectionString(AccessFileName)
  else
    adcLogin.ConnectionString := GetSQLServerConnectionString(DBServerName, DBName, DBUserName, DBPassword);
  try
    adcLogin.Open;
  except
    ShowError('Database connection fail!');
    Result := False;
  end;
end;

procedure TfmLogin.btnLoginClick(Sender: TObject);
begin
  if Trim(edtUserName.Text) = '' then
  begin
    ShowError('User name cannot be empty!');
    edtUserName.SetFocus;
    Exit;
  end;
  if not ConnectDatabase(pDatabaseType, pDBServerName, pDBName, pDBUserName, pDBPassword, pAccessFileName) then
  begin
    btnConfiguration.Click;
    Exit;
  end;
  pSysUserId := edtUserName.Text;
  with dsSystemUser do
  begin
    Close;
    Parameters.ParamByName('UserId').Value := pSysUserId;
    Open;
    if IsEmpty then
    begin
      if pSysUserId = GetLocalComputerName then
      begin
        if ShowYesNo('User name not exist, add this user name?') then
        begin
          pSysUserPassword := Encrypt('888', PassContext);
          AppendRecord([pSysUserId, pSysUserPassword]);
          ShowInformation('Your initial password is: ''888''');
        end
        else
          Exit;
      end else
      begin
        ShowError('User name not exist, try again!');
        edtUserName.SelectAll;
        edtUserName.SetFocus;
        Exit;
      end;
    end else
    begin
      pSysUserPassword := FieldByName('Password').AsString;
      if Decrypt(pSysUserPassword, PassContext) <> edtPassword.Text then
      begin
        ShowError('Password is wrong, try again!');
        edtPassword.SelectAll;
        edtPassword.SetFocus;
        Exit;
      end;
    end;
  end;
  ModalResult := mrOK;
end;

procedure TfmLogin.btnExitClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfmLogin.cbxDatabaseTypeChange(Sender: TObject);
begin
  lblServer.Visible := cbxDatabaseType.ItemIndex = 1;
  edtDBServer.Visible := cbxDatabaseType.ItemIndex = 1;
  edtDBDatabase.Visible := cbxDatabaseType.ItemIndex = 1;
  edtDBDatabaseFilename.Visible := cbxDatabaseType.ItemIndex = 0;
  lblUser.Visible := cbxDatabaseType.ItemIndex = 1;
  edtDBUser.Visible := cbxDatabaseType.ItemIndex = 1;
  lblPassword.Visible := cbxDatabaseType.ItemIndex = 1;
  edtDBPassword.Visible := cbxDatabaseType.ItemIndex = 1;
end;

procedure TfmLogin.edtDatabaseFilenameSubButtonClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    edtDBDatabaseFilename.Text := OpenDialog.FileName;
end;

procedure TfmLogin.btnConfigurationClick(Sender: TObject);
begin
  edtDBServer.Text := pDBServerName;
  edtDBDatabase.Text := pDBName;
  edtDBUser.Text := pDBUserName;
  edtDBPassword.Text := pDBPassword;
  edtDBDatabaseFilename.Text := pAccessFileName;
  cbxDatabaseType.ItemIndex := cbxDatabase.ItemIndex;
  cbxDatabaseType.OnChange(cbxDatabaseType);
  pnlTitle.Caption := pSystemName + ' Configuration';
  pnlDatabaseConnect.Visible := True;
  if edtDBServer.Visible then
    edtDBServer.SetFocus
  else
    edtDBDatabaseFilename.SetFocus;
end;

procedure TfmLogin.btnConnectClick(Sender: TObject);
begin
  if not ConnectDatabase(TDatabaseType(cbxDatabaseType.ItemIndex), edtDBServer.Text, edtDBDatabase.Text, edtDBUser.Text, edtDBPassword.Text, edtDBDatabaseFilename.Text) then
  begin
    if edtDBServer.Visible then
      edtDBServer.SetFocus
    else
      edtDBDatabaseFilename.SetFocus;
    Exit;
  end;
  pDBServerName := edtDBServer.Text;
  pDBName := edtDBDatabase.Text;
  pDBUserName := edtDBUser.Text;
  pDBPassword := edtDBPassword.Text;
  pAccessFileName := edtDBDatabaseFilename.Text;
  pDatabaseType := TDatabaseType(cbxDatabaseType.ItemIndex);
  cbxDatabase.ItemIndex := cbxDatabaseType.ItemIndex;
  pnlTitle.Caption := pSystemName + ' Login';
  pnlDatabaseConnect.Visible := False;
  edtUserName.SetFocus;
end;

procedure TfmLogin.btnCancelClick(Sender: TObject);
begin
  pnlTitle.Caption := pSystemName + ' Login';
  pnlDatabaseConnect.Visible := False;
  edtUserName.SetFocus;
end;

procedure TfmLogin.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then //ENTER
  begin
    if ActiveControl = edtPassword then
      btnLogin.Click
    else if ActiveControl = edtDBPassword then
      btnConnect.Click
    else if ActiveControl = edtDBDatabaseFilename then
      btnConnect.Click
    else
      inherited;
  end
  else
    inherited;
end;

procedure TfmLogin.btnCloseClick(Sender: TObject);
begin
  if pnlDatabaseConnect.Visible then
    btnCancel.Click
  else
    btnExit.Click;
end;

end.