absecurity.pas

1. It is located in the root directory - SecurityBuilderDemo.exe. Leave password box blank and click

unit abSecurity;

interface

uses
  Windows, Classes, SysUtils, Forms, Controls, ComCtrls, graphics, Dialogs;

const
  C_SUPERVISOR_NAME = 'Supervisor';
  C_DEFAULT_USER_TEMPLATE_REGISTRY_KEY_NAME = '\Software\AbEclecticVision\AbEclecticSecurity\CurrentVersion\SecurityObject\UserTemplate';
  C_DEFAULT_USER_TEMPLATE_FILE_NAME = 'UserTemplate';

  C_YES = ' (Yes)';
  C_NO = ' (No)';
  //C_MAX_ID = 2048;
  C_LAST_USER_COUNT = 5;

type
  TString40 = string[40];
  TString34 = string[34];
  
resourcestring
  rsAutoLogonFail = 'Auto Logon Failed.';
  rsOnlyOneInstanceFail = 'No more than one instance of Security Component allowed.';
  rsVersionMismatch = 'Version mismatch. Cannot continue';

type

  EabSecurityException = class(Exception);

  TabSecurityOptions = (soForceBuildSecurityFromClients,
                      soForceIDFromClients,
                      soForceClientsVisibleAfterLogon,
                      soAutoSaveUsers,
                      soShowCheckedOKOnly,
                      soAutoLogon,
                      soReleaseOwnerOnLogonFail,
                      soCreateSupervisorIfMissing,
                      soShowIcons,
                      soStorePassword,
                      soSilentLogonTry,
                      //v 1.4
                      soSaveUsersInFile);
  TabSecurityOptionSet = set of TabSecurityOptions;

  TabSecurityError = (seNone, seUserTemplateMissing,
                    seSecurityTemplateMissing,
                    seSecurityTemplateCannotBuildFromClients,
                    seUsrAccessInitEntryMissing,
                    seUsrAccessUserEntryMissing,
                    seUsrAccessRightEntryMissing,
                    eUsrAccessLoginNameEntryMissing,
                    seUsrAccessLoginNameEntryMissing,
                    seUsrAccessInitFailed);

  TNodeType = (ntNone, ntPassword, ntUserLeave, ntIntermediate, ntUserRegular, ntSupervisor, ntSupervisorLeave);

  TVersion = record
    Major: integer;
    Minor: integer;
    MinorMinor: integer;
    Patch: char;
  end;

  TAdditionalInfo = record
    iItemIndex: integer;
    iImageIndex: integer;
    sOwner: string[40];
    Reserved: array[0..79] of char;
  end;

  TNodeData = record
    iId: integer;
    sCaption: string[40];
    bCheckOK: boolean;
    AdditionalInfo: TAdditionalInfo;
  end;
  PNodeData = ^TNodeData;

  TabSecurityTemplate = class(TTreeView)
    function GetPasswordFromUserTreeNode(tnUser: TTreeNode): string;
    function GetUserPassword(sUserName: string): string;
    procedure AddUserToUserTemplate(tvSourceTemplate: TabSecurityTemplate; sUserName, sPassword: string; bGrantAll: boolean);
    procedure BuildASecurityUser(tnDest, tnSource: TTreeNode; bGrantAll: boolean);
    function GetUserNodeByUserName(sUserName: string): TTreeNode;
    function GetUserNodeForSelected: TTreeNode;
    function GetUserNodeForNode(tn: TTreeNode): TTreeNode;
    procedure DeleteNode(tnUserNode: TTreeNode);
    function GetSelectedNodeType(var sUser, sPassword: string): TNodeType;
    function GetNodeType(tn: TTreeNode; var sUser, sPassword: string): TNodeType;
    function GetNodeTypeSecurityTemplate(tn: TTreeNode): TNodeType;
    procedure ClearTemplate;
    procedure LoadFromStreamSecurity(Stream: TMemoryStream);
    procedure SaveToStreamSecurity(Stream: TMemoryStream);
    function GenerateSecurityId: integer;
    function IsValidSecurityId(iID: integer): boolean;
    destructor Destroy; override;
    function DeleteKey(sKey: string): boolean;//v1.4
  end;

  TabSecurity = class;

  TabSecurityDialogs = class
  private
    fSecurity: TabSecurity;
    procedure SetSecurityObject(SecurityObject: TabSecurity);
  public
    ftvUserTemplate: TabSecurityTemplate;
    ftvSecurityTemplate: TabSecurityTemplate;
    //ffrUserTemplate: TForm;
    constructor Create{(AOwner: TComponent); override};
    destructor Destroy; override;
    function Init(var sLogonName: string; var sPassword: string; bTrySilentInit: boolean; bRestrictToCheckOK: boolean): boolean;
  published
    property SecurityObject: TabSecurity read fSecurity write SetSecurityObject;
  end;

  TabSecurity = class(TComponent)
  private
    fhFileMap: THandle;
    fsCurrentUser: string;
    fbIsSupervisor: boolean;

    flClientList: TList;//Currently supports TabActionListClients only
    fbUserBlobChanged: boolean;

    fbLoggedOn: boolean;

    FLastError: TabSecurityError;
    fSecurityOptions: TabSecurityOptionSet;
    fsUserTemplateRegistryKeyName: string;
    fsUserTemplateFileName: string;

    fImglActions: TImageList;

    //D4 Moved to publicftvSecurityTemplate: TabSecurityTemplate;
    ffrSecurityTemplate: TForm;

    procedure NotifyClientsForBeingDestroyed;
    procedure ForceClientsVisible;
    function ReadUserTemplateFromRegistry(var sPasswordCripted: string): boolean;
    function WriteUserTemplateIntoRegistry(sPasswordCripted: string): boolean;
    function GetCurrentUser: string;
    function OnlyInstance: boolean;
    procedure AddInLastUser(sUserName: string);
  protected
    procedure Loaded; override;
  public

    ftvUserTemplate: TabSecurityTemplate;//v1.4
    ftvSecurityTemplate: TabSecurityTemplate;//v1.4

    flstLastUser: TStringList;
    fSecurityDialogs: TabSecurityDialogs;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Logon(sUserName: string = '';  sPassword: string = ''; bTrySilent: boolean = false): boolean;
    procedure ShowPrivileges;
    function CheckId(ID: integer): boolean;
    procedure AddClientObject(Client: TObject);
    procedure RemoveClientObject(Client: TObject);

    function DoBuildSecurityTemplateFromClients(ftvSecurityTemplate: TabSecurityTemplate; fimglActions: TImageList): boolean;

    procedure DefineProperties(Filer: TFiler); override;

    procedure StoreTreeProperty(Stream: TStream);
    procedure LoadTreeProperty(Stream: TStream);
    procedure StoreImageProperty(Stream: TStream);
    procedure LoadImageProperty(Stream: TStream);

    //v 3.0
    function GenerateUniqueSecurityId: integer;
    function GetActionClientById(iId: integer): TObject;
    property Images: TImageList read FimglActions;
    property UserTemplate: TabSecurityTemplate read ftvUserTemplate write ftvUserTemplate;
    procedure SetOptions(SecurityOptionSet: TabSecurityOptionSet);
{$IFDEF DELPHI4}
    property SecurityTemplate: TabSecurityTemplate read ftvSecurityTemplate write ftvSecurityTemplate;
{$ENDIF}
  published
    property UserTemplateRegistryKeyName: string read fsUserTemplateRegistryKeyName write fsUserTemplateRegistryKeyName;
    property UserTemplateFileName: string read fsUserTemplateFileName write fsUserTemplateFileName;
    property CurrentUser: string read GetCurrentUser;
    property IsSupervisor: boolean read fbIsSupervisor;
    property LastError: TabSecurityError read FLastError;
    property Options: TabSecurityOptionSet read fSecurityOptions write SetOptions;
{$IFNDEF DELPHI4}
    property SecurityTemplate: TabSecurityTemplate read ftvSecurityTemplate write ftvSecurityTemplate;
{$ENDIF}    
  end;

  procedure Register;
  function GetStringItem(Expression: string; Count: integer; Separator: Char): string;
  procedure CopyEntireUserTemplate(tvSource, tvDest: TabSecurityTemplate);

