absecurity.pas

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

      if ftvSecurityTemplate.Items[i].Level = iLevel then
        if ftvSecurityTemplate.Items[i].Text = sCategoryItem then
        begin
          Result := ftvSecurityTemplate.Items[i];
          exit;
        end;
    Result := nil;
  end;

  procedure ParseTree(tn: TTreeNode);
  var
    tnChild: TTreeNode;
  begin
    if tn.Level = 0 then
    begin//Write header
      iByte := 1;
      msBlobSecurityTemplate.WriteBuffer(iByte, 1);//number of languages
      msBlobSecurityTemplate.WriteBuffer('GB'+ #0, 3);//language identifier
      iDWord := 0;
      msBlobSecurityTemplate.WriteBuffer(iDWord, 4);//size of the language related part of the blob (w/o header) - set up later
      iWord := tn.Count;
      msBlobSecurityTemplate.WriteBuffer(iWord, 2);//Number of level 1 nodes
    end
    else
    begin
      iWord := tn.Count;
      msBlobSecurityTemplate.WriteBuffer(iWord, sizeOf(iWord));//Number of children
      iWord := WORD(tn.Data);
      msBlobSecurityTemplate.WriteBuffer(iWord, sizeOf(iWord));//Self Security ID
      iWord := Length(tn.Text);
      msBlobSecurityTemplate.WriteBuffer(iWord, sizeOf(iWord));//Length of the name
      move(PChar(Pointer(tn.Text))^, s, length(tn.Text));
      s[length(tn.Text)] := #0;
      msBlobSecurityTemplate.WriteBuffer(Addr(s[0])^, Succ(iWord));//Self Caption
    end;
    tnChild := tn.GetFirstChild;
    while Assigned(tnChild) do
    begin
      ParseTree(tnChild);
      tnChild := tn.GetNextChild(tnChild);
    end;
  end;

  function GetCategoryIdNext: integer;
  begin
    repeat
      inc(iCategoryId);
    until slIDs.IndexOf(intToStr(iCategoryId)) <> 0;
    Result := iCategoryId;
  end;

  function CheckSecurityIDsDuplicate: boolean;//0 - Check Passed, <> 0 - duplicates found
  var
    i, j, iDuplicateIndx: integer;
  begin
    for i := Pred(flClientList.Count) downto 0 do
      if TObject(flClientList[i]) is TabActionList then
        for j:= Pred(TabActionList(TObject(flClientList[i])).ActionCount) downto 0 do
          if TabActionList(TObject(flClientList[i])).Actions[j] is TabAction then
          begin
            iDuplicateIndx := slIDs.IndexOf(intToStr(TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId));
            if -1 <> iDuplicateIndx then
            begin
              Result := false;
              exit;
            end;
            if 0 <> TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId then
              slIds.Add(intToStr(TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId));
        end;
    Result := true;
  end;

begin
  //Result := false;
  slIDs := TStringList.Create;
  try
    if soForceIDFromClients in fSecurityOptions then
      if not CheckSecurityIDsDuplicate then
        raise Exception.Create('Duplicate Security ID Found. Cannot Continue. Please correct.');
    iCategoryId := 0;

    //Leaks 01/30/02 //ftvSecurityTemplate.Items.Clear;
    ftvSecurityTemplate.ClearTemplate;
    fimglActions.Clear;

    tnParent := ftvSecurityTemplate.Items.Add(nil, 'User');//Root node Id (tag) is 0 by default
    new(lpNodeData);
    lpNodeData^.iId := 0;
    lpNodeData^.sCaption := '';//tnParent.Text;
    lpNodeData^.bCheckOK := false;
    lpNodeData^.AdditionalInfo.iItemIndex := tnParent.AbsoluteIndex;//No need because changes???
    lpNodeData^.AdditionalInfo.iImageIndex := 0;
    tnParent.Data := lpNodeData;

    iImageOffset := 0;
    for i := Pred(flClientList.Count) downto 0 do
      if TObject(flClientList[i]) is TabActionList then
      begin

        if iCategoryId = 0 then//FirstFound determins Images characteristics
        begin
          if Assigned(TabActionList(flClientList[i]).Images) then
          begin
            fimglActions.Assign(TabActionList(flClientList[i]).Images);
            fimglActions.Masked := false;
          end;

          bmpImage := TBitmap.Create;
          bmpImage.LoadFromResourceName(HInstance, 'TCHECKABLE');//Index 4
          if Assigned(bmpImage) then
            fimglActions.Insert(0, bmpImage, bmpImage);//Add mask

          bmpImage := TBitmap.Create;
          bmpImage.LoadFromResourceName(HInstance, 'TPASSWORD');//Index 3
          if Assigned(bmpImage) then
            fimglActions.Insert(0, bmpImage, bmpImage);//Add mask

          bmpImage := TBitmap.Create;;
          //bmpImage.Assign(img2.Picture);
          bmpImage.LoadFromResourceName(HInstance, 'TCATEGORY');//Index 2
          if Assigned(bmpImage) then
            fimglActions.Insert(0, bmpImage, bmpImage);//Add mask

          bmpImage := TBitmap.Create;;
          //bmpImage.Assign(img2.Picture);
          bmpImage.LoadFromResourceName(HInstance, 'THAND');//Index 1
          if Assigned(bmpImage) then
            fimglActions.Insert(0, bmpImage, bmpImage);//Add mask

          bmpImage := TBitmap.Create;
          bmpImage.LoadFromResourceName(HInstance, 'TUSER');//Index 0
          if Assigned(bmpImage) then
            fimglActions.Insert(0, bmpImage, bmpImage);//Add mask

          tnParent.ImageIndex := 0;
          tnParent.SelectedIndex := 0;
          iImageOffset := 5;
        end
        else if Assigned(TabActionList(flClientList[i]).Images) then
        begin
          iImageOffset := fimglActions.Count;
          for j := 0 to Pred(TabActionList(flClientList[i]).Images.Count) do
          begin
            bmpImage := TBitmap.Create;
            TabActionList(flClientList[i]).Images.GetBitmap(j, bmpImage);
            fimglActions.AddMasked(bmpImage, clWindow{nil});//Add mask
          end;
        end;


        for j:= 0 to Pred(TabActionList(TObject(flClientList[i])).ActionCount) do
          if TabActionList(TObject(flClientList[i])).Actions[j] is TabAction then
          begin
            tnParent := ftvSecurityTemplate.Items[0];
            k := 1;
            sCategoryItem := GetStringItem(TabActionList(TObject(flClientList[i])).Actions[j].Category, k, '/');
            while length(sCategoryItem) > 0 do
            begin
              tnChild := FindTreeNodeByCategoryAndLevel(sCategoryItem, k);//second parameter is level
              if not Assigned(tnChild) then
              begin
                tnChild := ftvSecurityTemplate.Items.AddChild(tnParent, sCategoryItem);
                new(lpNodeData);
                lpNodeData^.iId := 0;
                lpNodeData^.sCaption := sCategoryItem;
                lpNodeData^.bCheckOK := false;
                lpNodeData^.AdditionalInfo.iItemIndex := tnChild.AbsoluteIndex;//No need because changes???
                lpNodeData^.AdditionalInfo.iImageIndex := 2;
                tnChild.Data := lpNodeData;//0 //No ID for intermediate (hierarchical) nodes Pointer(GetCategoryIdNext);

                tnChild.ImageIndex := 2;
                tnChild.SelectedIndex := 2;
              end;
              tnParent := tnChild;
              inc(k);
              sCategoryItem := GetStringItem(TabActionList(TObject(flClientList[i])).Actions[j].Category, k, '/');
            end;
            tnChild := ftvSecurityTemplate.Items.AddChild(tnParent, TString34(GetCaption(TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).Caption)));

            new(lpNodeData);
            if (not (soForceIDFromClients in fSecurityOptions)) or
               (0 = TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId) then
            begin
              lpNodeData^.iId := GetCategoryIdNext;
              //tnChild.Data := Pointer(GetCategoryIdNext);
              TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId := lpNodeData^.iId;//Integer(tnChild.Data);
            end
            else
              //tnChild.Data := Pointer(TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId);
              lpNodeData^.iId := TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).SecurityId;

            tnChild.ImageIndex := -1;
            tnChild.SelectedIndex := -1;
            if Assigned(TabActionList(flClientList[i]).Images) then
              if TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).ImageIndex >= 0 then
              begin
                tnChild.ImageIndex := iImageOffset + TabAction(TabActionList(TObject(flClientList[i])).Actions[j]).ImageIndex;//Otwerwise -1 by default
                tnChild.SelectedIndex := tnChild.ImageIndex;
              end;

            lpNodeData^.sCaption := tnChild.Text;
            lpNodeData^.bCheckOK := false;//No need
            lpNodeData^.AdditionalInfo.iItemIndex := tnChild.AbsoluteIndex;//No need because changes???
            lpNodeData^.AdditionalInfo.iImageIndex := tnChild.ImageIndex;
            tnChild.Data := lpNodeData;
          end;
      end;
  finally
    slIDs.Destroy;
  end;
  Result := true;
