{------------------------------------------------------------------------------}
{
   Unit Name: security
   Purpose  : To keep track for security codes for controls
              Security includes enabled level and visibility
   Author   : Vesa Lappalainen
   Date     : 02.10.1999
   Changed  : 20.02.2000
     + jokin vika purkamisessa??? SecurityControl ei poistuessaan
       Unjoinannut muita...
   Changed  : 21.04.2000
     + Forms-lista
     + listoihin jokerit ja - -operaatio
     + TkSpeedButton kun disabled
     + TMenuItem
     + TAction
     + sarakkeiden leveys säädettäväksi
     + näytä muutettava komponentti
   Changed  : 23.04.2000
     + kParam enabled näkyväksi
     + Korjattu: Ei enää tuo päällimmäiseksi valittua vektinta?
     + Korjattu: sytyttää jopa jonkin formin turhan takia (johtui siitä että
       formin omisti toinen formi, kiellettiin formit)
     + kielletty timerit (enabled => käynistyy omia aikojaan)
     + Labelit ja Panelit oletuksena 0-tasolle
   Changed  : 24.04.2000
     + ExtraComp -komponentit formin omistukseen
     + korjattu: välkyttää komponentteja muutoksen aikana
     + korjattu: alkukäynnistyksessä turha disbaled käynti?
       korjaus: asetetaan ensin haluttu taso
   Changed  : 05.07.2000
     + jos jokin alainen muutetaan, niin isäntä lasketaan tälle tasolle
     + Cancel ja OK nappulat auomaattisesti tasolle 0 (oletuksena)
       (pitää olla ModalResult <> mrNone tai Cancel := True)
   Changed  : 07.07.2000
     + muiden toimintojen muuttamat näkyvyydet yms.
       eli suoritetaan NotifySecurityScan
     + talletus vain kun Item-muuttuu, ei kaikkien itemien talletusta
     + nopeampi luku
   Changed  : 08.07.2000
     + tyypin oletus suojaus tyypin nimen viereen components listassa
       muodossa TButton=0;0
     + oletusten lukeminen myös .sec-tiedostosta
     + Korjattu: ei muuta suojauksia oikein ensimmäisellä sisäänmenolla?
     + käyttäjän salasanan käsittely (KUsers.pas)
   Changed  : 20.05.2003
     + if item is removed, its is also removed from items list

   Usage: Add to on form (FormUser) TSecurituControl -item.
          Then call
            SecurityControl1.UserSecurityLevel := SecurityLevel;
            SecurityControl1.AddAll;
          where SecurityLevel is the needed security level for
          current user.  AddAll will add a new TSecurityForForm
          -component for every form that does not have one.
          During AddAll an .sec-file is read.  The format of
          .sec file is:

[Security-Names]
!*Button*=7;4             - all buttons default to 7;4
-ButtonUser=0             - ButtonUser not added to any form (everybody can use)

[FormSectest3-SecurityComponents]
!TButton=2;0              - all buttons with def sec 2;0 

[FormSectest3-SecurityNames]
ButtonOK=0;0              - ButtonOK added to this form

[Security-FormUsers]      - this is filled by SecurityForm
SavePos1=4;0
DBNavigator2=0;0
[Security-FormSecTest]
kSpeedButton1=5;2
SpeedButton1=6;5
ButtonEditSec=4;0
[Security-FormSectest3]
Scale1=3;0
Button2=3;4
GroupBox1=0;0

   ToDo     :
     -- jos PanelDisabloitu, niin disabloidut komponentit näkyvät
        silti enabloituina?
}
{------------------------------------------------------------------------------}


unit security;

interface

uses sysutils,classes,IniFiles,controls,IniName, forms, grids, menus,ActnList;

