function AddAccessRights(lpszFileName: PChar; lpszAccountName: PChar;
dwAccessMask: DWORD): boolean;
const
HEAP_ZERO_MEMORY = $00000008;
ACL_REVISION = 2;
ACL_REVISION2 = 2;
INHERITED_ACE = $10;
type
ACE_HEADER =
record
AceType,
AceFlags: BYTE;
AceSize: WORD;
end;
PACE_HEADER = ^ACE_HEADER;
ACCESS_ALLOWED_ACE =
record
Header: ACE_HEADER;
Mask: ACCESS_MASK;
SidStart: DWORD;
end;
PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;
ACL_SIZE_INFORMATION =
record
AceCount,
AclBytesInUse,
AclBytesFree: DWORD;
end;
SetSecurityDescriptorControlFnPtr =
function (pSecurityDescriptor: PSecurityDescriptor;
ControlBitsOfInterest: SECURITY_DESCRIPTOR_CONTROL;
ControlBitsToSet: SECURITY_DESCRIPTOR_CONTROL): boolean;
stdcall;
var
// SID variables.
snuType: SID_NAME_USE;
szDomain: PChar;
cbDomain: DWORD;
pUserSID: Pointer;
cbUserSID: DWORD;
// File SD variables.
pFileSD: PSecurityDescriptor;
cbFileSD: DWORD;
// New SD variables.
newSD: TSecurityDescriptor;
// ACL variables.
ptrACL: PACL;
fDaclPresent,
fDaclDefaulted: BOOL;
AclInfo: ACL_SIZE_INFORMATION;
// New ACL variables.
pNewACL: PACL;
cbNewACL: DWORD;
// Temporary ACE.
pTempAce: Pointer;
CurrentAceIndex,
newAceIndex: UINT;
// Assume function will fail.
fResult,
fAPISuccess: boolean;
secInfo: SECURITY_INFORMATION;
// New APIs available only in Windows 2000 and above for setting
// SD control
_SetSecurityDescriptorControl: SetSecurityDescriptorControlFnPtr;
controlBitsOfInterest,
controlBitsToSet,
oldControlBits: SECURITY_DESCRIPTOR_CONTROL;
dwRevision: DWORD;
AceFlags : BYTE;
function myheapalloc(x: integer): Pointer;
begin
Result := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, x);
end;
function myheapfree(x: Pointer): boolean;
begin
Result := HeapFree(GetProcessHeap(), 0, x);
end;
function SetFileSecurityRecursive(lpFileName: PChar;
SecurityInformation: SECURITY_INFORMATION;
pSecurityDescriptor: PSecurityDescriptor): BOOL;
var
sr : TSearchRec;
begin
Result := SetFileSecurity(lpFileName, SecurityInformation, pSecurityDescriptor);
if not Result
then
Exit;
if (FileGetAttr(lpFileName)
and faDirectory) = faDirectory
then
begin
// Rekursion beginnt
if FindFirst(IncludeTrailingPathDelimiter(lpFileName) + '
*',
$EFFF, sr) = 0
then
begin
repeat
// msp 07.10.2004
// if ((sr.Attr and faDirectory) = faDirectory) AND (sr.Name <> '.') AND (sr.Name <> '..') then
if (sr.
Name <> '
.')
and (sr.
Name <> '
..')
then
SetFileSecurityRecursive(PChar(IncludeTrailingPathDelimiter(
lpFileName) + sr.
Name), SecurityInformation,
pSecurityDescriptor);
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
end;
begin
// Init
szDomain :=
nil;
cbDomain := 0;
pUserSID :=
nil;
cbUserSID := 0;
// File SD variables.
pFileSD :=
nil;
cbFileSD := 0;
// ACL variables.
ptrACL :=
nil;
// New ACL variables.
pNewACL :=
nil;
cbNewACL := 0;
// Temporary ACE.
pTempAce :=
nil;
CurrentAceIndex := 0;
newAceIndex := 0;
// Assume function will fail.
fResult := false;
secInfo := DACL_SECURITY_INFORMATION;
// New APIs available only in Windows 2000 and above for setting
// SD control
_SetSecurityDescriptorControl :=
nil;
// Delphi-Result
Result := false;
try
//
// STEP 1: Get SID of the account name specified.
//
fAPISuccess := LookupAccountName(
nil, lpszAccountName,
pUserSID, cbUserSID, szDomain,
cbDomain, snuType);
// API should have failed with insufficient buffer.
if (
not fAPISuccess)
and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER)
then
raise Exception.Create('
LookupAccountName Error=' +
IntToStr(GetLastError()));
pUserSID := myheapalloc(cbUserSID);
if pUserSID =
nil then
raise Exception.Create('
myheapalloc Error=' + IntToStr(GetLastError()));
szDomain := PChar(myheapalloc(cbDomain * sizeof(PChar)));
if szDomain =
nil then
raise Exception.Create('
myheapalloc Error=' + IntToStr(GetLastError()));
fAPISuccess := LookupAccountName(
nil, lpszAccountName,
pUserSID, cbUserSID, szDomain,
cbDomain, snuType);
if not fAPISuccess
then
raise Exception.Create('
LookupAccountName Error=' +
IntToStr(GetLastError()));
//
// STEP 2: Get security descriptor (SD) of the file specified.
//
fAPISuccess := GetFileSecurity(lpszFileName,
secInfo, pFileSD, 0, cbFileSD);
// API should have failed with insufficient buffer.
if (
not fAPISuccess)
and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER)
then
raise Exception.Create('
GetFileSecurity Error=' +
IntToStr(GetLastError()));
pFileSD := myheapalloc(cbFileSD);
if pFileSD =
nil then
raise Exception.Create('
myheapalloc Error=' + IntToStr(GetLastError()));
fAPISuccess := GetFileSecurity(lpszFileName,
secInfo, pFileSD, cbFileSD, cbFileSD);
if not fAPISuccess
then
raise Exception.Create('
GetFileSecurity Error=' +
IntToStr(GetLastError()));
//
// STEP 3: Initialize new SD.
//
if not InitializeSecurityDescriptor(@newSD,
SECURITY_DESCRIPTOR_REVISION)
then
raise Exception.Create('
InitializeSecurityDescriptor Error=' +
IntToStr(GetLastError()));
//
// STEP 4: Get DACL from the old SD.
//
if not GetSecurityDescriptorDacl(pFileSD, fDaclPresent, ptrACL,
fDaclDefaulted)
then
raise Exception.Create('
GetSecurityDescriptorDacl Error=' +
IntToStr(GetLastError()));
//
// STEP 5: Get size information for DACL.
//
AclInfo.AceCount := 0;
// Assume NULL DACL.
AclInfo.AclBytesFree := 0;
AclInfo.AclBytesInUse := sizeof(
ACL);
if ptrACL =
nil then
fDaclPresent := false;
// If not NULL DACL, gather size information from DACL.
if fDaclPresent
then
if not GetAclInformation(ptrACL^, @AclInfo, sizeof(ACL_SIZE_INFORMATION),
AclSizeInformation)
then
raise Exception.Create('
GetAclInformation ' + IntToStr(GetLastError()));
//
// STEP 6: Compute size needed for the new ACL.
//
cbNewACL := AclInfo.AclBytesInUse + sizeof(ACCESS_ALLOWED_ACE) +
GetLengthSid(pUserSID) - sizeof(DWORD);
//
// STEP 7: Allocate memory for new ACL.
//
pNewACL := PACL(myheapalloc(cbNewACL));
if pNewACL =
nil then
raise Exception.Create('
myheapalloc ' + IntToStr(GetLastError()));
//
// STEP 8: Initialize the new ACL.
//
if not InitializeAcl(pNewACL^, cbNewACL, ACL_REVISION2)
then
raise Exception.Create('
InitializeAcl ' + IntToStr(GetLastError()));
//
// STEP 9 If DACL is present, copy all the ACEs from the old DACL
// to the new DACL.
//
// The following code assumes that the old DACL is
// already in Windows 2000 preferred order. To conform
// to the new Windows 2000 preferred order, first we will
// copy all non-inherited ACEs from the old DACL to the
// new DACL, irrespective of the ACE type.
//
newAceIndex := 0;
if (fDaclPresent)
and (AclInfo.AceCount > 0)
then
begin
for CurrentAceIndex := 0
to AclInfo.AceCount - 1
do
begin
//
// STEP 10: Get an ACE.
//
if not GetAce(ptrACL^, CurrentAceIndex, pTempAce)
then
raise Exception.Create('
GetAce ' + IntToStr(GetLastError()));
//
// STEP 11: Check if it is a non-inherited ACE.
// If it is an inherited ACE, break from the loop so
// that the new access allowed non-inherited ACE can
// be added in the correct position, immediately after
// all non-inherited ACEs.
//
if PACCESS_ALLOWED_ACE(pTempAce)^.Header.AceFlags
and
INHERITED_ACE > 0
then
break;
//
// STEP 12: Skip adding the ACE, if the SID matches
// with the account specified, as we are going to
// add an access allowed ACE with a different access
// mask.
//
if EqualSid(pUserSID, @(PACCESS_ALLOWED_ACE(pTempAce)^.SidStart))
then
continue;
//
// STEP 13: Add the ACE to the new ACL.
//
if not AddAce(pNewACL^, ACL_REVISION, MAXDWORD, pTempAce,
PACE_HEADER(pTempAce)^.AceSize)
then
raise Exception.Create('
AddAce ' + IntToStr(GetLastError()));
Inc(newAceIndex);
end;
end;
//
// STEP 14: Add the access-allowed ACE to the new DACL.
// The new ACE added here will be in the correct position,
// immediately after all existing non-inherited ACEs.
//
AceFlags := $1
(* OBJECT_INHERIT_ACE *)
or $2
(* CONTAINER_INHERIT_ACE *)
or $10
(* INHERITED_ACE*);
if not AddAccessAllowedAceEx(pNewACL^, ACL_REVISION2, AceFlags, dwAccessMask,
pUserSID)
then
raise Exception.Create('
AddAccessAllowedAce ' + IntToStr(GetLastError()));
//
// STEP 15: To conform to the new Windows 2000 preferred order,
// we will now copy the rest of inherited ACEs from the
// old DACL to the new DACL.
//
if (fDaclPresent)
and (AclInfo.AceCount > 0)
then
begin
while CurrentAceIndex < AclInfo.AceCount
do
begin
//
// STEP 16: Get an ACE.
//
if not GetAce(ptrACL^, CurrentAceIndex, pTempAce)
then
raise Exception.Create('
GetAce ' + IntToStr(GetLastError()));
//
// STEP 17: Add the ACE to the new ACL.
//
if not AddAce(pNewACL^, ACL_REVISION, MAXDWORD, pTempAce,
PACE_HEADER(pTempAce)^.AceSize)
then
raise Exception.Create('
AddAce ' + IntToStr(GetLastError()));
Inc(CurrentAceIndex);
end;
end;
//
// STEP 18: Set the new DACL to the new SD.
//
if not SetSecurityDescriptorDacl(@newSD, TRUE, pNewACL, FALSE)
then
raise Exception.Create('
SetSecurityDescriptorDacl ' +
IntToStr(GetLastError()));
//
// STEP 19: Copy the old security descriptor control flags
// regarding DACL automatic inheritance for Windows 2000 or
// later where SetSecurityDescriptorControl() API is available
// in advapi32.dll.
//
_SetSecurityDescriptorControl := SetSecurityDescriptorControlFnPtr(
GetProcAddress(GetModuleHandle(
'
advapi32.dll'),
'
SetSecurityDescriptorControl'));
if @_SetSecurityDescriptorControl <>
nil then
begin
controlBitsOfInterest := 0;
controlBitsToSet := 0;
oldControlBits := 0;
dwRevision := 0;
if not GetSecurityDescriptorControl(pFileSD, oldControlBits,
dwRevision)
then
raise Exception.Create('
GetSecurityDescriptorControl ' +
IntToStr(GetLastError()));
if (oldControlBits
and SE_DACL_AUTO_INHERITED) <> 0
then
begin
controlBitsOfInterest := SE_DACL_AUTO_INHERIT_REQ
or
SE_DACL_AUTO_INHERITED;
controlBitsToSet := controlBitsOfInterest;
end else
if (oldControlBits
and SE_DACL_PROTECTED) <> 0
then
begin
controlBitsOfInterest := SE_DACL_PROTECTED;
controlBitsToSet := controlBitsOfInterest;
end;
if controlBitsOfInterest <> 0
then
if not _SetSecurityDescriptorControl(@newSD, controlBitsOfInterest,
controlBitsToSet)
then
raise Exception.Create('
SetSecurityDescriptorControl ' +
IntToStr(GetLastError()));
end;
//
// STEP 20: Set the new SD to the File.
//
// msp 07.09.2004: Set to all objects including subdirectories
// if Not SetFileSecurity(lpszFileName, secInfo, @newSD) then
if not SetFileSecurityRecursive(lpszFileName, secInfo, @newSD)
then
raise Exception.Create('
SetFileSecurity ' + IntToStr(GetLastError()));
except
on E:
Exception do
begin
MessageDlg(E.
Message, mtError, [mbAbort], -1);
// WriteLog(ltError, Format('AddAccessRights: Beim Ändern der Rechte auf
//dem Verzeichnis ''%s'' für ''%s'' ist ein Fehler aufgetreten. %s',
//[lpszFileName, lpszAccountName, E.Message]), []);
Exit;
end;
end;
//
// STEP 21: Free allocated memory
//
if pUserSID <>
nil then
myheapfree(pUserSID);
if szDomain <>
nil then
myheapfree(szDomain);
if pFileSD <>
nil then
myheapfree(pFileSD);
if pNewACL <>
nil then
myheapfree(pNewACL);
fResult := true;
end;