|
|
|
| | | | | | | | |  |
| 
| Code source : unité LRJ_WinACL | |
| |
| | |
|
Description : cette unité contient les objets LRJ_TNewExplicitEntry, LRJ_TNewExplicitEntries,
LRJ_TExplicitEntry, LRJ_TExplicitEntries, LRJ_TWinACE, LRJ_TWinNewACE, LRJ_TListNewACE et
LRJ_TWinACL. LRJ_TNewExplicitEntry contient les données d'une explicit entry à fusionner à une
ACL. LRJ_TNewExplicitEntries contient la liste de nouvelles explicit entries à fusionner à une
ACL. LRJ_TExplicitEntry encapsule une explicit entry existante. LRJ_TExplicitEntries contient
une liste d'explicit entries extraites d'une ACL. LRJ_TWinACE encapsule une ACE (Access Control Entry)
d'une ACL existante. LRJ_TWinNewACE contient les données d'une nouvelle ACE à ajouter à une
ACL. LRJ_TListNewACE contient une liste de LRJ_TWinNewACE à ajouter à une ACL. LRJ_TWinACL
encapsule une ACL existante mais permet aussi d'en créer une nouvelle soit directement avec
une liste d'ACE ou indirectement avec une liste d'explicit entries.
L'unité est livrée avec une application de démonstration (
voir description plus loin
) qui utilise certaines fonctionnalités des objets de cette unité. Les codes de l'application
sont livrés avec l'unité pour illustrer comment utiliser les objets de cette unité.
L'application de démonstration utilise les unités
LRJ_WindowsPlus,
LRJ_ClassesPlus,
LRJ_WinNetUsers,
LRJ_WinNetLocalGroups et
LRJ_WinSID
non livrées avec
l'application.
L'unité LRJ_WinACL met en
oeuvre les fonctions de Windows suivantes :
|
|
AddAce
DeleteAce
GetAce
GetAclInformation
GetExplicitEntriesFromAcl
GetNamedSecurityInfo
GetSecurityInfo
InitializeAcl
IsValidAcl
LocalAlloc
LocalFree
SetEntriesInAcl
SetNamedSecurityInfo
SetSecurityInfo
|
Déclarations publiques de l'unité
I
Télécharger l'application de démonstration
I
Exemples d'utilisations
Utilise les unités : Windows, Classes, SysUtils,
LRJ_ClassesPlus et
LRJ_WinSID.
Version : 1.1 du 16.05.2009
Auteur : Laurent Hède
Copyright : LorenJo
Nombre de lignes : 2574
Réalisée sous : Delphi 6
Systèmes compatibles : NT4, 2000, XP, Vista, serveurs
Prix : 582.00 € H.T.
Déclarations publiques de l'unité :
unit LRJ_WinACL;
........
interface
uses
Windows,
Classes,
SysUtils,
LRJ_ClassesPlus,
LRJ_WinSID;
........
function GetStringTypeObjectFromItemEnum(const ATypeObject: LRJ_SE_OBJECT_TYPE) : string;
........
function LRJ_GetACLFromNamedObject(const AObjectName: string; const AObjectType: LRJ_SE_OBJECT_TYPE; const ppAcl: LRJ_PPACL;
const ATypeACL: LRJ_TTypeACL; var ppSecurityDescriptor: LRJ_PRelativeSecurityDescriptor): DWORD;//use localfree to
//release ppSecurityDescriptor
function LRJ_GetACLFromHandleObject(const AHandle: THandle; const AObjectType: LRJ_SE_OBJECT_TYPE; const ppAcl: LRJ_PPACL;
const ATypeACL: LRJ_TTypeACL; var ppSecurityDescriptor: LRJ_PRelativeSecurityDescriptor): DWORD; //use localfree to
// release ppSecurityDescriptor
function LRJ_GetExplicitEntriesFromAcl(const pacl: PACL; var pcCountOfExplicitEntries: Integer;
var pListOfExplicitEntries: LRJ_TListOfExplicitEntries): DWORD; //use localfree to release LRJ_TListOfExplicitEntries
function LRJ_SetEntriesInAcl(const ACountOfExplicitEntries: Integer; const pListOfExplicitEntries: LRJ_TListOfExplicitEntries;
const AOldAcl: PACL; var ANewAcl: PACL): DWORD; //use localfree to release NewAcl
function LRJ_SetNewACLToHandleObject(const AHandle: THandle; const AObjectType: LRJ_SE_OBJECT_TYPE; const ppAcl: PACL;
const ATypeACL: LRJ_TTypeACL): DWORD;
function LRJ_SetNewACLToNamedObject(const AObjectName: string; const AObjectType: LRJ_SE_OBJECT_TYPE; const ppAcl: PACL;
const ATypeACL: LRJ_TTypeACL): DWORD;
........
function GetGenericRightsStringFromTypedAccessMask(const ATypedAccessMask: LRJ_TACE_TypedAccessMask) : string;
function GetStandardRightsStringFromTypedAccessMask(const ATypedAccessMask: LRJ_TACE_TypedAccessMask) : string;
function GetDWORDAccessMaskForTypedAccessMask(const ATypedAccessMask: LRJ_TACE_TypedAccessMask) : DWORD;
function GetTypedAccessMaskForDWORDAccessMask(const ADWORDAccessMask: DWORD) : LRJ_TACE_TypedAccessMask;
........
function GetSetOfACEFlagsFromFlags(const AFlag: DWORD) : LRJ_TSetOf_ACE_Flag;
function GetStringFlagsFromSetOfTypedACEFlags(const ASetOfTypedACE: LRJ_TSetOf_ACE_Flag) : string;
function GetFlagsFromSetOfAceFlags(const ASetOfTypedACE: LRJ_TSetOf_ACE_Flag) : DWORD;
type
// Contient une entrée d'une liste d'Explicit_Access à ajouter à une ACL. Après avoir ajouter ou insérer l'entry
// dans LRJ_TNewExplicitEntries, surtout ne pas la détruire car LRJ_TNewExplicitEntries s'en occupe.
//------------OBJET----------------------------
LRJ_TNewExplicitEntry = class(TObject)
........
procedure InitializeForTrusteeAndSid(
const AccessMask: DWORD;
const AccessMode: LRJ_ACCESS_MODE;
const Inheritance: DWORD;
const TrusteeType: LRJ_TRUSTEE_TYPE;
const ASID: PSID
);
procedure InitializeForTrusteeAndName(
const AccessMask: DWORD;
const AccessMode: LRJ_ACCESS_MODE;
const Inheritance: DWORD;
const TrusteeType: LRJ_TRUSTEE_TYPE;
const AName: string
);
procedure InitializeForTrusteeObjectAndSid(
const AccessMask: DWORD;
const AccessMode: LRJ_ACCESS_MODE;
const Inheritance: DWORD;
const TrusteeType: LRJ_TRUSTEE_TYPE;
const ASID: PSID;
const ObjectPresent: DWORD;
const GUIDObjectPresent: TGUID
);
procedure InitializeForTrusteeObjectAndName(
const AccessMask: DWORD;
const AccessMode: LRJ_ACCESS_MODE;
const Inheritance: DWORD;
const TrusteeType: LRJ_TRUSTEE_TYPE;
const AName: string;
const AObjectType: LRJ_SE_OBJECT_TYPE;
const ObjectPresent: DWORD;
const ANameObjectPresent: string
);
function GetDWORDAccessMaskFromTypedAccessMask(const ATypedAccessMask : LRJ_TACE_TypedAccessMask): DWORD;
end;//-----------FIN--------------------------
// Contient une liste de nouveaux Explicit_Access à ajouter a une ACL
//------------OBJET----------------------------
LRJ_TNewExplicitEntries = class(TObject)
........
procedure AddEntry(const ANewEntry: LRJ_TNewExplicitEntry);
procedure InsertEntry(const AIndex: integer; const ANewEntry: LRJ_TNewExplicitEntry);
procedure ClearList;
function CountEntry: integer;
property Entry[const Index: integer]: LRJ_TNewExplicitEntry read GetEntry;
end;//-----------FIN--------------------------
// Encapsule une entrée d'une liste existante d'Explicit_Access.
//------------OBJET----------------------------
LRJ_TExplicitEntry = class(TObject)
........
function GetGenericRightsString: string;
function GetStandardRightsString: string;
function GetAccessModeString: string;
function GetTypedInheritanceString: string;
function GetTrusteeTypeString: string;
function GetTrusteeFormString: string;
function GetObjectType(var ATypeObject: LRJ_SE_OBJECT_TYPE) : boolean;
function GetObjectTypeGuid(var AObjectTypeGuid: TGUID) : boolean;
function GetObjectTypeName(var AObjectTypeName: string) : boolean;
function GetInheritedObjectTypeGuid(var AInheritedObjectTypeGuid: TGUID) : boolean;
function GetInheritedObjectTypeName(var AInheritedObjectTypeName: string) : boolean;
procedure LoadCheckObject(const AStrListe: TStrings);
property AccessMask: DWORD read MOEntry.grfAccessPermissions write SetNewAccessMask;
property AccessMaskTyped: LRJ_TACE_TypedAccessMask read GetTypedAccessMask write SetNewTypedAccessMask;
property AccessMode: LRJ_ACCESS_MODE read MOEntry.grfAccessMode write SetNewAccessMode;
property Inheritance: DWORD read MOEntry.grfInheritance write SetNewInheritance;
property InheritanceTyped: LRJ_TSetOf_ACE_Flag read GetTypedInheritance write SetNewTypedInheritance;
property TrusteeType: LRJ_TRUSTEE_TYPE read MOEntry.trustee.TrusteeType write SetNewTrusteeType;
property TrusteeName: string read GetTrusteeName;
property TrusteeSID: LRJ_TWinSID read GetTrusteeSID;
end;//-----------FIN--------------------------
// Encapsule une liste existante d'Explicit_Access.
//------------OBJET----------------------------
LRJ_TExplicitEntries = class(TObject)
........
procedure Refresh;
procedure DeleteEntry(const AIndex: integer);
procedure ClearList;
property CountEntries: integer read MOCountExplicitEntries;
property Entry[const index: integer] : LRJ_TExplicitEntry read GetEntry;
end;//-----------FIN--------------------------
// Cet objet encapsule une Ace d'une ACL existante. Ne possède que des fonctions de lecture
//------------OBJET----------------------------
LRJ_TWinACE = class(TObject)
........
function GetSize: DWORD;
function GetType: Byte;
function GetTypeString: string;
function GetInheritanceFlag: Byte;
function GetTypedInheritanceFlags: LRJ_TSetOf_ACE_Flag;
function GetInheritanceFlagsString: string;
function GetAccessMask: DWORD;
function GetTypedAccessMask: LRJ_TACE_TypedAccessMask;
function GetGenericRightsString: string;
function GetStandardRightsString: string;
function ReadSID: LRJ_TWinSID;
function GetObjectType(var AGUID : TGUID): boolean;
function GetInheritedObjectType(var AGUID : TGUID): boolean;
end;//-----------FIN--------------------------
// Cet objet stocke les paramètres des ACEs. D'après la doc, les ACEs contiennent que des SID, alors que les explicit
// entries peuvent être par name ou par SID. Utiliser les fonctions de LRJ_TWinSID pour charger le SID en function d'un
// nom ou d'un WellKnowSID par exemple. Ensuite on crée les véritables ACE dans les ACL avec les fonctions dédiées,
// AddACE, InsertACE, AddListACEs, InsertListACEs.
//------------OBJET----------------------------
LRJ_TWinNewACE = class(TObject)
........
function CheckAceValid: boolean; // Test si le informations sur l'ACE sont suffisantes
property AceType: Byte read MOTypeAce write MOTypeAce;
property InheritanceFlag: Byte read MOInheritanceFlag write MOInheritanceFlag;
property TypedFlag: LRJ_TSetOf_ACE_Flag read GetTypedFlags write SetTypedFlags;
property Mask: DWORD read MOMask write MOMask;
property TypedMask : LRJ_TACE_TypedAccessMask read GetTypedAccessMask write SetTypedAccessMask;
property SID: LRJ_TWinSID read GetSID;
property ObjectType: TGUID read MOObjectType write MOObjectType;
property InheritedObjectType: TGUID read MOInheritedObjectType write MOInheritedObjectType;
end;//-----------FIN--------------------------
// LRJ_TListNewACE accumule des objets LRJ_TWinNewACE que l'on va ensuite insérer dans une ACL et qui vont permettre
// créer une ACL nouvelle ou modifier une existante. Il faut obligatoirement respecter la cohérence au niveau de ACL revision
// (soit entrer que des ACEs simples, soit que des Aces pour objets) et normalement la forme canoniale pour l'ordre des ACEs,
// c'est-à-dire les Access denied avant les Access allowed. Il ne semble pas y avoir de nécessité de respecter un ordre
// quelconque entre les différents accès denied ou allowed sauf en raison d'une stratégie. Les ACEs transmis à AddAce et
// InsertAce ne doivent pas être détruits. Ils le seront par LRJ_TListNewACE.
//------------OBJET----------------------------
LRJ_TListNewACE = class(TObject)
........
procedure Clear;
function Count: integer;
function AddAce(const AAceCreator: LRJ_TWinNewACE): integer; // si result = -1 => erreur
function InsertAce(const AIndex: integer; const AAceCreator: LRJ_TWinNewACE): integer; // si result = -1 => erreur
property Ace[const index: integer]: LRJ_TWinNewACE read GetAce;
end;//-----------FIN--------------------------
// Cet objet encapsule une ACL existante.
// On peut charger une ACL d'un objet par LoadFromObject ou LoadFromHandle puis l'attribuer à un autre
// objet par SaveToHandleObject ou SaveToNamedObject ou l'attribuer à l'objet d'origine
// après modifications .
// Le schéma d'utilisation est le suivant : 1) on duplique l'ACL d'origine que cet objet conserve 2) on peut ensuite
// modifier cette ACL avec NewExplicitEntries ou ExplicitEntries ou ajouter, supprimer,
// insérer un ACE ou une liste d'ACEs sur l'objet initial puis 3)on peut attribuer l'ACL modifiée à l'objet d'origine
// par SaveToObject ou à un autre objet par SaveToHandleObject ou SaveToNamedObject. Tant que l'on n'a pas utilisé une
// fonction save.., il n'y a aucune modification de la sécurité existante sur aucun objet car l'ACL chargée est dupliquée.
// On peut donc sans risque travailler la cohérence d'une ACL avant de l'attribuer à un objet.
//------------OBJET----------------------------
LRJ_TWinACL = class(TObject)
........
// Informations sur l'ACL
function IfAssigned: boolean;
function IfValid: boolean;
function GetACLRevision: DWORD;
function GetSize: DWORD;
function GetBytesInUse: DWORD;
function GetBytesFree: DWORD;
function CountAce: Integer;
// Pour extraire et dupliquer dans cet objet une ACL à partir d'un objet
// utilise GetNamedSecurityInfo, voir la doc de cette function pour savoir de quels objets on peut charger
function LoadFromObject(const ATypeObject: LRJ_SE_OBJECT_TYPE; const ATypeACL: LRJ_TTypeACL;
const AObjectName: string): DWORD; // 0 = true, <> 0 = error (result = error)
// utilise GetSecurityInfo, voir la doc de cette function pour savoir de quels objets on peut charger
function LoadFromHandle(const ATypeObject: LRJ_SE_OBJECT_TYPE; const ATypeACL: LRJ_TTypeACL;
const AHandle: THandle): DWORD; // 0 = true, <> 0 = error (result = error)
//Pour ajouter - retirer des ACEs un par un. LRJ_TWinACL utilise des LRJ_TWinNewACE transmis mais ne les détruits pas
function AddACE(const AACE: LRJ_TWinNewACE): integer; // retourne l'index du nouvel ACE, -1 en cas d'erreur
function InsertACE(const AACE: LRJ_TWinNewACE; const AIndex: integer): integer; // retourne l'index du nouvel ACE, -1 en cas d'erreur
function DeleteAceIndex(const AIndex: integer): boolean; // Détruit l'ACE dans l'ACL
function DeleteAcesForSID(const ASID: PSID): boolean; // détruit tous les ACEs correspondant à ce SID
//Pour vider ou mettre à nil l'ACL
procedure ClearACL; // vide l'ACL, mettre une ACL vide dans un objet interdit tous accès
procedure DeleteACL; // met l'ACL à nil, mettre aucune ACL (ou = nil) dans un objet autorise tous accès
// Pour ajouter ou insérer la liste des nouveaux ACEs (ListNewACEs)
function AddNewACEsList: boolean;
function InsertNewACEsList(const AIndex: integer): boolean;
// MergeOldExplicitEntries permet de fusionner la liste des explicits entries chargées dans l'ACL.
// ExplicitEntries est chargée automatiquement si on a chargée l'ACL avant son appel. Sinon, il faut le faire par Refresh.
// Les Explicits entries sont ensuite conservées même si on recharge l'ACL par loadfrom.... On peut ensuite créer des répliques de
// l'ACL d'origine avec les Explicits entries extraites. Néanmoins, la stratégie de sécurité peut être différentes car
// les explicits entries correspondent à la stratégie non héritée, donc en fusionnant les mêmes explicits entries avec
// différentes ACL peut ne pas donner des droits d'accès identiques.
function MergeOldExplicitEntries: DWORD; // 0 = true, <> 0 = error (result = error)
//MergeNewExplicitEntries pour fusionner l'ACL avec des ExplicitEntries nouvelles entrées dans NewExplicitEntries
function MergeNewExplicitEntries: DWORD; // 0 = true, <> 0 = error (result = error)
//pour mettre l'ACL dupliquée dans l'objet d'origine
function SaveToObject: DWORD; // utilisable si on a chargé l'ACL avec LoadFromObject ou LoadFromHandle // 0 = true, <> 0 = error (result = error)
//pour mettre l'ACL dupliquée dans un objet
function SaveToHandleObject(const ATypeObject: LRJ_SE_OBJECT_TYPE; const ATypeACL: LRJ_TTypeACL; const AHandle: THandle): DWORD; // 0 = true, <> 0 = error (result = error)
function SaveToNamedObject(const ATypeObject: LRJ_SE_OBJECT_TYPE; const ATypeACL: LRJ_TTypeACL; const AObjectName: string): DWORD; // 0 = true, <> 0 = error (result = error)
//propriétés
property ACL: PACL read MOACL write SetACL;
property Ace[const index: integer]: LRJ_TWinACE read GetAce;
property ExplicitEntries: LRJ_TExplicitEntries read GetExplicitEntriesList;
property NewExplicitEntries: LRJ_TNewExplicitEntries read GetNewExplicitEntries;
property ListNewACEs: LRJ_TListNewACE read GetListNewACEs;
end;//-----------FIN--------------------------
|
Application de démonstration
Les champs 'Object type' et 'Object name' permettent de sélectionner un objet pour charger la DACL
de cet objet. Consulter la documentation Microsoft de la fonction GetNamedSecurityInfo pour
en savoir plus sur la sémantique du nom de l'objet. Nous recommandons de choisir une clef
de registre ou un fichier créé pour l'occasion si vous souhaitez tester l'attribution d'une
nouvelle DACL à un objet. Lisez attentivement la documentation Windows concernant les ACL
si vous souhaitez attribuer une nouvelle ACL à un objet. Attention, selon la stratégie de
sécurité attribuée, l'objet peut devenir définitivement inaccessible.
Les boutons 'Save Object name select', Delete Object name select' et 'Clear Object name list'
permettent de gérer la sauvegarde ou la destruction de la sauvegarde des informations
saisies dans le champs 'Object name'. En effet, pour faciliter les tests, ces boutons
permettent d'enregistrer ou supprimer les noms d'objet saisis dans 'Object name'.
L'onglet 'Load actual DACL' permet de charger la DACL de l'objet sélectionné par les champs
'Object type' et 'Object name'.
L'onglet 'Load actual ExplicitEntries' permet de charger la liste des explicit entries
contenues dans l'ACL chargée.
L'onglet 'Work actual ExplicitEntries' permet de supprimer des entrées de la liste d'explicit
entries de l'onglet 'Load actual ExplicitEntries' ou/et de fusionner la liste des explicit
entries de cet onglet à une DACL interne que cette application permet de travailler.
L'onglet 'Create New Explicits access' permet de créer de nouvelles explicit entries que
l'on peut charger dans une liste de nouvelle explicit entries interne. On peut en cliquant
sur 'Set new explicitEntries to worked DACL' fusionner les nouvelles explicit entries avec
la DACL interne que nous sommes en train de travailler.
L'onglet 'Add ACE' permet de créer de nouveaux ACEs que l'on peut ajouter à la DACL interne
en fin de liste en cliquant sur le bouton 'ADD ACE'.
L'onglet 'See worked DACL' permet de visualiser la DACL interne et de supprimer des ACEs
de cette DACL.
L'onglet 'Set worked DACL to Object' permet d'attribuer la DACL interne à l'objet sélectionné
par les champs 'Object type' et 'Object name'. ATTENTION, la stratégie de sécurité découlant
de la DACL interne est immédiatement appliquée à cet objet. En cas de mauvaise stratégie,
cet objet peut devenir définitivement inaccessible.
Exemples d'utilisations
Attribuer un droit d'accès total à un groupe pour 5 clefs de registre et toutes
les sous-clefs de ces clefs
const
CtGroupeAllowed = 'nom d''un groupe';
CtCountKey = 5;
var
TTabRegKey : array[0..CtCountKey-1] of string = (
'aaaaaaaa',
'bbbbbbbb',
'cccccccc',
'dddddddd',
'eeeeeeee'
);
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
zWinACL: LRJ_TWinACL;
zNewEntry: LRJ_TNewExplicitEntry;
begin
zWinACL := LRJ_TWinACL.create;
zNewEntry := LRJ_TNewExplicitEntry.Create;
zNewEntry.InitializeForTrusteeAndName(KEY_ALL_ACCESS,
LRJ_GRANT_ACCESS,
LRJ_CONTAINER_INHERIT_ACE or LRJ_OBJECT_INHERIT_ACE,
LRJ_TRUSTEE_IS_GROUP,
CtGroupeAllowed);
zWinACL.NewExplicitEntries.AddEntry(zNewEntry);
for i:=0 to CtCountKey-1 do
begin
zWinACL.LoadFromObject(LRJ_SE_REGISTRY_KEY, tta_DACL, TTabRegKey[i]);
zWinACL.MergeNewExplicitEntries;
zWinACL.SaveToObject;
end;
zWinACL.free;
end;
|
Supprimer les droits d'accès créés ci-dessus
var
i: integer;
zWinACL: LRJ_TWinACL;
zNewEntry: LRJ_TNewExplicitEntry;
begin
zWinACL := LRJ_TWinACL.create;
zNewEntry := LRJ_TNewExplicitEntry.Create;
zNewEntry.InitializeForTrusteeAndName(KEY_ALL_ACCESS,
LRJ_REVOKE_ACCESS,//Seule modif par rapport à l'exemple ci-dessus
LRJ_CONTAINER_INHERIT_ACE or LRJ_OBJECT_INHERIT_ACE,
LRJ_TRUSTEE_IS_GROUP,
CtGroupeAllowed);
zWinACL.NewExplicitEntries.AddEntry(zNewEntry);
for i:=0 to CtCountKey-1 do
begin
zWinACL.LoadFromObject(LRJ_SE_REGISTRY_KEY, tta_DACL, TTabRegKey[i]);
zWinACL.MergeNewExplicitEntries;
zWinACL.SaveToObject;
end;
zWinACL.free;
end;
|
Vous n'avez pas trouvé d'exemple répondant à votre problématique ?
Cliquez sur ce lien.
|
|
|
 | |  |
|
|