type
  TSecurityForForm = class;
  TSecurityControl = class;
  TkSecurity = class;

  TNotifySecurity = procedure (sender : TkSecurity; var def:boolean) of object;
  TNotifySecurityScan = procedure (sender : TSecurityControl) of object;


  TkSecurity = class(TPersistent)
  private
    FLevel: integer;
    FormSecurity : TSecurityForForm;
    FItemToControl: TComponent;
    FVisibility: integer;
    function GetLevelProp : string;
    function GetVisibilityProp : string;
  protected
    procedure SetLevel(const Value: integer); virtual;
    procedure SetItemToControl(const Value: TComponent); virtual;
    function GetAsString: string; virtual;
    procedure SetAsString(const Value: string); virtual;
    procedure SetAsStringNoChange(const Value: string); virtual;
    procedure SetVisibility(const Value: integer); virtual;
    function GetVisibilityAsString: string; virtual;
    procedure SetVisibilityAsString(const Value: string); virtual;
    procedure SetLevelAsString(const Value: string); virtual;
    function GetLevelAsString: string; virtual;
    function GetOnLevel: TNotifySecurity; virtual;
    function GetOnVisibility: TNotifySecurity; virtual;
    procedure SetOnLevel(const Value: TNotifySecurity); virtual;
    procedure SetOnVisibility(const Value: TNotifySecurity); virtual;
    function GetLevelProperty: string; virtual;
    function GetVisibilityProperty: string; virtual;
    procedure SetLevelProperty(const Value: string); virtual;
    procedure SetVisibilityProperty(const Value: string); virtual;
  public
    constructor Create(fs:TSecurityForForm;AItemToControl: TComponent;const defsec:string='');  overload; virtual;
    destructor  Destroy;                   override;
    function HasRights : boolean; virtual;
    function HasVisibility : boolean; virtual;
    procedure Save(ini:TIniFile); virtual;
    procedure Read(ini:TIniFile); virtual;
    procedure UpdateRow(row:TStrings); virtual;
    procedure UpdateValue(row:TStrings); virtual;
    procedure EditLevel(row:TStrings); virtual;
    procedure EditVisibility(row: TStrings);
    procedure SetValue(row:TStrings;key:char;mode:integer); virtual;
    property AsString : string read GetAsString write SetAsString;
    property VisibilityAsString : string read GetVisibilityAsString write SetVisibilityAsString;
    property LevelAsString : string read GetLevelAsString write SetLevelAsString;
    procedure SetItem(e,v:boolean); overload; virtual;
    procedure SetItem; overload; virtual;
    function CheckParents(ini:TIniFile):boolean; virtual;
    function ItemName : string;
  published
    property Level:integer read FLevel write SetLevel;
    property Visibility:integer read FVisibility write SetVisibility;
    property ItemToControl : TComponent read FItemToControl write SetItemToControl;
    property LevelProperty : string read GetLevelProperty write SetLevelProperty;
    property VisibilityProperty : string read GetVisibilityProperty write SetVisibilityProperty;
    property OnLevel : TNotifySecurity read GetOnLevel write SetOnLevel;
    property OnVisibility : TNotifySecurity read GetOnVisibility write SetOnVisibility;
  end;

  TkSecurityLevel = class(TkSecurity)
  private
    FLevelProperty : string;
    FVisibilityProperty : string;
    FOnVisibility: TNotifySecurity;
    FOnLevel: TNotifySecurity;
  protected
    procedure SetLevel(const Value: integer); override;
    procedure SetVisibility(const Value: integer); override;
    function GetOnLevel: TNotifySecurity; override;
    function GetOnVisibility: TNotifySecurity; override;
    procedure SetOnLevel(const Value: TNotifySecurity); override;
    procedure SetOnVisibility(const Value: TNotifySecurity); override;
  public
    constructor Create(fs:TSecurityForForm;AItemToControl: TComponent; const defsec:string = ''); override; 
    function GetLevelProperty: string; override;
    function GetVisibilityProperty: string; override;
    procedure SetLevelProperty(const Value: string); override;
    procedure SetVisibilityProperty(const Value: string); override;
  end;

  TSecurityCollectionItem = class(TCollectionItem)
  private
    FSecurity: TkSecurity;
    function GetItemToControl: TComponent;
    function GetLevel: integer;
    function GetVisibility: integer;
    procedure SetItemToControl(const Value: TComponent);
    procedure SetLevel(const Value: integer);
    procedure SetVisibility(const Value: integer);
    function GetLevelProperty: string;
    function GetVisibilityProperty: string;
    procedure SetLevelProperty(const Value: string);
    procedure SetVisibilityProperty(const Value: string);
  protected
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Security : TkSecurity read FSecurity write FSecurity;
    function GetOnLevel: TNotifySecurity;
    function GetOnVisibility: TNotifySecurity;
    procedure SetOnLevel(const Value: TNotifySecurity);
    procedure SetOnVisibility(const Value: TNotifySecurity);
  published
    property Level : integer read GetLevel write SetLevel default 0;
    property Visibility : integer read GetVisibility write SetVisibility default 0;
    property ItemToControl : TComponent read GetItemToControl write SetItemToControl;
    property LevelProperty : string read GetLevelProperty write SetLevelProperty;
    property VisibilityProperty : string read GetVisibilityProperty write SetVisibilityProperty;
    property OnLevel : TNotifySecurity read GetOnLevel write SetOnLevel;
    property OnVisibility : TNotifySecurity read GetOnVisibility write SetOnVisibility;
  end;

  TSecurityCollection = class(TCollection)
  private
    FSecurityForForm : TSecurityForForm;
    function GetItem(index: integer): TSecurityCollectionItem;
    procedure SetItems(index: integer; const Value: TSecurityCollectionItem);

  protected
    function GetOwner : TPersistent; override;
  public
    constructor Create(AOwner:TSecurityForForm);
    function Add : TSecurityCollectionItem;
    property Items[index:integer] : TSecurityCollectionItem read GetItem write SetItems;
  published
  end;

  TSecurityForForm = class(TComponent)
  private
    FList : TList;
    FAddFromSecurity : boolean;
    FSecurityControl : TSecurityControl;
    FComponents: TStrings;
    FNames: TStrings;
    FItems: TSecurityCollection;
    FDefaultSecurity : string;
    procedure SetSecurityControl(const Value: TSecurityControl);
    procedure SetComponents(const Value: TStrings);
    function GetDefaultSecurity: string;
    procedure SetDefaultSecurity(const Value: string);
    function GetFormName: string;
    procedure SetItems(const Value: TSecurityCollection);
    procedure ClearList;
    procedure SetNames(const Value: TStrings);
    procedure Scan;
    function FindSecurity(const c: TComponent): TkSecurity;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    function  HasRights(i:integer) : boolean; virtual;
    constructor Create(AOwner : TComponent);  override;
    destructor  Destroy;                   override;
    procedure AddAll; virtual;
    procedure Save(ini:TIniFile); virtual;
    procedure Read(ini:TIniFile); virtual;
    procedure ReadFast(ini:TIniFile); virtual;
    function UpdateGrid(grid:TstringGrid):TForm; virtual;
    function FindDefaultSecurity:string; virtual;
  published
    property DefaultSecurity : string read GetDefaultSecurity write SetDefaultSecurity;
    property SecurityControl : TSecurityControl read FSecurityControl write SetSecurityControl;
    property Components : TStrings read FComponents write SetComponents;
    property Names : TStrings read FNames write SetNames;
    property FormName : string read GetFormName;
    property Items : TSecurityCollection read FItems write SetItems;
    property AddFromSecurity : boolean read FAddFromSecurity write FAddFromSecurity default true;
  end;

  TSecurityControl = class(TComponent)
  private
    FList : TList;
    FUserSecurityLevel: integer;
    FDefaultSecurity: string;
    FNotifySecurityScan:TNotifySecurityScan;
    FComponents: TStrings;
    FNames: TStrings;
    FForms: TStrings;
    FIni : TIniFile;
    FSecurityForm:TForm;
    procedure SetDefaultSecurity(const Value: string);
    procedure SetUserSecurityLevel(const Value: integer);
    procedure SetComponents(const Value: TStrings);
    procedure SetForms(const Value: TStrings);
    procedure SetNames(const Value: TStrings);
    procedure Scan;
  public
    function SecurityValue(i:integer) : integer; virtual;
    function HasRights(i:integer) : boolean; virtual;
    constructor Create(AOwner : TComponent);  override;
    destructor  Destroy;                   override;
    procedure Join(fs:TSecurityForForm);  virtual;
    procedure UnJoin(fs:TSecurityForForm); virtual;
    procedure Save; virtual;
    procedure Read; virtual;
    procedure AddAll; virtual;
    procedure Edit(modal:boolean = true); virtual;
    procedure AddToList(st:TStrings); virtual;
    function UpdateGrid(grid:TStringGrid; c:TObject):TForm; virtual;
    procedure UpdateValue(row:TStrings); virtual;
    function EditLevel(row:TStrings):boolean; virtual;
    function EditVisibility(row: TStrings): boolean;
    function SetLevel(row:TStrings;key:char;mode:integer):boolean; virtual;
    procedure FormClose;
  published
    property DefaultSecurity : string read FDefaultSecurity write SetDefaultSecurity;
    property UserSecurityLevel : integer read FUserSecurityLevel write SetUserSecurityLevel;
    property Components : TStrings read FComponents write SetComponents;
    property Names : TStrings read FNames write SetNames;
    property Forms : TStrings read FForms write SetForms;
    property NotifySecurityScan:TNotifySecurityScan read FNotifySecurityScan write FNotifySecurityScan;
  end;

  procedure Register;

