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

unit DBSecur;

interface

{$I RX.INC}
{$T+}

{$IFDEF WIN32}
uses SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DB, DBTables, LoginDlg, ChPswDlg,   EZDSLCts in 'EZDSLCTS.PAS',
  EZDSLBse in 'EZDSLBSE.PAS',
  ezdslbtr in 'ezdslbtr.pas',
  EZDSLSup in 'EZDSLSUP.PAS';
{$ELSE}
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DB, DBTables, LoginDlg, ChPswDlg,  EZDSLCts,
  EZDSLBse,
  ezdslbtr,
  EZDSLSup;
{$ENDIF}

type

{ TDBSecurity }

  TUpdateCaption = (ucNoChange, ucAppTitle, ucFormCaption);
  TCheckUserEvent = function(UsersTable: TTable;
    const Password: string): Boolean of object;

   TableSecurityPtr=^TableSecurityRec;
   TableSecurityRec=record
      TableName : string[60];
      SelectAuthority,
      UpdateAuthority,
      InsertAuthority,
      DeleteAuthority,
      UpdColSecurity:boolean; {if the user can update only certain columns}
    end;


  {TTableSecurityEvent = procedure;
  {TLoadColumnSecurity = procedure(ColumnSecurity:TColumnSecurity;
   const DataBase: TDataBase);}


  TDBSecurity = class(TComponent)
  private
    FActive: Boolean;
    FAttemptNumber: Integer;
    FDatabase: TDatabase;
    FUsersTableName: TFileName;
    FLoginNameField: PString;
    FLoggedUser: PString;
    FMaxPasswordLen: Integer;
    FAllowEmpty: Boolean;
    FUpdateCaption: TUpdateCaption;
    FIniFileName: PString;
    FUseRegistry: Boolean;
    FLocked: Boolean;
    FUnlockDlgShowing: Boolean;
    FPassword: string;
    FSaveOnRestore: TNotifyEvent;
    FOnCheckUser: TCheckUserEvent;
    FAfterLogin: TNotifyEvent;
    FOnChangePassword: TChangePasswordEvent;
    FOnUnlock: TCheckUnlockEvent;

   BSTreeTable : TBinSearchTree;
   FTablePtr : TableSecurityPtr;
	FSearchTablePtr : TableSecurityPtr;
   FUseTableSecurity: boolean;
   FOnTableSecurity: TNotifyEvent;

   BSTreeColumn : TBinSearchTree;
   FUseColumnSecurity: boolean;
   FOnColumnSecurity: TNotifyEvent;

	BSTreeStorProc : TBinSearchTree;
	FUseStorProcSecurity: boolean;
	FOnStorProcSecurity: TNotifyEvent;

   FUNCTION  CanSelect:boolean;
   function CanUpdate:boolean;
   function CanDelete:boolean;
   function CanInsert:boolean;
	function HasUpdColumns: boolean;



    procedure SetDatabase(Value: TDatabase);
    procedure SetUsersTableName(const Value: TFileName);
    function GetLoginNameField: string;
    procedure SetLoginNameField(const Value: string);
    function GetLoggedUser: string;
    procedure SetLoggedUser(const Value: string);
    function GetIniFileName: string;
    procedure SetIniFileName(const Value: string);
    function UnlockHook(var Message: TMessage): Boolean;
  protected
    procedure DoAfterLogin; dynamic;
    function DoCheckUser(UsersTable: TTable; const UserName,
      Password: string): Boolean; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
    PROCEDURE GetTableSecurity;
    procedure GetColumnSecurity;
	 procedure GetStorProcSecurity;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Login: Boolean;
    function ChangePassword: Boolean;
    procedure Lock;

	 procedure InsertTable( sTableName:string;bSelectAuthority,
      bInsertAuthority,bDeleteAuthority,bUpdateAuthority,bUpdColSecurity:boolean);
	 procedure InsertColumn( sColumnName :string);
	 procedure InsertStorProc(sStorProc: string);
    function TableExists( search:string):boolean;
	 function ColumnExists( search:string):boolean;
	 function StorProcExists(search:string):boolean;
    property TableSelect : boolean read CanSelect;
     property TableUpdate: boolean read CanUpdate;
    property TableDelete: boolean read CanDelete;
    property TableInsert: boolean read CanInsert;
    property TableUpdateColumns: boolean read HasUpdColumns;

    property LoggedUser: string read GetLoggedUser;
    property Password: string read FPassword;
  published
    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 Database: TDatabase read FDatabase write SetDatabase;
    property IniFileName: string read GetIniFileName write SetIniFileName;
    property LoginNameField: string read GetLoginNameField write SetLoginNameField;
    property MaxPasswordLen: Integer read FMaxPasswordLen write FMaxPasswordLen default 0;
    property UpdateCaption: TUpdateCaption read FUpdateCaption write FUpdateCaption default ucNoChange;
{$IFDEF WIN32}
    property UseRegistry: Boolean read FUseRegistry write FUseRegistry default False;
{$ENDIF WIN32}
   property UseColumnSecurity: boolean read FUseColumnSecurity write FUseColumnSecurity;
	property UseStorProcSecurity: boolean read FUseStorProcSecurity write FUseStorProcSecurity;
   property UseTableSecurity: boolean read FUseTableSecurity write FUseTableSecurity;
    property UsersTableName: TFileName read FUsersTableName write SetUsersTableName;
    property AfterLogin: TNotifyEvent read FAfterLogin write FAfterLogin;
    property OnCheckUser: TCheckUserEvent read FOnCheckUser write FOnCheckUser;
    property OnChangePassword: TChangePasswordEvent read FOnChangePassword
      write FOnChangePassword;
    property OnLoadTableSecurity: TNotifyEvent read FOnTableSecurity
      write FOnTableSecurity;
    property OnLoadColumnSecurity: TNotifyEvent read FOnColumnSecurity
      write FOnColumnSecurity;
	 property OnLoadStorProcSecurity: TNotifyEvent read FOnStorProcSecurity
		write FOnStorProcSecurity;
    property OnUnlock: TCheckUnlockEvent read FOnUnlock write FOnUnlock;
  end;

function TableCompare(Data1, Data2 : pointer) : integer; far;
procedure TableDisposeData(aData : pointer); far;

implementation

uses AppUtils, VCLUtils;

{ TDBSecurity }

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

destructor TDBSecurity.Destroy;
begin
  DisposeStr(FLoggedUser);
  DisposeStr(FLoginNameField);
  DisposeStr(FIniFileName);
  {free the table security pointers if assigned}
  if FSearchTablePtr <> nil then freemem(FSearchTablePtr,sizeof(TableSecurityRec));
  if BSTreeTable <> nil then BSTreeTable.free;
  if BSTreeColumn <> nil then BSTreeColumn.free;
  if BSTreeStorProc <> nil then BSTreeStorProc.free;
  inherited Destroy;
end;

procedure TDBSecurity.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Database) then Database := nil;
end;

