absecurity.pas

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

          if TabActionList(Owner.Components[i]).ActionCount > 0 then
          begin
            //fimglActions.Assign(TImageList(TabActionList(Owner.Components[i]).images));
            fimglActions.Masked := false;
          end;
        end;

    if bActionListRefered then
      if mrYes = MessageDlg('New abActionList found. Do you want to build security template from clients?', mtConfirmation, [mbYes, mbNo], 0) then
      begin
        DoBuildSecurityTemplateFromClients(ftvSecurityTemplate, fimglActions);
      end;
  end;
  *)
end;


destructor TabSecurity.Destroy;
begin
  NotifyClientsForBeingDestroyed;
  flClientList.Destroy;

  ftvUserTemplate.ClearTemplate;
  ftvUserTemplate.Destroy;
  ftvSecurityTemplate.ClearTemplate;

  ftvSecurityTemplate.Destroy;
  ffrSecurityTemplate.Destroy;
  fSecurityDialogs.Destroy;
  fimglActions.Destroy;
  flstLastUser.Destroy;
  CloseHandle(fhFileMap);
  inherited;
end;

procedure TabSecurity.SetOptions(SecurityOptionSet: TabSecurityOptionSet);
begin
  fSecurityOptions := SecurityOptionSet;
  if soShowIcons in fSecurityOptions then
    ftvSecurityTemplate.Images := fimglActions
  else
    ftvSecurityTemplate.Images := nil;
end;

procedure TabSecurity.ForceClientsVisible;
var
  i, j: integer;
begin
  for i := Pred(flClientList.Count) downto 0 do
    if TObject(flClientList[i]) is TabActionList then
      if {//v 3.0 was soSetInvisibleOnFail} sorSetInvisibleOnFail = TabActionList(flClientList[i]).Options then//v 3.0 ???? was "in" and cannot compile ????
        for j:= Pred(TabActionList(TObject(flClientList[i])).ActionCount) downto 0 do
          if TabActionList(TObject(flClientList[i])).Actions[j] is TabAction then
            if soForceClientsVisibleAfterLogon in fSecurityOptions then
              TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).Visible := true;

end;


function TabSecurity.Logon(sUserName: string = '';  sPassword: string = ''; bTrySilent: boolean = false): boolean;
begin
  Result := false;
  fbLoggedOn := fSecurityDialogs.Init(sUserName, sPassword, bTrySilent, soShowCheckedOKOnly in fSecurityOptions);
  if fbLoggedOn then
  begin
    fsCurrentUser := sUserName;
    fbIsSupervisor := fsCurrentUser = C_SUPERVISOR_NAME;

    WriteUserTemplateIntoRegistry(TCripter.Cript(sPassword));

    Result := true;
  end
  else
  begin
    fsCurrentUser := '';
    fbIsSupervisor := false;
  end;
  ForceClientsVisible;
end;


procedure TabSecurity.ShowPrivileges;
var
  dlgPassword: TDlgPassword;
  frmSecurity: TfrmSecurity;