implementation
uses SecurityForm,numerot,kdouble,kstring, comctrls,stdctrls,extctrls,
     DbTables,db,kPropFunc;

{ TkSecurity }

{------------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('Kave2000', [TSecurityForForm]);
  RegisterComponents('Kave2000', [TSecurityControl]);
end;

constructor TkSecurity.Create(fs:TSecurityForForm;AItemToControl: TComponent; const defsec:string);
begin
  inherited Create;
  ItemToControl := AItemToControl;
  FormSecurity := fs;
  FLevel := 0;
  FVisibility := 0;

  if ( defsec ='' ) then SetAsStringNoChange(FormSecurity.FindDefaultSecurity)
                    else SetAsStringNoChange(defsec);

  if ( defsec = '' ) and (
    ( AItemToControl is TPanel ) or
    ( AItemToControl is TLabel ) or
    ( AItemToControl is TQuery ) or
    ( AItemToControl is TDataSource ) or
    ( AItemToControl is TToolBar ) ) then
    FLevel := 0;
  if ( ItemToControl is TButton ) then with TButton(ItemToControl) do begin
    if ( ModalResult <> mrNone ) then FLevel := 0;
    if ( Cancel ) then FLevel := 0;
  end;
end;

destructor TkSecurity.Destroy;
begin
  inherited;
end;

procedure TkSecurity.EditLevel(row: TStrings);
var i:integer;
begin
  i := Level;
  if not AskIValue('Give security for ' + Row[0],i,0,10) then exit;
  Level := i;
  UpdateRow(row);
end;

procedure TkSecurity.EditVisibility(row: TStrings);
var i:integer;
begin
  i := Visibility;
  if not AskIValue('Give visibility for ' + Row[0],i,0,20) then exit;
  Visibility := i;
  UpdateRow(row);
end;

function TkSecurity.GetAsString: string;
begin
  Result := LevelAsString + ';' + VisibilityAsString;
end;

function TkSecurity.GetLevelAsString: string;
begin
  Result := IntToStr(Level);
end;

function TkSecurity.GetVisibilityAsString: string;
begin
  Result := IntToStr(Visibility);
end;

function TkSecurity.HasRights: boolean;
begin
  Result := FormSecurity.HasRights(Level);
end;

function TkSecurity.HasVisibility: boolean;
begin
  Result := FormSecurity.HasRights(Visibility);
end;

procedure TkSecurity.Read(ini: TIniFile);
begin
  if ( ItemToControl = nil ) then exit;
  AsString := IniReadString(ini,'Security-'+FormSecurity.FormName,ItemToControl.Name,'');
//  Level := ExtractInt(s,';',FormSecurity.FindDefaultSecurity);
end;

procedure TkSecurity.Save(ini: TIniFile);
begin
  if ( ItemToControl = nil ) then exit;
  IniWriteString(ini,'Security-'+FormSecurity.FormName,ItemToControl.Name,AsString);
end;

procedure TkSecurity.SetAsStringNoChange(const Value: string);
var s:string;
begin
  s := Value;
  FLevel := ExtractInt(s,';',Level);
  FVisibility := ExtractInt(s,';',Visibility);
end;


procedure TkSecurity.SetAsString(const Value: string);
var s:string;
begin
  s := Value;
  Level := ExtractInt(s,';',Level);
  Visibility := ExtractInt(s,';',Visibility);
end;

procedure TkSecurity.SetValue(row: TStrings; key: char; mode: integer);
var s:string;
begin
  s := key;
  if ( key = ' ' ) then s := '0';
  if ( key = '-' ) then s := '-1';
  if ( mode and 1 = 1 ) then Level := StrToIntDef(key,Level);
  if ( mode and 2 = 2 ) then Visibility := StrToIntDef(key,Visibility);
  UpdateRow(row);
end;

procedure TkSecurity.SetLevelAsString(const Value: string);
begin
  Level := StrToIntDef(Value,Level);
end;

procedure TkSecurity.SetItemToControl(const Value: TComponent);
begin
  FItemToControl := Value;
end;

function TkSecurity.ItemName: string;
begin
  Result := '';
  if ( ItemToControl <> nil ) then Result := ItemToControl.Name;
end;

function TkSecurity.GetLevelProp: string;
begin
  if ( LevelProperty <> '' ) then Result := LevelProperty
  else Result := 'Enabled';
end;

function TkSecurity.GetVisibilityProp: string;
begin
  if ItemToControl is TTabSheet then begin
    Result := 'TabVisible';
    Exit;
  end;

  if ( VisibilityProperty <> '' ) then Result := VisibilityProperty
  else Result := 'Visible';
end;

procedure TkSecurity.SetLevel(const Value: integer);
begin
  FLevel := Value;
  if ( ItemToControl = nil ) then exit;
  SetBooleanProperty(ItemToControl,GetLevelProp,HasRights);
(*
  if ( ItemToControl is TControl ) then
    TControl(ItemToControl).Enabled := HasRights;
  if ( ItemToControl is TMenuItem ) then
    TMenuItem(ItemToControl).Enabled := HasRights;
  if ( ItemToControl is TAction ) then
    TAction(ItemToControl).Enabled := HasRights;
*)
end;

procedure TkSecurity.SetVisibility(const Value: integer);
begin
  FVisibility := Value;
  if ( ItemToControl = nil ) then exit;
  SetBooleanProperty(ItemToControl,GetVisibilityProp,HasVisibility);
(*
  if ( ItemToControl is TControl ) then
    TControl(ItemToControl).Visible := HasVisibility;
  if ( ItemToControl is TMenuItem ) then
    TMenuItem(ItemToControl).Visible := HasVisibility;
  if ( ItemToControl is TAction ) then
    TAction(ItemToControl).Visible := HasVisibility;
*)
end;

procedure TkSecurity.SetItem;
begin
  SetBooleanProperty(ItemToControl,GetLevelProp,HasRights);
  SetBooleanProperty(ItemToControl,GetVisibilityProp,HasVisibility);
end;

procedure TkSecurity.SetItem(e, v: boolean);
begin
  SetBooleanProperty(ItemToControl,GetLevelProp,e);
  SetBooleanProperty(ItemToControl,GetVisibilityProp,v);
end;

procedure TkSecurity.SetVisibilityAsString(const Value: string);
begin
  self.Visibility := StrToIntDef(Value,self.Visibility);
end;

procedure TkSecurity.UpdateValue(row: TStrings);
begin
  AsString := row[3];
  VisibilityAsString := row[4];
  UpdateRow(row);
end;

procedure TkSecurity.UpdateRow(row: TStrings);
begin
  if ( ItemToControl = nil ) then exit;
  row[0] := ItemToControl.Name;
  row[1] := GetStringProperty(ItemToControl,'Hint',''); //ItemToControl.Hint;
  row[2] := GetStringProperty(ItemToControl,'AsString','');
  row[3] := LevelAsString;
  row[4] := VisibilityAsString;
end;

function TkSecurity.GetOnLevel: TNotifySecurity;
begin
  Result := nil;
end;

function TkSecurity.GetOnVisibility: TNotifySecurity;
begin
  Result := nil;
end;

procedure TkSecurity.SetOnLevel(const Value: TNotifySecurity);
begin
end;

procedure TkSecurity.SetOnVisibility(const Value: TNotifySecurity);
begin
end;


function TkSecurity.GetLevelProperty: string;
begin
  Result := '';
end;

function TkSecurity.GetVisibilityProperty: string;
begin
  Result := '';
end;

procedure TkSecurity.SetLevelProperty(const Value: string);
begin

end;

procedure TkSecurity.SetVisibilityProperty(const Value: string);
begin

end;

function TkSecurity.CheckParents(ini:TIniFile):boolean;
// Returns true if parent level changed
var p: TControl; s : TkSecurity;
begin
  Result := false;
  if not ( ItemToControl is TControl ) then exit;
  p := TControl(ItemToControl);
  while ( true ) do begin
    p := p.Parent;
    if ( p = nil ) then exit;
    s := FormSecurity.FindSecurity(p);
    if ( s <> nil ) and ( s.Level > Level ) then begin
      s.Level := Level; Result := true;
      s.Save(ini);
    end;
  end;
end;

{ TSecurityForForm }

constructor TSecurityForForm.Create(AOwner: TComponent);
begin
  inherited;
  Flist := TList.Create;
  FAddFromSecurity := true;
  FComponents := TStringList.Create;
  FNames := TStringList.Create;
  FItems := TSecurityCollection.Create(self);
  Name := 'SecurityForForm';
  FDefaultSecurity := '';
end;

procedure TSecurityForForm.ClearList;
var i:integer;
begin
  for i:=0 to FList.Count-1 do TkSecurity(FList.Items[i]).Free; FList.Clear;
end;

function TSecurityForForm.FindSecurity(const c:TComponent):TkSecurity;
var i:integer;
begin
  Result := nil;
  for i:=0 to FList.Count-1 do
    if ( TkSecurity(FList.Items[i]).ItemToControl = c ) then begin
      Result := TkSecurity(FList.Items[i]);
      Exit;
    end;
end;

destructor TSecurityForForm.Destroy;
begin
  ClearList;
  SecurityControl := nil;
  FItems.Free;
  FList.Free;
  FNames.Free;
  FComponents.Free;
  inherited;
end;

function TSecurityForForm.FindDefaultSecurity: string;
begin
  if ( SecurityControl = nil ) or ( FDefaultSecurity <> '' ) then
    Result := FDefaultSecurity
  else
    Result := SecurityControl.DefaultSecurity;
end;

function TSecurityForForm.GetDefaultSecurity: string;
begin
  Result := FDefaultSecurity;
end;

function TSecurityForForm.GetFormName: string;
begin
  Result := Owner.Name;
end;

function TSecurityForForm.HasRights(i: integer): boolean;
begin
 Result := SecurityControl.HasRights(i);
end;

procedure TSecurityForForm.Read(ini:TIniFile);
var i:integer;
begin
  ini := TIniFile.Create(GetIniName('.sec'));
  for i:=0 to FList.Count-1 do
    TkSecurity(FList.Items[i]).Read(ini);
  for i:=0 to Items.Count-1 do
    Items.Items[i].Security.Read(ini);
end;

procedure TSecurityForForm.ReadFast(ini: TIniFile);
var st : TStrings;
  procedure CheckSection;
  var i:integer; s: string; ts : TkSecurity;
  begin
    for i:=0 to FList.Count-1 do begin
      ts := FList.Items[i];
      s := st.Values[ts.ItemName];
      if ( s <> '' ) then ts.AsString := s;
    end;
    for i:=0 to Items.Count-1 do begin
      ts := Items.Items[i].Security;
      s := st.Values[ts.ItemName];
      if ( s <> '' ) then ts.AsString := s;
    end;
  end;
begin
  st := TStringList.Create;
  ini.ReadSectionValues('Security-'+FormName,st);
  if ( st.Count <> 0 ) then CheckSection;
  st.Free;
end;


procedure TSecurityForForm.Save(ini:TIniFile);
var i:integer;
begin
  for i:=0 to FList.Count-1 do
    TkSecurity(FList.Items[i]).Save(ini);
  for i:=0 to Items.Count-1 do
    Items.Items[i].Security.Save(ini);
end;

function DefSec(const n:string):string;
var i:integer;
begin
  Result := '';
  i := Pos('=',n);
  if ( i = 0 ) then exit;
  Result := copy(n,i+1,100);
end;

function UpName(const s:string):string;
var i:integer;
begin
  Result := UpperCase(s);
  i := Pos('=',Result); if  ( i > 0 ) then delete(Result,i,1000);
end;

function PosInList(st:TStrings;const s:string; var lastdef:string):integer;
var i:integer; sec,mask,su:string; p : integer;
begin
  Result := -1;
  if ( st.Count = 0 ) then exit;
  su := UpName(s);
  lastdef := '';
  for i:=0 to st.Count-1 do begin
    mask := UpName(st[i]);
    if length(mask) <= 0 then continue;
    if mask[1] = '+' then delete(mask,1,1);
    p := i;
    if mask[1] = '-' then begin delete(mask,1,1); p := -10-i; end;
    if mask[1] = '!' then begin delete(mask,1,1); p := 10000; end;
    if ( wildmat(mask,su) ) then begin
      if ( p >= 0 ) then begin
        sec := DefSec(st[i]); if sec <> '' then lastdef := sec;
      end;
      if ( p < 10000 ) then Result := p;
    end
  end;
end;

(*
function ExactPosInList(st:TStrings;const s:string; var lastp,lastn : Integer):integer;
var i:integer; mask,su:string; p : integer;
begin
  Result := -1;
  lastp := -1;
  lastn := -1;
  if ( st.Count = 0 ) then exit;
  su := UpperCase(s);
  i := Pos('=',su); if ( i > 0 ) then delete(su,i,1000);
  if su = '' then exit;
  if ( su[1] = '+' ) then delete(su,1,1);
  if su = '' then exit;

  for i:=0 to st.Count-1 do begin
    mask := UpperCase(st.Names[i]);
    if length(mask) <= 0 then continue;
    if mask[1] = '+' then delete(mask,1,1);
    p := i;
    if mask[1] = '-' then begin delete(mask,1,1); p := -10-i; end;
    if ( mask = su ) then begin
      if ( p >= 0 ) then lastp := i
                    else lastn := i;
      Result := p;
    end;
  end;
end;
*)

procedure TSecurityForForm.Scan;
var i:integer;
begin
  for i:=0 to FList.Count-1 do
    TkSecurity(FList.Items[i]).SetItem;
  for i:=0 to Items.Count-1 do
    Items.Items[i].Security.SetItem;
end;


procedure AddStrings(st:TStrings; const sl:TStrings);
begin
  st.AddStrings(sl);
end;
(*
   Alkup. suunnitelma:
   Jos lista ennestään
     -Button*
     ButtonOK
     ButtonCancel=0;0

   - lisätään ButtonOK=0;0 niin uutta ei lisätä, vaan muutetaan vanha
   - lisätään Button*, ei lisätä vaan korvataan vanha -Button*
   - lisätään -ButtonOK, ei lisätä vaan korvataan ButtonOK
   - lisätään ButtonDelete, niin se lisätään ihan rehellisesti

   Toistaiseksi kaikki lisätään ilman muuta, koska
   PosInList kertoo kyllä viimeisen oletussuojauksen.
   Suunnitelmassa oli ongelmana mitä tehdään suojauksille jos -muotoinen
   tuhoaa sellaisen, jolla on oletussuojaus.

var i,p,lastp,lastn:integer;
begin
  for i:=0 to sl.Count-1 do begin
    if ( sl[i] = '' ) then exit;
    p := ExactPosInList(st,sl[i],lastp,lastn);
    if ( p = - 1 ) then begin                            // ei ole ennestään
      st.Add(sl[i]);
      continue;
    end;

    if ( p < 0 ) then begin                              // negat ennestään
      if ( sl[i][1] = '-' ) then continue;               // negat on jo
      if ( lastp >= 0 ) then begin          // on negat, mutta myös pos
        if ( DefSec(st[lastp]) <> '' ) and DefSec(sl[i]) = '' )
          then st.Add(st[lastp])            // vanhassa oletus, uudessa ei
          else st.Add(sl[i]);               // vanhassa ei tai uudessa on
        st.Delete(lastp);                   // vanha joutaa pois
        continue;
      end;
      st.Add(sl[i]);
    end;
  end;
end;
*)