procedure TDBSecurity.Loaded;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) and Active and
    (Database <> nil) then
  begin
    Database.LoginPrompt := True;
    if not Login then begin
      with Application do begin
        Terminate;
        if Handle <> 0 then ShowOwnedPopups(Handle, False);
      end;
      Halt(10);
    end;
  end;
end;

procedure TDBSecurity.SetDatabase(Value: TDatabase);
begin
  if FDatabase <> Value then begin
    FDatabase := Value;
{$IFDEF WIN32}
    if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
  end;
end;

procedure TDBSecurity.SetUsersTableName(const Value: TFileName);
begin
  if FUsersTableName <> Value then
    FUsersTableName := Value;
end;

function TDBSecurity.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 TDBSecurity.SetIniFileName(const Value: string);
begin
  AssignStr(FIniFileName, Value);
end;

function TDBSecurity.GetLoginNameField: string;
begin
  Result := FLoginNameField^;
end;

procedure TDBSecurity.SetLoginNameField(const Value: string);
begin
  AssignStr(FLoginNameField, Value);
end;

function TDBSecurity.GetLoggedUser: string;
begin
  Result := FLoggedUser^;
end;

procedure TDBSecurity.SetLoggedUser(const Value: string);
begin
  AssignStr(FLoggedUser, Value);