begin
  if not fbLoggedOn then
    Logon(fsCurrentUser)
  else
  begin
    dlgPassword := TDlgPassword.Create(nil);
    try
      frmSecurity := TfrmSecurity.Create(nil);
      frmSecurity.ftvSecurityTemplate := ftvSecurityTemplate;



      try
        TabSecurityTemplate(frmSecurity.ftvUserTemplate).ClearTemplate;
        TabSecurityTemplate(frmSecurity.ftvUserTemplate).Images := ftvSecurityTemplate.Images;
        dlgPassword.CopyUserTemplate(ftvUserTemplate, TabSecurityTemplate(frmSecurity.ftvUserTemplate), fsCurrentUser, soShowCheckedOKOnly in fSecurityOptions);
        frmSecurity.IsSupervisor := fsCurrentUser = C_SUPERVISOR_NAME;
        if frmSecurity.ftvUserTemplate.Items.Count > 0 then
          frmSecurity.ftvUserTemplate.Items[0].Expand(true);
        if mrOK = frmSecurity.ShowModal then
        begin
          if fsCurrentUser = C_SUPERVISOR_NAME then
            dlgPassword.CopyUserTemplate(TabSecurityTemplate(frmSecurity.ftvUserTemplate), ftvUserTemplate, fsCurrentUser, soShowCheckedOKOnly in fSecurityOptions)//Might be used as is for a user copy only as well
          else//Copy Data (Password only)
            PNodeData(ftvUserTemplate.GetUserNodeByUserName(fsCurrentUser).Item[0].Data)^ :=
               PNodeData(TabSecurityTemplate(frmSecurity.ftvUserTemplate).GetUserNodeByUserName(fsCurrentUser).Item[0].Data)^;

          WriteUserTemplateIntoRegistry(TCripter.Cript(PNodeData(ftvUserTemplate.GetUserNodeByUserName(fsCurrentUser).Item[0].Data)^.sCaption));
        end;
      finally
        frmSecurity.Destroy;
      end;
    finally
      dlgPassword.Destroy;
    end;
  end;
end;


function TabSecurity.WriteUserTemplateIntoRegistry(sPasswordCripted: string): boolean;
var
  Reg: TRegistry;
  strUserTemplate: TMemoryStream;
begin
  Reg:= TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if not Reg.OpenKey(fsUserTemplateRegistryKeyName, true) then
    begin
      Result := false;
      exit;
    end
    else
    begin
      strUserTemplate := TMemoryStream.Create;
      try
        ftvUserTemplate.SaveToStreamSecurity(strUserTemplate);
        strUserTemplate.Position := 0;
        //v 1.4
        if soSaveUsersInFile in fSecurityOptions then
        begin
          strUserTemplate.SaveToFile(fsUserTemplateFileName);
          Reg.WriteString('UserTemplateFileName', fsUserTemplateFileName);
        end
        else
        begin
          try
            Reg.WriteBinaryData('UserTemplate', strUserTemplate.Memory^, strUserTemplate.Size);
          except
              ShowMessage('Error saving Users into Windows Registry. ' + #9#13 +
                          'Probably you work with an older version of Windows that limits the size of binary block to be written to the registry. ' + #9#13 +  #9#13 +
                          'To resolve this problem you may chose to save Users into a file, pointed by a registry entry. ' +
                          '(set "soSaveUsersInFile" option to your TabSecurity component and rebuild)');
            Result := false;
            exit;
          end;
        end;

        try
          Reg.WriteInteger('UserTemplateSize', strUserTemplate.Size);
        except
          Result := false;
          exit;
        end;

        strUserTemplate.Clear;
        flstLastUser.SaveToStream(strUserTemplate);
        try
          Reg.WriteBinaryData('LastUsers', strUserTemplate.Memory^, strUserTemplate.Size);
        except
          //Result := false;
          //exit;
        end;

        try
          Reg.WriteInteger('LastUsersSize', strUserTemplate.Size);
        except
          //Result := false;
          //exit;
        end;

        if soStorePassword in fSecurityOptions then
        try
          Reg.WriteString('Password', sPasswordCripted);
        except//Not important
        end;
      finally
        strUserTemplate.Destroy;
      end;
    end;
    Result := true;
  finally
    Reg.Free;
  end;
end;


function TabSecurity.ReadUserTemplateFromRegistry(var sPasswordCripted: string): boolean;
var
  Reg: TRegistry;
  iUserTemplateSize: integer;
  strUserTemplate: TMemoryStream;