procedure AddIni(st:TStrings;const sec:String; const name:string; const sc:TSecurityControl);
var sl : TStrings;
begin
  if ( sc = nil ) then exit;
  sl := TStringList.Create;
  sc.FIni.ReadSectionValues(name+'-'+sec,sl);
  AddStrings(st,sl);
  sl.Free;
end;

procedure TSecurityForForm.Notification(AComponent: TComponent;
  Operation: TOperation);
// if item to control is removed, then removed it also from secure list
var i:integer;
begin
  inherited Notification(AComponent, Operation);
  if (Operation <> opRemove) then exit;
  if ( csDestroying in Owner.ComponentState ) then exit;
  for i:= 0 to Items.Count-1 do
    if ( Items.Items[i].ItemToControl = AComponent ) then begin
      Items.Items[i].Free;
      Items.Delete(i);
      exit;
    end;
  for i:= 0 to FList.Count-1 do
    if ( TkSecurity(FList.Items[i]).ItemToControl = AComponent ) then begin
      TkSecurity(FList.Items[i]).Free;
      FList.Delete(i);
      exit;
    end;
end;


procedure TSecurityForForm.AddAll;
var i,ci:integer;  c: TComponent; typesec,namesec:string;
    scmps,snames : TStrings;

  procedure AddSec(c:TComponent; const defsec:string);
  var i:integer;
  begin
    for i:= 0 to Items.Count-1 do
      if ( Items.Items[i].ItemToControl = c ) then begin
