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;
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 := True;
if (FileGetAttr(lpFileName) AND faDirectory) <> 0 then
begin
// Rekursion beginnt
with Self do
begin
if FindFirst(IncludeTrailingPathDelimiter(lpFileName) + '*.*', $EFFF, sr) = 0 then
begin
Repeat
// Rechte setzen
SetFileSecurity(PChar(IncludeTrailingPathDelimiter(lpFileName) + sr.Name), SecurityInformation, pSecurityDescriptor);
if (sr.Attr and faDirectory) = faDirectory then
begin
if (sr.Name <> '.') AND (sr.Name <> '..') then
SetFileSecurityRecursive(PChar(IncludeTrailingPathDelimiter(lpFileName) + sr.Name),
SecurityInformation, pSecurityDescriptor);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
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 Not 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.
//
if Not AddAccessAllowedAce(pNewACL^, ACL_REVISION2, 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()));
end;
Inc(CurrentAceIndex);
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;