end;


function TabSecurity.GetCurrentUser: string;
begin
  if fbLoggedOn then
    Result := fsCurrentUser
  else
    Result := '';
end;

procedure TabSecurity.AddInLastUser(sUserName: string);
var
  iDxUserName: integer;
begin
  iDxUserName := flstLastUser.IndexOf(sUserName);
  if iDxUserName >= 0 then
    flstLastUser.Delete(iDxUserName);
  if flstLastUser.Count > C_LAST_USER_COUNT then
    flstLastUser.Delete(0);
  flstLastUser.Add(sUserName);
end;

procedure TabSecurity.LoadTreeProperty(Stream: TStream);
begin
  ftvSecurityTemplate.LoadFromStreamSecurity(TMemoryStream(Stream));
end;


procedure TabSecurity.StoreTreeProperty(Stream: TStream);
begin
  ftvSecurityTemplate.SaveToStreamSecurity(TMemoryStream(Stream));
end;


procedure TabSecurity.LoadImageProperty(Stream: TStream);
var
  i: integer;
  Image: TBitmap;
  iDWord: DWORD;
begin
  Stream.ReadBuffer(iDWord, sizeof(iDWord));
  Image := TBitmap.Create;
  try
    for i := 0 to Pred(iDWord) do
    begin
      Image.LoadFromStream(Stream);
      FimglActions.Add(Image, Image);
    end;
  finally
    Image.Destroy;
  end;