//        Items.Items[i].Security.SetAsStringNoChange(defsec);
        exit;
      end;
    FList.Add(TkSecurity.Create(self,c,defsec));
    c.FreeNotification(self);
  end;

begin
  if ( Owner = nil ) then exit;
  ClearList;

  scmps := TStringList.Create;
  snames := TStringList.Create;
  if ( AddFromSecurity  ) and ( SecurityControl <> nil ) then
    AddStrings(snames,SecurityControl.Names);
  if ( AddFromSecurity  ) and ( SecurityControl <> nil ) then
    AddStrings(scmps,SecurityControl.Components);
  scmps.AddStrings(Components);
  snames.AddStrings(Names);
  AddIni(scmps,'SecurityComponents',Owner.Name,SecurityControl);
  AddIni(snames,'SecurityNames',Owner.Name,SecurityControl);
  for i:=0 to Owner.ComponentCount-1 do begin
//    if  not ( Owner.Components[i] is TComponent ) then continue;
//    c := TComponent(Owner.Components[i]);
    c := Owner.Components[i];
    if ( c = self ) then continue;
    if ( c is TForm ) then continue;
    if ( c is TTimer ) then continue;
    ci := PosInList(snames,c.name,namesec);
    if ( ci >= 0 ) then begin AddSec(c,namesec); continue; end;
    if ( ci < -1 ) then continue;
    ci := PosInList(scmps,c.ClassName,typesec);
    if ( namesec <> '' ) then typesec := namesec;
    if ( ci >= 0 ) then begin AddSec(c,typesec); continue; end;
  end;
  scmps.Free;
  snames.Free;
  if ( SecurityControl <> nil ) then
    ReadFast(SecurityControl.FIni);