end;

procedure TDBSecurity.DoAfterLogin;
begin
  IF ( FUseTableSecurity  ) THEN BEGIN
   GetTableSecurity;
   IF ( FUseColumnSecurity  ) THEN BEGIN
      GetColumnSecurity;
   END;
  END;
  If ( FUseStorProcSecurity  ) Then Begin
		GetStorProcSecurity;
  End;
  if Assigned(FAfterLogin) then FAfterLogin(Self);
end;

function TDBSecurity.DoCheckUser(UsersTable: TTable; const UserName,
  Password: string): Boolean;
var
  SaveLoggedUser: string;
begin
  if Assigned(FOnCheckUser) then begin
    SaveLoggedUser := LoggedUser;
    try
      SetLoggedUser(UserName);
      Result := FOnCheckUser(UsersTable, Password);
    finally
      SetLoggedUser(SaveLoggedUser);
    end;
  end
  else Result := True;
end;

function TDBSecurity.Login: Boolean;
var
  LoginName: string;
  F: TForm;
begin
  LoginName := EmptyStr;
  Result := LoginDialog(Database, AttemptNumber, UsersTableName,
    LoginNameField, MaxPasswordLen, DoCheckUser, LoginName, FPassword, IniFileName,
    FUseRegistry);
  if Result then begin
    SetLoggedUser(LoginName);
    F := Application.MainForm;
    if (F = nil) and (Owner is TForm) then F := Owner as TForm;
    if (F <> nil) and (LoginName <> '') then
      case UpdateCaption of
        ucAppTitle:
          F.Caption := Format('%s (%s)', [Application.Title, LoginName]);
        ucFormCaption:
          F.Caption := Format('%s (%s)', [F.Caption, LoginName]);
      end;
    DoAfterLogin;
  end;
end;

function TDBSecurity.ChangePassword: Boolean;
begin
  Result := ChangePasswordDialog(Database, AttemptNumber, UsersTableName,
    LoginNameField, LoggedUser, MaxPasswordLen, FAllowEmpty,
    OnChangePassword);
end;

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

function TDBSecurity.UnlockHook(var Message: TMessage): Boolean;

  function DoUnlock: Boolean;
  var
    Popup: HWnd;
  begin
    with Application do
      if IsWindowVisible(Handle) and IsWindowEnabled(Handle) then
{$IFDEF WIN32}
        SetForegroundWindow(Handle);
{$ELSE}
        BringWindowToTop(Handle);
{$ENDIF}
    if FUnlockDlgShowing then begin
      Popup := GetLastActivePopup(Application.Handle);
      if (Popup <> 0) and IsWindowVisible(Popup) and
        (WindowClassName(Popup) = TRxLoginForm.ClassName) then
      begin
{$IFDEF WIN32}
        SetForegroundWindow(Popup);
{$ELSE}
        BringWindowToTop(Popup);
{$ENDIF}
      end;
      Result := False;
      Exit;
    end;
    FUnlockDlgShowing := True;
    try
      Result := UnlockDialog(LoggedUser, OnUnlock);
    finally
      FUnlockDlgShowing := False;
    end;
    if Result then begin
      Application.UnhookMainWindow(UnlockHook);
      FLocked := False;
    end;
  end;

begin
  Result := False;
  if not FLocked then Exit;
  with Message do begin
    case Msg of
      WM_SHOWWINDOW:
        if Bool(WParam) then begin
          UnlockHook := not DoUnlock;
        end;
      WM_SYSCOMMAND:
        if (WParam and $FFF0 = SC_RESTORE) or
          (WParam and $FFF0 = SC_ZOOM) then
        begin
          UnlockHook := not DoUnlock;
        end;
    end;
  end;
end;

