Права доступа к элементам управления Delphi

 

 

 

 Для удобства администрирования, при компиляции с параметром {$define isadmin} доступно меню разработчика, а так же возможно мышью перетаскивать правила. Так же в модуле присутствуют функции загрузки и сохранения правил из потока Tstream, так что саму информацию о правилах можно сохранять в любом удобном для вас виде.

 

 

Для применения свойств используется функция парсер, которая выделяет из общей строки прав только то, что относиться к форме, описанной в параметре parent, и так же то, что относится ко всем формам (all)

procedure ApllyRights(const parent:Twincontrol; rights:string);

var

s,s1:string;

x,z,y:integer;

len:byte;

begin

if rights='' then exit;

 s:=lowercase(parent.Name)+'(';   z:=pos(s,rights);

 // вытаскиваем из общей строки прав только то, что относиться к текущей форме

 if z>0 then begin x:=length(s);      y:=PosEx(')',rights,z+x);

s:='';

if y>0 then s:=copy(rights,z+x,y-x-z);end else s:='';

 s1:='all(';z:=pos(s1,rights);

 // и так же вытаскиваем то что относиться ко всем формам.

 if z>0 then begin x:=length(s1);y:=PosEx(')',rights,z+x);

s1:='';

if y>0 then s1:=copy(rights,z+x,y-x-z);end else s1:='';

 // формируем общую строку того, что применимо к данной форме

 rights:=s1+','+s+','; // запятая в конце обязательна.

 for x := parent.ComponentCount - 1 downto 0 do begin

   s:=lowercase(parent.Components[x].Name);

   len:=length(s)-3;

   z:=pos(s,rights);

   if z>0 then begin

    z:=PosEx('.',rights,z+len);

    y:=PosEx(',',rights,z+1);

    s1:=copy(rights,z+1,y-z-1);

    if (parent.Components[x].ClassName='ваш класс')and(s1='ваш код свойства') then "ваше действие" else

    if (parent.Components[x].ClassName='ваш класс ')and(s1='ваш код свойства ') then "ваше действие" else

    if s1='0' then SetOrdProp(parent.Components[x],'Visible',0) else

    if s1='1' then SetOrdProp(parent.Components[x],'Enabled',0) else

    if s1='5' then SetOrdProp(parent.Components[x],'ReadOnly',1);

    end;

 end;

end;

Как видно из процедуры, можно изменять не только стандартные логические свойства но и любые другие предусмотренные разработчиком.

Данная функция может вызываться при загрузке или отображении формы следующим способом:

Procedure TDisp1.FormShow(Sender: TObject);

begin

ApllyRights(self,CurrentRigths);

// где self ссылка на вызываемую форму, а CurrentRigths - общая строка правил для конкретного пользователя.

end;

Описание класса TrightData

TrightData=class(Tobject)

private

RightsClass:array of Record TFormName:string[50]; SubClass:array of string[50];end;

// массив содержащий элементы строки прав

function AddForm(const formname:string):integer;

// Функция возвращает номер формы по порядку, если формы нет она создается

Function AddSubClass(const formid:integer;Subclass:string):integer;

// Функция возвращает номер класса по порядку в форме, если класса нет он создается

procedure Clear;

// очищает правило

public

Function FormExists(const FormName:string):integer;

// проверяет создана ли форма возвращает номер формы или -1 если форма не найдена

Function SubClassExist(FormId:integer;Subclass:string):integer;

// проверяет создан ли класс в форме возвращает номер класса или -1 если класс не найдена

constructor Create(CurrentRights:string);

// создает массив правил RightsClass из строки прав.

Destructor destroy;

Function GetString:string;

// Создает строку правил из массива правил

Procedure ConcatWith(const Plus:TrightData);overload;

// Складывает правила текущее с правилом Plusж

Procedure ConcatWith(const s:string);overload;

// Складывает правила текущее с троковым выражением правила

function Equal(a,b: TrightData) : Boolean;

// проверяет вхождение правила b в правило а

Function IsNull:boolean;

// возращает true если правило пустое.

end;

Данный модуль будет работоспособен в версии Delphi 6,7,2005,2007, 2009 и может быть легко использован в уже готовой программе без значительных доработок.