end;


procedure TabSecurity.StoreImageProperty(Stream: TStream);
var
  i: integer;
  Image: TBitmap;
  iDWord: DWORD;
begin
  Stream.Position := 0;
  iDWord := FimglActions.Count;
  Stream.WriteBuffer(iDWord, sizeof(iDWord));
  Image := TBitmap.Create;
  try
    for i := 0 to Pred(FimglActions.Count) do
    begin
      FimglActions.GetBitmap(i, Image);
      Image.SaveToStream(Stream);
    end;
  finally
    Image.Destroy;
  end;
end;


procedure TabSecurity.DefineProperties(Filer: TFiler);
begin
  inherited;
  //Filer.DefineBinaryProperty('ImageData', LoadImageCompProperty, StoreImageCompProperty, true);
  Filer.DefineBinaryProperty('evTree', LoadTreeProperty, StoreTreeProperty, true);
  Filer.DefineBinaryProperty('evImage', LoadImageProperty, StoreImageProperty, true);
end;


procedure TabSecurity.Loaded;
var
  sUserName, sPasswordCripted: string;
begin
  inherited Loaded;                                     { call the inherited method first}
  try
    if not (csDesigning in ComponentState) then
    begin
      ReadUserTemplateFromRegistry(sPasswordCripted);

      if soShowIcons in fSecurityOptions then
        ftvSecurityTemplate.Images := fimglActions
      else
        ftvSecurityTemplate.Images := nil;
      if soForceBuildSecurityFromClients in fSecurityOptions then
        if not DoBuildSecurityTemplateFromClients(ftvSecurityTemplate, fimglActions) then
          raise Exception.Create('Cannot build Security template from clients');
      fSecurityDialogs.SecurityObject := Self;

      if soAutoLogon in fSecurityOptions then
      begin
        if flstLastUser.Count > 0 then
          sUserName := flstLastUser[Pred(flstLastUser.Count)]
        else
          sUserName := '';

        sPasswordCripted := TCripter.Decript(sPasswordCripted);
        if not Logon(sUserName, sPasswordCripted, soSilentLogonTry in fSecurityOptions) then
          if soReleaseOwnerOnLogonFail in fSecurityOptions then
            if Owner is TForm then
              Application.Terminate;//TForm(Owner).Release;//raise Exception.CreateRes(@rsAutoLogonFail);
      end;
    end;
  except
    if csDesigning in ComponentState then                            { at design time... }
      Application.HandleException(Self)                { let Delphi handle the exception }
    else raise;                                                     { otherwise, reraise }
  end;
end;

//TabSecurityTemplate******************************************************

destructor TabSecurityTemplate.Destroy;//Leaks
begin
  ClearTemplate;
  inherited;
end;

//v1.4
function TabSecurityTemplate.DeleteKey(sKey: string): boolean;
var
  Reg: TRegistry;
begin
  Reg:= TRegistry.Create;
  try
    Result := Reg.DeleteKey(sKey);
  finally
    Reg.Destroy;
  end;
end;

procedure TabSecurityTemplate.LoadFromStreamSecurity(Stream: TMemoryStream);
var
  i: integer;
  lpNodeData: PNodeData;
  iDWord: DWORD;
  Version: TVersion;
begin
  Stream.Position := 0;
  Stream.ReadBuffer(Version, sizeof(Version));
  if (Version.Major <> C_VERSION.Major) or
     (Version.Minor <> C_VERSION.Minor) or
     (Version.MinorMinor <> C_VERSION.MinorMinor) or
     (Version.Patch <> C_VERSION.Patch) then
    raise Exception.Create(rsVersionMismatch);