{*******************************************************************************
  TDBSecurity.GetTableSecurity - 6/12/1998 11:40AM
 BY:  DEREK AGAR
 DESCRIPTION: will create the table security table and call the user defined
 procedure to fill it

********************************************************************************}
PROCEDURE TDBSecurity.GetTableSecurity;
BEGIN
  	BSTreeTable := TBinSearchTree.Create(true);
  	with BSTreeTable do begin
   	Compare := TableCompare;
   	DisposeData := TableDisposeData;
  	end;
   {get the memory for the search record}
   GetMem(FSearchTablePtr,sizeof(TableSecurityRec));
   IF  assigned(FOnTableSecurity) THEN FOnTableSecurity(Self);
END; {TDBSecurity.GetTableSecurity}


{*******************************************************************************
   TDBSecurity.CanSelect - 6/16/1998 10:40am
 By:  Derek Agar
 Rochester College
 Description: Checks to see if the pointer is not null and returns the SelectAuthority

********************************************************************************}
Function TDBSecurity.CanSelect :boolean ;
Begin
	result := not (FTablePtr = nil) and FTablePtr^.SelectAuthority;
End; {TDBSecurity.CanSelect}

{*******************************************************************************
   TDbSecurity.CanUpdate - 6/16/1998 10:48am
 By:  Derek Agar
 Rochester College
 Description: Checks to see if the pointer is not null and returns the UpdateAuthority

********************************************************************************}
Function TDbSecurity.CanUpdate : boolean;
Begin
	result := not (FTablePtr = nil) and FTablePtr^.UpdateAuthority;
End; {TDbSecurity.CanUpdate}


{*******************************************************************************
   TDBSecurity.CanInsert - 6/16/1998 10:53am
 By:  Derek Agar
 Rochester College
 Description:	Checks to see if the pointer is not null and returns the InsertAuthority

********************************************************************************}
Function TDBSecurity.CanInsert :boolean ;
Begin
	result := not (FTablePtr = nil) and FTablePtr^.InsertAuthority;
End; {TDBSecurity.CanInsert}

function TDBSecurity.HasUpdColumns:boolean;
begin
   result := not (FTablePtr = nil) and FTablePtr^.UpdColSecurity;
end;

{*******************************************************************************
   TDBSecurity.CanDelete - 6/16/1998 10:59am
 By:  Derek Agar
 Rochester College
 Description:	Checks to see if the pointer is not null and returns the DeleteAuthority

********************************************************************************}
Function TDBSecurity.CanDelete :boolean ;
Begin
	result := not (FTablePtr = nil) and FTablePtr^.DeleteAuthority;
End; {TDBSecurity.CanDelete}

procedure TDBSecurity.InsertTable(sTableName:string;bSelectAuthority,
      bInsertAuthority,bDeleteAuthority,bUpdateAuthority,bUpdColSecurity:boolean);
var MyPtr : TableSecurityPtr;
   MyCursor : TTreeCursor;
begin
   if BSTreeTable <> nil then begin
      GetMem(MyPtr,sizeof(TableSecurityRec));
      MyPtr^.TableName := sTableName;
      MyPtr^.SelectAuthority := bSelectAuthority;
      MyPtr^.InsertAuthority := bInsertAuthority;
      MyPtr^.DeleteAuthority := bDeleteAuthority;
      MyPtr^.UpdateAuthority := bUpdateAuthority;
      MyPtr^.UpdColSecurity := bUpdColSecurity;
      try
         BSTreeTable.Insert(MyCursor,MyPtr);
      except
      {if it does not work then free the record}
         freemem(MyPtr,sizeof(TableSecurityRec));
      end;
   end;
end;

function TDBSecurity.TableExists(Search : string):boolean;
var MyPtr : TableSecurityPtr;
   MyCursor : TTreeCursor;
begin
   MyPtr := FSearchTablePtr;
   Myptr^.TableName := Search;
   result := BSTreeTable.Search(MyCursor,MyPtr);
   if result then
      FTablePtr := BSTreeTable.Examine(MyCursor)
   else
      FTablePtr := nil;
end;

