security.pas

TSecurity提供登陆/注销/修改口令的控件。(有源代码）工作在：D1 D2 D3 D4 D5。作者：Ma Jun

unit Security;
{

TSecurity
Version 1.0
by Ma Jun

email:[e-mail]
home page:http://go.163.com/~delphiws (in chinese)

  You are free to use TSecurity for any purpose. If you do some
  modification, please let me know.

}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TValidatePasswordEvent = function(Sender:TComponent; varUserID:String):String of Object; //由varUserID返回对应的密码(加密状态)

type
  TSecurity = class(TComponent)
  private
    // Information about current user
    FUserID   : String;
    FUserName : String;
    FPassword : String;     // Password in Crypted mode
    FUserList : TStrings;
    FLoginLimits : Integer; // Max value for user login input
    FLoginCaption: String;  // label's caption for login form
    FPasswordKey : String;

    FOnUserChanged : TNotifyEvent;
    FOnPasswordChange : TNotifyEvent;
    FOnGetUsers   : TNotifyEvent;
    FOnValidatePassword : TValidatePasswordEvent;

    function  GetPassword:String;
    procedure SetPassword(aValue:String);
    procedure SerUserList(aValue:TStrings);

  protected
    // virtual methode for future purpose
    procedure UserChanged; virtual;
    procedure PasswordChanged; virtual;
    procedure GetUserList; virtual;

  public
    function  Login : Boolean; virtual;
    procedure Logout; virtual;
    procedure ModifyPassword;
    function  ValidatePassword(varID, varPassword:String): Boolean; virtual; // varPassword is not Crypted

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    property UserID :  String read FUserID write FUSerID;
    property UserName: String read FUserName write FUserName;
    property Password: String read GetPassword write SetPassword;

  published
    property LoginCaption : String read FLoginCaption write FLoginCaption;
    property Key : String read FPasswordKey write FPasswordKey;
    property LoginLimits : Integer read FLoginLimits write FLoginLimits default 3;
    property UserList : TStrings read FUserList write SerUserList;
    property OnUserChanged : TNotifyEvent read FOnUserChanged write FOnUserChanged;
    property OnPasswordChanged : TNotifyEvent read FOnPasswordChange write FOnPasswordChange;
    property OnValidatePassword : TValidatePasswordEvent read FOnValidatePassword write FOnValidatePassword;
    property OnGetUsers : TNotifyEvent read FOnGetUsers write FOnGetUsers;
  end;

//  Crypt procedure from DSP,   Action='D' as Crypt, 'E' as Decypt 
function Crypt(Action, Src, Key : String) : String;

procedure Register;

implementation

uses loginfm, modipass;

procedure Register;
begin
  RegisterComponents('Ma Jun', [TSecurity]);
end;

function Crypt(Action, Src, Key : String) : String;
var
   KeyLen    : Integer;
   KeyPos    : Integer;
   offset    : Integer;
   dest      : string;
   SrcPos    : Integer;
   SrcAsc    : Integer;
   TmpSrcAsc : Integer;
   Range     : Integer;
begin
     dest:='';
     KeyLen:=Length(Key);
     KeyPos:=0;
     SrcPos:=0;
     SrcAsc:=0;
     Range:=256;
     if Action = UpperCase('E') then
     begin
          Randomize;
          offset:=Random(Range);
          dest:=format('%1.2x',[offset]);
          for SrcPos := 1 to Length(Src) do
          begin
               SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
               if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
               SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
               dest:=dest + format('%1.2x',[SrcAsc]);
               offset:=SrcAsc;
          end;
     end;
     if Action = UpperCase('D') then
     begin
          offset:=StrToInt('$'+ copy(src,1,2));
          SrcPos:=3;
          repeat
                SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
                if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
                TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
                if TmpSrcAsc <= offset then
                     TmpSrcAsc := 255 + TmpSrcAsc - offset
                else
                     TmpSrcAsc := TmpSrcAsc - offset;
                dest := dest + chr(TmpSrcAsc);
                offset:=srcAsc;
                SrcPos:=SrcPos + 2;
          until SrcPos >= Length(Src);
     end;
     Result:=dest;
end;


{ TSecurity }
constructor TSecurity.Create(AOwner: TComponent);
begin
  inherited;
  FPassword := '';
  FUserID   := '';
  FUserName := '';
  FPasswordKey := 'k#1,hRq8]gF%';
  FUserList := TStringList.Create;
  FLoginLimits := 3;
end;

destructor TSecurity.Destroy;
begin
  inherited;
  FUserList.Free;
end;

function TSecurity.GetPassword: String;
begin
  if FPassword<>'' then Result := Crypt('D', FPassword, FPasswordKey)
                   else Result := '';
end;

procedure TSecurity.GetUserList;
begin
  if Assigned(OnGetUsers) then OnGetUsers(Self);
end;

function TSecurity.Login:Boolean;
var
  mOldID : String;
begin
  Result := False;
  SecurityLoginDialog := TSecurityLoginDialog.Create(Self);
  GetUserList;
  with SecurityLoginDialog do
  begin
    InputLimits := FLoginLimits;
    LabelTitle.Caption := FLoginCaption;
    User.Items.Assign(FUserList);
    if ShowModal=mrOK then
    begin
      mOldID   := UserID;
      UserID   := InputUserID;
      UserName := InputUserName;
      Password := EditPassword.Text;
      if (mOldID<>UserID) and Assigned(FOnUserChanged) then FOnUserChanged(Self);
      Result := True;
    end;
  end;
  SecurityLoginDialog.Free;
end;

procedure TSecurity.Logout;
begin
  FPassword := '';
  FUserID   := '';
  FUserName := '';
  UserChanged;
end;

procedure TSecurity.ModifyPassword;
var
  mOldPass : String;
begin
  if UserID='' then Exit;
  PassModifyDialog := TPassModifyDialog.Create(Self);
  try
    with PassModifyDialog do
    begin
      if ShowModal=mrOK then
      begin
        mOldPass := EditOldPS.Text;
        if not ValidatePassword(UserID, mOldPass) then
           raise Exception.Create('Old Password error!');
        if (EditNewPS.Text<>EditRetryNewPS.Text) then
           raise Exception.Create('The new password was not same!');
        Password := EditNewPS.Text;
        if (mOldPass<>Password) then PasswordChanged;
      end;
    end;
  finally
    PassModifyDialog.Free;
  end;
end;

procedure TSecurity.PasswordChanged;
begin
  if Assigned(FOnPasswordChange) then FOnPasswordChange(Self);
end;

procedure TSecurity.SerUserList(aValue: TStrings);
begin
  FUserList.Assign(aValue);
end;

procedure TSecurity.SetPassword(aValue: String);
begin
  FPassword := Crypt('E', aValue, FPasswordKey);
end;

procedure TSecurity.UserChanged;
begin
  if Assigned(FOnUserChanged) then FOnUserChanged(Self);
end;

function TSecurity.ValidatePassword(varID, varPassword:String): Boolean;
var
  mTruePS : String;
begin
  mTruePS := '';
  Result := False;
  if Assigned(OnValidatePassword) then
  begin
    mTruePS := OnValidatePassword(Self, varID);
    if (varPassword=mTruePS)  then Result := True;
  end;
end;

end.