//    Read(SecurityControl.FIni);
end;

procedure TSecurityForForm.SetComponents(const Value: TStrings);
begin
  FComponents.Assign(Value);
end;

procedure TSecurityForForm.SetDefaultSecurity(const Value: string);
begin
  FDefaultSecurity := Value;
end;


procedure TSecurityForForm.SetItems(const Value: TSecurityCollection);
begin
  FItems.Assign(Value);
end;

procedure TSecurityForForm.SetSecurityControl(const Value: TSecurityControl);
begin
  if ( FSecurityControl <> nil ) then
    FSecurityControl.UnJoin(self);
  FSecurityControl := Value;
  if ( Value <> nil ) then Value.Join(self);
end;

function TSecurityForForm.UpdateGrid(grid: TstringGrid) : TForm;
var i,ir:integer;
begin
  Result := nil;
  if ( FList = nil ) then exit;
  if ( grid = nil ) then exit;
  if ( Owner is TForm ) then Result := TForm(Owner);
  grid.RowCount := Flist.Count + Items.Count + 1;
  grid.Cells[0,0] := 'Name';
  grid.Cells[1,0] := 'Hint';
  grid.Cells[2,0] := 'Value';
  grid.Cells[3,0] := 'Level';
  grid.Cells[4,0] := 'Visibility';
  ir := 1;
  for i:=0 to Items.Count-1 do begin
    Items.Items[i].Security.UpdateRow(grid.Rows[ir]);
    grid.Objects[0,ir] := Items.Items[i].Security;
    Inc(ir);
  end;
  for i:=0 to FList.Count-1 do begin
    TkSecurity(FList.Items[i]).UpdateRow(grid.Rows[ir]);
    grid.Objects[0,ir] := FList.Items[i];
    Inc(ir);
  end;
end;


procedure TSecurityForForm.SetNames(const Value: TStrings);
begin
  FNames.Assign(Value);
end;



{ TSecurityControl }