begin
  sPasswordCripted := '';
  Reg:= TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if not Reg.OpenKey(fsUserTemplateRegistryKeyName, true) then
    begin
      Result := false;
      exit;
    end
    else
    begin
      try
        iUserTemplateSize := Reg.ReadInteger('UserTemplateSize');
      except
        Result := false;
        exit;
      end;
    end;

    if soStorePassword in fSecurityOptions then
      try
        sPasswordCripted := Reg.ReadString('Password');
      except//Not so important
      end;

    strUserTemplate := TMemoryStream.Create;
    try
      strUserTemplate.SetSize(iUserTemplateSize);
      //v 1.4
      if soSaveUsersInFile in fSecurityOptions then
        try
          strUserTemplate.LoadFromFile(fsUserTemplateFileName);
        except
          strUserTemplate.SetSize(0);
        end
      else
        {if iUserTemplateSize} Reg.ReadBinaryData('UserTemplate', strUserTemplate.Memory^, iUserTemplateSize);{ then}

      if iUserTemplateSize <> strUserTemplate.Size then
      begin
        Result := false;
        exit;
      end;
      strUserTemplate.Position := 0;

      ftvUserTemplate.LoadFromStreamSecurity(strUserTemplate);

      strUserTemplate.Clear;
      try
        iUserTemplateSize := Reg.ReadInteger('LastUsersSize');
      except
        Result := false;
        exit;
      end;
      strUserTemplate.SetSize(iUserTemplateSize);
      if iUserTemplateSize  = Reg.ReadBinaryData('LastUsers', strUserTemplate.Memory^, iUserTemplateSize) then
        flstLastUser.LoadFromStream(strUserTemplate);
    finally
      strUserTemplate.Destroy;
    end;
    Result := true;
  finally
    Reg.Free;
  end;
end;


function TabSecurity.CheckId(ID: integer): boolean;
  function GetNodeForId(tn: TTreeNode): TTreeNode;
  var
    tnChild: TTreeNode;
  begin
    Result := nil;
    if tn.HasChildren then
    begin
      tnChild := tn.GetFirstChild;
      while Assigned(tnChild) do
      begin
        Result := GetNodeForId(tnChild);
        if Assigned(Result) then
          exit;
        tnChild := tn.GetNextChild(tnChild);
      end;
    end
    else
      if Assigned(tn.Data) then
        if PNodeData(tn.Data)^.iId = Id then
          Result := tn;
end;
var
  tnID: TTreeNode;
begin
  if fbLoggedOn then
  begin
    tnID := GetNodeForId(ftvUserTemplate.GetUserNodeByUserName(fsCurrentUser));
    if Assigned(tnID) then
      if Pos(C_YES, tnID.Text) = (Succ(length(tnID.Text)) - length(C_YES)) then
      begin
        Result := true;
        exit;
      end;
  end;
  Result := false;
end;


procedure TabSecurity.AddClientObject(Client: TObject);
begin
  if Client is TabActionList then
    flClientList.Add(Client);
  //Currently supports only TabActionList type of clients
  //Add else if clause and corresponding code for other type of clients
end;


procedure TabSecurity.RemoveClientObject(Client: TObject);
var
  i: integer;
begin
  for i := Pred(flClientList.Count) downto 0 do
    if flClientList.Items[i] = Client then
    begin
      flClientList.Delete(i);
      exit;
    end;
end;


procedure TabSecurity.NotifyClientsForBeingDestroyed;
var
  i: integer;
begin
  for i := Pred(flClientList.Count) downto 0 do
    if TObject(flClientList[i]) is TabActionList then
    begin
      TabActionList(flClientList[i]).SecurityObject := nil;
    end;
end;


function TabSecurity.DoBuildSecurityTemplateFromClients(ftvSecurityTemplate: TabSecurityTemplate; fimglActions: TImageList): boolean;
var
  i, j, k: integer;
  slIDs: TStringList;
  tnParent, tnChild: TTreeNode;
  sCategoryItem: string;
  iCategoryId: integer;
  msBlobSecurityTemplate: TMemoryStream;

  bmpImage: TBitmap;
  iImageOffset: integer;

  iByte: BYTE;
  iWord: WORD;
  iDWord: DWORD;
  s: Array[0..65535] of Char;
  lpNodeData: PNodeData;

  function FindTreeNodeByCategoryAndLevel(sCategoryItem: string; iLevel: integer): TTreeNode;
  var
    i: integer;
  begin
    for i := Pred(ftvSecurityTemplate.Items.Count) downto 0 do