abactnlst.pas

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

unit abActnLst;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ActnList, Consts, abSecurity{//v 1.4.}, menus;

const
  C_SEPARATOR_CONTROL_NAME = #9;
resourcestring
  RCST_TEXT_NEW_ACTION = 'A new abAction to be generated /';

type
  //Important: soParent must be the last
  TabSecurityOptionsRoot = (sorSetDisabledOnFail, sorSetInvisibleOnFail, sorShowMessageOnFail);
  TabSecurityOptions = (soSetDisabledOnFail, soSetInvisibleOnFail, soShowMessageOnFail, soParent);

  TabControl = class(TControl)
  published
    property  OnClick;
    property Text;
  end;
  TabActionDesigner = string;

{ TabAction }
  TabAction = class(TAction)
  private
    fiSecurityId: integer;
    //fabActionDesigner: TabActionDesigner;
    fsControlNames: string;//TabActionDesigner;
    fSecurityOptions: TabSecurityOptions;
    fsDisabledMessage: string;
  protected
    procedure Loaded; override;
  public
    property ControlNames: string read fsControlNames write fsControlNames;
    constructor Create(AOwner: TComponent); override;
    function Update: Boolean; override;
    function Execute: Boolean; override;
  published
    //property ControlNames: string read fsControlNames write fsControlNames;
    property ActionDesigner: TabActionDesigner{string} read fsControlNames{fabActionDesigner} write fsControlNames;//fabActionDesigner;
    property Options: TabSecurityOptions{Set} read fSecurityOptions write fSecurityOptions;

    property Caption;
    property Checked;
    property Enabled;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property ShortCut;
    property Visible;
    property OnExecute;
    property OnHint;
    property OnUpdate;
    property SecurityId: integer read fiSecurityId write fiSecurityId;
    property DisabledMessage: string read fsDisabledMessage write fsDisabledMessage;
  end;

  TabActionListDesigner = class
  end;


{ TabActionList }
  TabActionList = class(TActionList)
  private
    fSecurityObject: TabSecurity;
    fSecurityOptions: TabSecurityOptionsRoot;
    fabActionListDesigner: TabActionListDesigner;
    procedure SeTevSecurityObject(theSecurityObject: TabSecurity);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function MakeAnabCopy(standardAction: TAction): TabAction;
  published
    property Images;
    property OnChange;
    property OnExecute;
    property OnUpdate;
    property SecurityObject: TabSecurity read fSecurityObject write SeTevSecurityObject;
    property Options: TabSecurityOptionsRoot{Set} read fSecurityOptions write fSecurityOptions;
    property ActionListDesigner: TabActionListDesigner read fabActionListDesigner write fabActionListDesigner;
  end;

  procedure Register;
  //procedure EnumRegisteredSecurityActionsProc(const Category: string; ActionClass: TBasicActionClass; Info: Pointer);

implementation

procedure Register;
begin
  RegisterComponents('Security', [TabActionList{, TabAction}]);
{$IFDEF DELPHI5}
  RegisterActions('Security', [TabAction], TabActionList);
{$ELSE}
  RegisterActions('', [TabAction], TabActionList);
{$ENDIF}
end;

{$R *.dcr}

constructor TabAction.Create(AOwner: TComponent);
begin
  inherited;
  DisableIfNoHandler := false;
  fsControlNames := '';
  fSecurityOptions := soParent;
end;

procedure TabAction.Loaded;
var
  aComponent: TComponent;
  sControlName: string;
  i: integer;
begin
  inherited Loaded;{ call the inherited method first}
  i := 1;
  sControlName := GetStringItem(fsControlNames, i, C_SEPARATOR_CONTROL_NAME);
  while length(sControlName) > 0 do
  begin
    aComponent := ActionList.Owner.FindComponent(sControlName);
    if Assigned(aComponent) and (aComponent is TControl) then
      TControl(aComponent).Action := Self;
    inc(i);
    sControlName := GetStringItem(fsControlNames, i, C_SEPARATOR_CONTROL_NAME);
  end;
end;

function TabAction.Execute: Boolean;
var
  bSecCheck: boolean;
  abSecurityOption: TabSecurityOptions;
begin
  if fSecurityOptions = soParent then
    abSecurityOption := TabSecurityOptions(Ord((ActionList as TabActionList).fSecurityOptions))
  else
    abSecurityOption := fSecurityOptions;

  if abSecurityOption = soShowMessageOnFail then
  begin
    if Assigned((ActionList as TabActionList).SecurityObject) then
      bSecCheck :=(ActionList as TabActionList).SecurityObject.CheckId(fiSecurityID)
    else
      bSecCheck := true;

    if bSecCheck then
      Result := inherited Execute
    else
    begin
      if Length(fsDisabledMessage) > 0 then
        ShowMessage(fsDisabledMessage)
      else
        ShowMessage('Insuficient rights to access this functionality.');
      Result := false;
    end;
  end
  else
    Result := inherited Execute;
end;


function TabAction.Update: Boolean;
var
  bSecCheck: boolean;
  abSecurityOption: TabSecurityOptions;
begin
  if Assigned((ActionList as TabActionList).SecurityObject) then
  begin
    if fSecurityOptions = soParent then
      abSecurityOption := TabSecurityOptions(Ord(TabActionList(ActionList).fSecurityOptions))
    else
      abSecurityOption := fSecurityOptions;
    if abSecurityOption <> soShowMessageOnFail then
    begin
      bSecCheck :=(ActionList as TabActionList).SecurityObject.CheckId(fiSecurityID);
      if soSetDisabledOnFail = abSecurityOption then
        Enabled := bSecCheck;
      if soSetInvisibleOnFail = abSecurityOption then
        Visible := bSecCheck;
    end;
  end;
  Result := inherited Update;
end;


//TabActionList
function TabActionList.MakeAnabCopy(standardAction: TAction): TabAction;
var
  k: integer;
  sSuffix: string;
begin
  Result := TabAction.Create(Owner);
  if Assigned(standardAction) then
    Result.Assign(standardAction);
  Result.ActionList := Self;

{$B-}
  if assigned(self) and assigned(self.SecurityObject) and Assigned(self.SecurityObject.ftvSecurityTemplate) then
    Result.SecurityId := self.SecurityObject.GenerateUniqueSecurityId;

  k := 0;
  sSuffix := '';
  repeat
    try
      if Assigned(standardAction) then
        Result.Name := 'ab' + standardAction.Name + sSuffix
      else
        Result.Name := 'abAutoGenerated' + sSuffix;
      break;
    except
      inc(k);
      sSuffix := intToStr(k);
    end;
  until false;
  if Assigned(standardAction) then
  begin
    Result.Caption := standardAction.Caption;//Because if Caption = "" when we change the name, Caption will get tha Name value
    Result.OnExecute := standardAction.OnExecute;
    Result.OnUpdate := standardAction.OnUpdate;
    Result.OnHint :=  standardAction.OnHint;
    Result.Category := standardAction.Category;
    Result.Tag := standardAction.Tag;
  end
  else
  begin

  end;
end;

constructor TabActionList.Create(AOwner: TComponent);
var
  abAction: TabAction;

  i, j, k: integer;
  bDoConvert: boolean;
begin
  inherited;
  fSecurityOptions := sorSetDisabledOnFail;//[soSetDisabledOnFail]
  if (csDesigning in ComponentState) and Assigned(AOwner) then
  begin
    bDoConvert := false;
    for i:= Pred(AOwner.ComponentCount) downto 0 do
    begin
      if AOwner.Components[i] is TabSecurity then
        SecurityObject :=  TabSecurity(AOwner.Components[i])
      else if (AOwner.Components[i] is TActionList) and  (not (AOwner.Components[i] is TabActionList)) then
      begin

        for j := 0 to Pred(TActionList(AOwner.Components[i]).ActionCount) do
        begin
          abAction := nil;
          for k := 0 to Pred(AOwner.ComponentCount) do
            if AOwner.Components[k] is TMenuItem then
            begin
              if TMenuItem(AOwner.Components[k]).Action = TActionList(AOwner.Components[i]).Actions[j] then
              begin
                if not bDoConvert then
                  if mrNo = MessageDlg('A standard ActionList component found. Do you want to convert to Security Builder one (strongly recomended)?', mtConfirmation, [mbYes, mbNo], 0) then
                    exit
                  else
                  begin
                    bDoConvert := true;
                    if (not Assigned(Images)) and Assigned(TActionList(AOwner.Components[i]).Images) then
                      Images := TActionList(AOwner.Components[i]).Images;
                    if not Assigned(OnExecute) then
                      OnExecute := TActionList(AOwner.Components[i]).OnExecute;
                    if not Assigned(OnUpdate) then
                      OnUpdate := TActionList(AOwner.Components[i]).OnUpdate;
                    if not Assigned(OnChange) then
                      OnChange :=  TActionList(AOwner.Components[i]).OnChange;
                  end;

                if not Assigned(abAction) then
                  abAction := MakeAnabCopy(TAction(TActionList(AOwner.Components[i]).Actions[j]));
                TMenuItem(AOwner.Components[k]).Action := abAction;
              end;
            end
            else if AOwner.Components[k] is TControl then
            begin
              if TControl(AOwner.Components[k]).Action = TActionList(AOwner.Components[i]).Actions[j] then
              begin
                if not bDoConvert then
                  if mrNo = MessageDlg('A standard ActionList component found. Do you want to convert to Security Builder one (strongly recomended)?', mtConfirmation, [mbYes, mbNo], 0) then
                    exit
                  else
                  begin
                    bDoConvert := true;
                    if (not Assigned(Images)) and Assigned(TActionList(AOwner.Components[i]).Images) then
                      Images := TActionList(AOwner.Components[i]).Images;
                    if not Assigned(OnExecute) then
                      OnExecute := TActionList(AOwner.Components[i]).OnExecute;
                    if not Assigned(OnUpdate) then
                      OnUpdate := TActionList(AOwner.Components[i]).OnUpdate;
                    if not Assigned(OnChange) then
                      OnChange :=  TActionList(AOwner.Components[i]).OnChange;
                  end;

                if not Assigned(abAction) then
                  abAction := MakeAnabCopy(TAction(TActionList(AOwner.Components[i]).Actions[j]));
                TControl(AOwner.Components[k]).Action := abAction;
              end;
            end;
        end;

        if bDoConvert then
          if mrYes = MessageDlg('Do you want to delete the conveted standard ActionList component?', mtConfirmation, [mbYes, mbNo], 0) then
            TActionList(AOwner.Components[i]).Free;
      end
      else
      begin

      end;
    end;
  end;
end;

destructor TabActionList.Destroy;
begin
  SecurityObject := nil;//Removes ActionList from SecurityObject Clients List - see accessor method
  inherited;
end;

procedure TabActionList.SeTevSecurityObject(theSecurityObject: TabSecurity);
begin
  if Assigned(theSecurityObject) then
  begin
    if theSecurityObject <> fSecurityObject then
      theSecurityObject.AddClientObject(Self);
  end
  else
  begin
    if Assigned(fSecurityObject) then
      fSecurityObject.RemoveClientObject(Self);
  end;
  fSecurityObject := theSecurityObject;
end;

end.