procedure TSecurityControl.AddAll;
var i,fi:integer; fo:TForm; c : TComponent; defsec:string;
    SecurityForForm : TSecurityForForm;
begin
  SecurityForForm := nil;
  AddIni(Components,'Components','Security',self);
  AddIni(Names,'Names','Security',self);
  AddIni(Forms,'Forms','Security',self);
  for fi:=0 to Application.ComponentCount-1 do begin
    if ( not (Application.Components[fi] is TForm) ) then continue;
    fo := Application.Components[fi] as TForm;
    c := fo.FindComponent('SecurityForForm1');
    if ( c = nil ) then
      c := fo.FindComponent('SecurityForForm');

    if ( c <> nil ) then begin
      if ( not ( c is TSecurityForForm ) ) then continue;
      SecurityForForm := TSecurityForForm(c);
    end
    else begin
      if ( PosInList(Forms,fo.name,defsec) < 0 )  then continue;
      SecurityForForm := TSecurityForForm.Create(fo);
      SecurityForForm.DefaultSecurity := defsec;
    end;
    SecurityForForm.SecurityControl := self;
  end;
  for i:=0 to FList.Count-1 do begin
    TSecurityForForm(FList.Items[i]).AddAll;
  end;
  Scan;
//  if ( Assigned(NotifySecurityScan) ) then NotifySecurityScan(self);
end;

procedure TSecurityControl.AddToList(st: TStrings);
var i:integer;
begin
  st.Clear;
  if ( FList = nil ) then exit;
  for i:=0 to Flist.Count-1 do begin
    st.AddObject(TSecurityForForm(FList.Items[i]).FormName,FList.Items[i]);
  end;
end;

constructor TSecurityControl.Create(AOwner: TComponent);
begin
  inherited;
  Flist := TList.Create;
  FComponents := TStringList.Create;
  FForms := TStringList.Create;
  FNames := TStringList.Create;
  Forms.Add('*');
  Components.Add('*');
  FUserSecurityLevel := 0;
  FDefaultSecurity := '4';
  FIni := TIniFile.Create(GetIniName('.sec'));
end;

destructor TSecurityControl.Destroy;
var i:integer;
begin
  if ( FSecurityForm <> nil ) then begin
    TFormSecurity(FSecurityForm).RepairForDestroy;
    FormClose;
  end;
  for i:=Flist.Count-1 downto 0 do begin
    TSecurityForForm(FList[i]).SecurityControl := nil;
  end;
  FIni.Free;
  FList.Free;
  FForms.Free;
  FNames.Free;
  FComponents.Free;
  inherited;

end;

procedure TSecurityControl.Edit(modal:boolean);
begin
  if ( FSecurityForm <> nil ) then exit;
  FSecurityForm := TFormSecurity.Create(self);
  if ( modal ) then begin
    FSecurityForm.ShowModal;
//    FSecurityForm.Free;
//    FSecurityForm := nil;
    exit;
  end;
  FSecurityForm.Show;
end;

procedure TSecurityControl.FormClose;
begin
  if ( FSecurityForm = nil ) then exit;
  FSecurityForm.Release;
  FSecurityForm := nil;
end;

function TSecurityControl.EditLevel(row: TStrings):boolean;
var sec : TkSecurity;
begin
  Result := false;
  if not ( row.Objects[0] is TkSecurity ) then exit;
  sec := TkSecurity(row.Objects[0]);
  sec.EditLevel(row);
  Result := sec.CheckParents(FIni);
  sec.Save(FIni);
end;

function TSecurityControl.EditVisibility(row: TStrings):boolean;
var sec : TkSecurity;
begin
  Result := false;
  if not ( row.Objects[0] is TkSecurity ) then exit;
  sec := TkSecurity(row.Objects[0]);
  sec.EditVisibility(row);
  Result := sec.CheckParents(FIni);
  sec.Save(FIni);
end;

function TSecurityControl.HasRights(i: integer): boolean;
begin
  Result := UserSecurityLevel >= SecurityValue(i);
end;

procedure TSecurityControl.Join(fs: TSecurityForForm);
var i:integer;
begin
  if ( fs = nil ) then exit;
  i := FList.IndexOf(fs);
  if ( i >= 0 ) then exit;
  FList.Add(fs);
end;

procedure TSecurityControl.Read;
var i:integer;
begin
  for i:=0 to FList.Count-1 do begin
    TSecurityForForm(FList.Items[i]).ReadFast(FIni);
  end;
end;

procedure TSecurityControl.Save;
var i:integer;
begin
  for i:=0 to FList.Count-1 do begin
    TSecurityForForm(FList.Items[i]).save(FIni);
  end;
end;


procedure TSecurityControl.Scan;
var i:integer;
begin
  for i:=0 to FList.Count-1 do begin
    TSecurityForForm(FList.Items[i]).Scan;
  end;
  if ( Assigned(NotifySecurityScan) ) then NotifySecurityScan(self);
end;

function TSecurityControl.SecurityValue(i: integer): integer;
var s:string;
begin
  Result := i;
  if ( i < 0 ) then begin
    s := DefaultSecurity;
    Result := ExtractInt(s,';',4);
  end;
end;


procedure TSecurityControl.SetComponents(const Value: TStrings);
begin
  FComponents.Assign(Value);
end;

procedure TSecurityControl.SetDefaultSecurity(const Value: string);
begin
  if ( self = nil ) then exit;
  FDefaultSecurity := Value;
end;

procedure TSecurityControl.SetForms(const Value: TStrings);
begin
  FForms.Assign(Value);
end;