const
  C_VERSION: TVersion = (Major: 1; Minor: 4; MinorMinor: 0; Patch: #0);
  
implementation

uses Registry, abActnLst, abEntryPasswordDlg, abCript, abDlgSecurity,
     stdctrls{//v 3.0}, Math;

{$A-}

procedure Register;
begin
  RegisterComponents ('Security', [TabSecurity]);
end;


function GetStringItem(Expression: string; Count: integer; Separator: Char): string;
var
  i: integer;
  position: byte;
begin
 Result:= '';
 try
   for i:= 1 to Count  do
   begin
     position:= Pos(Separator, Expression);
     if position <> 0 then
     begin
   	   Result:= Copy(Expression, 1, Position - 1);
	   Expression:= Copy(Expression, Position + 1, length(Expression) - Position);
      end
      else
      begin
        if i = Count then
          Result:= Expression
        else
          Result:= '';
        exit;
      end;
   end;
 finally
   Result:= Trim(Result);
 end;
end;

//v 3.0
function GetCaption(sCaption: string): string;
var
  i: integer;
begin
  for i := length(sCaption) downto 1 do
    if sCaption[i] = '&' then
    begin
      sCaption := Copy(sCaption, 1, Pred(i)) + Copy(sCaption, Succ(i), Length(sCaption) - i);
    end;

  for i := length(sCaption) downto 1 do
    if sCaption[i] <> ' ' then
      if sCaption[i] < '!' then
        sCaption[i] := '_';
  Result := sCaption;
end;


procedure CopyEntireUserTemplate(tvSource, tvDest: TabSecurityTemplate);
var
  i: integer;
  lpNodeData: PNodeData;
begin
  tvDest.Items.assign(tvSource.Items);
  for i:= Pred(tvSource.Items.Count) downto 0 do
    if nil <> tvSource.Items[i].Data then
    begin
      new(lpNodeData);
      tvDest.Items[i].Data := lpNodeData;
      PNodeData(tvDest.Items[i].Data)^ := PNodeData(tvSource.Items[i].Data)^;
    end;
end;


function TabSecurity.OnlyInstance: boolean;
begin
{$B-}
  if not (Assigned(Owner) and (Owner is TWinControl)) then
    Result := true
  else
  begin
    fhFileMap := OpenFileMapping(FILE_MAP_READ, false, PChar(intToStr(TWinControl(Owner).Handle)));
    if fhFileMap = 0 then
    begin
      fhFileMap := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(WORD), PChar(intToStr(TWinControl(Owner).Handle)));
      Result := true;
    end
    else
      Result := false;
  end;
end;

function TabSecurity.GetActionClientById(iId: integer): TObject;
var
  i, j: integer;
begin
  for i := Pred(flClientList.Count) downto 0 do
    if TObject(flClientList[i]) is TabActionList then
      for j:= 0 to Pred(TabActionList(TObject(flClientList[i])).ActionCount) do
        if TabActionList(TObject(flClientList[i])).Actions[j] is TabAction then
          if iId = TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId then
          begin
            Result := TabAction(TabActionList(TObject(flClientList[i])).Actions[j]);
            exit;
          end;
  Result := nil;
end;

//v 3.0
function TabSecurity.GenerateUniqueSecurityId: integer;
var
  i, j: integer;
begin
  Result := 0;
  for i := Pred(flClientList.Count) downto 0 do
    if TObject(flClientList[i]) is TabActionList then
      for j:= 0 to Pred(TabActionList(TObject(flClientList[i])).ActionCount) do
        if TabActionList(TObject(flClientList[i])).Actions[j] is TabAction then
          if Result <= TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId then
            Result := Succ(TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId);
  Result := max(ftvSecurityTemplate.GenerateSecurityId, Result);
end;

constructor TabSecurity.Create;
begin
  inherited;
  fLastError:= seNone;
  fbUserBlobChanged := false;
  fbLoggedOn := false;
  flClientList := TList.Create;
  fSecurityOptions := [soAutoSaveUsers,
                       soShowCheckedOKOnly,
                       soAutoLogon,
                       soReleaseOwnerOnLogonFail,
                       soCreateSupervisorIfMissing,
                       soShowIcons,
                       soSaveUsersInFile];
  fsUserTemplateRegistryKeyName := C_DEFAULT_USER_TEMPLATE_REGISTRY_KEY_NAME;
  fsUserTemplateFileName := C_DEFAULT_USER_TEMPLATE_FILE_NAME;

  fimglActions := TImageList.Create(nil);
  fimglActions.Masked := false;
  ffrSecurityTemplate := TForm.Create(nil);
  ffrSecurityTemplate.Align := alClient;
  ftvSecurityTemplate := TabSecurityTemplate.Create(nil);
  ftvSecurityTemplate.Parent := ffrSecurityTemplate;
  ftvSecurityTemplate.Align := alClient;
  ftvUserTemplate := TabSecurityTemplate.Create(nil);
  ftvUserTemplate.Parent := ffrSecurityTemplate;
  fSecurityDialogs := TabSecurityDialogs.Create{(nil)};

  flstLastUser := TStringList.Create;
  fhFileMap := 0;
  if not OnlyInstance then
  begin
    closehandle(fhFileMap);
    raise Exception.Create(rsOnlyOneInstanceFail);
  end;

  //v 1.4
  (*
  if (csDesigning in ComponentState) and Assigned(Owner) then
  begin
    bActionListRefered := false;
    for i:= Pred(Owner.ComponentCount) downto 0 do
      if Owner.Components[i] is TabActionList then
        if not Assigned(TabActionList(Owner.Components[i]).SecurityObject) then
        begin
          TabActionList(Owner.Components[i]).SecurityObject :=  Self;
          bActionListRefered := true;