{*******************************************************************************
   TDBSecurity.ColumnExists - 6/18/1998 2:12pm
 By:  Derek Agar
 Rochester College
 Description: calls the search medthod on the search tree for the column

********************************************************************************}
Function TDBSecurity.ColumnExists(search:string) : boolean;
var MyCursor : TTreeCursor;
	SearchString : PEZString;
Begin
	SearchString := EZStrNew(search);
	result := BSTreeColumn.Search(MyCursor,SearchString);
	EZStrDispose(SearchString);
End; {TDBSecurity.ColumnExists}

{*******************************************************************************
   TDBSecurity.StorProcExists(search:string) - 7/1/1998 4:40pm
 By:  Derek Agar
 Rochester College
 Description:	checks to see if the Stor proc exists in the binary tree

********************************************************************************}
Function TDBSecurity.StorProcExists(search:string) :boolean ;
var MyCursor : TTreeCursor;
	SearchString : PEZString;
Begin
	SearchString := EZStrNew(search);
	result := BSTreeStorProc.Search(MyCursor,SearchString);
	EZStrDispose(SearchString);
End; {TDBSecurity.StorProcExists(search:string)}

{*******************************************************************************
   TDBSecurity.InsertColumn - 6/18/1998 2:22pm
 By:  Derek Agar
 Rochester College
 Description: Inserts the column name into the Column Tree

********************************************************************************}
procedure TDBSecurity.InsertColumn(sColumnName :string);
var MyCursor : TTreeCursor;
Begin
	BSTreeColumn.Insert(MyCursor,EZStrNew(sColumnName));
End; {TDBSecurity.InsertColumnName}

{*******************************************************************************
   TDBSecurity.InsertStorProc - 7/1/1998 4:12pm
 By:  Derek Agar
 Rochester College
 Description:

********************************************************************************}
Procedure TDBSecurity.InsertStorProc(sStorProc:string);
var MyCursor : TTreeCursor;
Begin
	BSTreeStorProc.Insert(MyCursor,EZStrNew(sStorProc));
End; {TDBSecurity.InsertStorProc}

{*******************************************************************************
  TDBSecurity.GetColumnSecurity - 6/12/1998 12:11PM
 BY:  DEREK AGAR
 DESCRIPTION: will create the column security table and call the user defined
 LoadColumnSecurity to fill it

********************************************************************************}
PROCEDURE TDBSecurity.GetColumnSecurity;
BEGIN
  	BSTreeColumn := TBinSearchTree.Create(true);
  	with BSTreeColumn do begin
      Compare := EZStrCompare;
      DupData := EZStrDupData;
      DisposeData := EZStrDisposeData;
  	end;
   IF  assigned(FOnColumnSecurity) THEN FOnColumnSecurity(Self);
END; {TDBSecurity.GetColumnSecurity}


{*******************************************************************************
   TDBSecurity.GetStorProcSecurity - 7/1/1998 3:42pm
 By:  Derek Agar
 Rochester College
 Description:	will create the binary tree to get the stored procedure security
 and call the user defined OnStorProcSecurity to fill it

********************************************************************************}
Procedure TDBSecurity.GetStorProcSecurity;
Begin
  	BSTreeStorProc := TBinSearchTree.Create(true);
  	with BSTreeStorProc do begin
      Compare := EZStrCompare;
      DupData := EZStrDupData;
      DisposeData := EZStrDisposeData;
  	end;
   IF  assigned(FOnStorProcSecurity) THEN FOnStorProcSecurity(Self);
End; {TDBSecurity.GetStorProcSecurity}


{binary tree utility functions}

function TableCompare(Data1, Data2 : pointer) : integer;
var aData1 : TableSecurityPtr absolute Data1;
   aData2 : TableSecurityPtr absolute Data2;
begin
  if (aData1 = nil) then
    if (aData2 = nil) then
      result := 0
    else
      result := -1
  else
    if (aData2 = nil) then
      result := 1
    else
    {uses case insensitive search}
      result := CompareText(aData1^.TableName,aData2^.TableName);
end;


procedure TableDisposeData(aData : pointer);
begin
	freemem(aData,sizeof(TableSecurityRec));
end;

end.