function TSecurityControl.SetLevel(row: TStrings; key: char; mode:integer):boolean;
begin
  Result := false;
  if not ( row.Objects[0] is TkSecurity ) then exit;
  TkSecurity(row.Objects[0]).SetValue(row,key,mode);
  Result := TkSecurity(row.Objects[0]).CheckParents(FIni);
  TkSecurity(row.Objects[0]).Save(FIni);
end;

procedure TSecurityControl.SetNames(const Value: TStrings);
begin
  FNames.Assign(Value);
end;

procedure TSecurityControl.SetUserSecurityLevel(const Value: integer);
begin
  if ( self = nil ) then exit;
  if ( UserSecurityLevel = Value ) then exit;
  FUserSecurityLevel := Value;
  Scan;
end;

procedure TSecurityControl.UnJoin(fs: TSecurityForForm);
begin
  if ( fs = nil ) then exit;
  FList.Remove(fs);
end;


function TSecurityControl.UpdateGrid(grid: TStringGrid; c: TObject):TForm;
begin
  Result := nil;
  if ( grid = nil ) or ( not (c is TSecurityForForm) ) then exit;
  Result := TSecurityForForm(c).UpdateGrid(grid);
end;

procedure TSecurityControl.UpdateValue(row: TStrings);
begin
  if not ( row.Objects[0] is TkSecurity ) then exit;
  TkSecurity(row.Objects[0]).UpdateValue(row);
end;

{ TCISecurity }

constructor TSecurityCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  FSecurity := TkSecurityLevel.Create(TSecurityForForm(TSecurityCollection(Collection).GetOwner),nil);
end;

destructor TSecurityCollectionItem.Destroy;
begin
  Security.Free;
  inherited;
end;

function TSecurityCollectionItem.GetItemToControl: TComponent;
begin
  Result := Security.ItemToControl;
end;

function TSecurityCollectionItem.GetLevel: integer;
begin
  Result := Security.Level;
end;

function TSecurityCollectionItem.GetLevelProperty: string;
begin
  Result := Security.LevelProperty;
end;

function TSecurityCollectionItem.GetOnLevel: TNotifySecurity;
begin
  Result := Security.OnLevel;
end;

function TSecurityCollectionItem.GetOnVisibility: TNotifySecurity;
begin
  Result := Security.OnVisibility;
end;

function TSecurityCollectionItem.GetVisibility: integer;
begin
  Result := Security.Visibility;
end;

function TSecurityCollectionItem.GetVisibilityProperty: string;
begin
  Result := Security.VisibilityProperty;
end;

procedure TSecurityCollectionItem.SetItemToControl(const Value: TComponent);
begin
  Security.ItemToControl := Value;
end;

procedure TSecurityCollectionItem.SetLevel(const Value: integer);
begin
  Security.Level := Value;
end;

procedure TSecurityCollectionItem.SetLevelProperty(const Value: string);
begin
  Security.LevelProperty := Value;
end;

procedure TSecurityCollectionItem.SetOnLevel(const Value: TNotifySecurity);
begin
  Security.OnLevel := Value;
end;

procedure TSecurityCollectionItem.SetOnVisibility(
  const Value: TNotifySecurity);
begin
  Security.OnVisibility := Value;
end;

procedure TSecurityCollectionItem.SetVisibility(const Value: integer);
begin
  Security.Visibility := Value;
end;

procedure TSecurityCollectionItem.SetVisibilityProperty(
  const Value: string);
begin
  Security.VisibilityProperty := Value;
end;

{ TSecurityCollection }

function TSecurityCollection.Add: TSecurityCollectionItem;
begin
  Result := TSecurityCollectionItem(inherited Add);
end;

constructor TSecurityCollection.Create(AOwner: TSecurityForForm);
begin
  inherited create(TSecurityCollectionItem);
  FSecurityForForm := AOwner;
end;

function TSecurityCollection.GetItem(
  index: integer): TSecurityCollectionItem;
begin
  Result := TSecurityCollectionItem(inherited Items[Index]);
end;

function TSecurityCollection.GetOwner: TPersistent;
begin
  Result := FSecurityForForm;
end;

procedure TSecurityCollection.SetItems(index: integer;
  const Value: TSecurityCollectionItem);
begin
  Items[Index].Assign(Value);
end;

{ TkSecurityLevel }

constructor TkSecurityLevel.Create(fs: TSecurityForForm;
  AItemToControl: TComponent; const defsec:string);
begin
  inherited;
end;

function TkSecurityLevel.GetLevelProperty: string;
begin
  Result := FLevelProperty;
end;

function TkSecurityLevel.GetOnLevel: TNotifySecurity;
begin
  Result := FOnLevel;
end;

function TkSecurityLevel.GetOnVisibility: TNotifySecurity;
begin
  Result := FOnVisibility;
end;

function TkSecurityLevel.GetVisibilityProperty: string;
begin
  Result := FVisibilityProperty;
end;

procedure TkSecurityLevel.SetLevel(const Value: integer);
begin
  if ( LevelProperty = '' ) and ( not Assigned(FOnLevel) ) then begin
    inherited;
    exit;
  end;

end;

procedure TkSecurityLevel.SetLevelProperty(const Value: string);
begin
  FLevelProperty := Value;
end;

procedure TkSecurityLevel.SetOnLevel(const Value: TNotifySecurity);
begin
  FOnLevel := Value;
end;

procedure TkSecurityLevel.SetOnVisibility(const Value: TNotifySecurity);
begin
  FOnVisibility := Value;
end;

procedure TkSecurityLevel.SetVisibility(const Value: integer);
begin
  inherited;
  if ( VisibilityProperty = '' ) and ( not Assigned(OnVisibility) ) then begin
    inherited;
    exit;
  end;

end;

procedure TkSecurityLevel.SetVisibilityProperty(const Value: string);
begin
  FVisibilityProperty := value;
end;







end.